rest-types (empty) → 1.9.0.1
raw patch · 7 files changed
+401/−0 lines, 7 filesdep +aesondep +basedep +bytestringsetup-changed
Dependencies added: aeson, base, bytestring, containers, generic-aeson, hxt, json-schema, mtl, regular, regular-xmlpickler, text, tostring, unordered-containers, utf8-string, uuid
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- rest-types.cabal +40/−0
- src/Rest/Types/Container.hs +101/−0
- src/Rest/Types/Container/Resource.hs +70/−0
- src/Rest/Types/Error.hs +144/−0
- src/Rest/Types/ShowUrl.hs +14/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014, Silk++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Silk nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ rest-types.cabal view
@@ -0,0 +1,40 @@+Name: rest-types+Version: 1.9.0.1+Description: Silk Rest Framework Types+Synopsis: Silk Rest Framework Types+Maintainer: code@silk.co+Category: Web+Build-Type: Simple+Cabal-Version: >= 1.8+License: BSD3+License-File: LICENSE++Library+ GHC-Options: -Wall+ Hs-Source-Dirs: src+ Build-Depends:++ base == 4.*+ , aeson >= 0.7 && < 0.8+ , bytestring >= 0.9 && < 0.11+ , containers >= 0.4 && < 0.6+ , generic-aeson == 0.1.*+ , hxt >= 9.2 && < 9.4+ , json-schema == 0.4.*+ , mtl >= 2.0 && < 2.2+ , regular == 0.3.*+ , regular-xmlpickler == 0.2.*+ , text == 0.11.*+ , tostring == 0.2.*+ , unordered-containers == 0.2.*+ , utf8-string == 0.3.*+ , uuid >= 1.2 && < 1.4++ Exposed-Modules: Rest.Types.Container+ Rest.Types.Container.Resource+ Rest.Types.Error+ Rest.Types.ShowUrl++Source-repository head+ Type: Git+ Location: https://github.com/silkapp/rest.git
+ src/Rest/Types/Container.hs view
@@ -0,0 +1,101 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE+ DeriveDataTypeable+ , DeriveGeneric+ , EmptyDataDecls+ , FlexibleContexts+ , FlexibleInstances+ , GADTs+ , ScopedTypeVariables+ , StandaloneDeriving+ , TemplateHaskell+ , TupleSections+ , TypeFamilies+ , UndecidableInstances+ #-}+module Rest.Types.Container+ ( List(..)+ , StringMap(..)+ , fromStringMap+ , toStringMap+ , SomeOutput(..)+ ) where++import Control.Applicative+import Data.Aeson+import Data.JSON.Schema hiding (Object, Value)+import Data.JSON.Schema.Combinators (field)+import Data.Map (Map)+import Data.String+import Data.String.ToString+import Data.Text (pack, unpack)+import Data.Typeable+import GHC.Generics+import Generics.Generic.Aeson+import Generics.Regular (PF, deriveAll)+import Generics.Regular.XmlPickler (gxpickle)+import Text.XML.HXT.Arrow.Pickle+import Text.XML.HXT.Arrow.Pickle.Schema+import Text.XML.HXT.Arrow.Pickle.Xml+import qualified Data.HashMap.Strict as H+import qualified Data.Map as M++-------------------------------------------------------------------------------++data List a = List+ { offset :: Int+ , count :: Int+ , items :: [a]+ } deriving (Generic, Show, Typeable)++deriveAll ''List "PFList"+type instance PF (List a) = PFList a++instance XmlPickler a => XmlPickler (List a) where xpickle = gxpickle+instance ToJSON a => ToJSON (List a) where toJSON = gtoJson+instance FromJSON a => FromJSON (List a) where parseJSON = gparseJson+instance JSONSchema a => JSONSchema (List a) where schema = gSchema++-------------------------------------------------------------------------------++newtype StringMap a b = StringMap { unMap :: [(a, b)] } deriving (Show, Typeable)++deriveAll ''StringMap "PFStringMap"+type instance PF (StringMap a b) = PFStringMap a b++instance (IsString a, ToString a, XmlPickler b) => XmlPickler (StringMap a b) where+ xpickle = xpElem "map" (xpWrap (StringMap, unMap) (xpList (xpPair (xpElem "key" (xpWrap (fromString,toString) xpText)) xpickle)))++instance (ToString a, ToJSON b) => ToJSON (StringMap a b) where+ toJSON = toJSON . Object . H.fromList . map (\(a,b) -> pack (toString a) .= b) . unMap++instance (IsString a, FromJSON b) => FromJSON (StringMap a b) where+ parseJSON = withObject "StringMap" (fmap StringMap . mapM (\(k,v) -> (fromString . unpack $ k,) <$> parseJSON v) . H.toList)++instance (IsString a, ToString a, JSONSchema b) => JSONSchema (StringMap a b) where+ schema _ = field "key" False (schema (Proxy :: Proxy b))++fromStringMap :: (Ord a, IsString a, ToString a) => StringMap a b -> Map a b+fromStringMap = M.fromList . unMap++toStringMap :: (Ord a, IsString a, ToString a) => Map a b -> StringMap a b+toStringMap = StringMap . M.toList++-------------------------------------------------------------------------------++data SomeOutput where+ SomeOutput :: (XmlPickler o, ToJSON o, JSONSchema o) => o -> SomeOutput++deriving instance Typeable SomeOutput++instance XmlPickler SomeOutput where+ xpickle = PU+ (\(SomeOutput e) st -> appPickle xpickle e st)+ (throwMsg "Cannot unpickle SomeOutput.")+ Any++instance ToJSON SomeOutput where toJSON (SomeOutput r) = toJSON r+-- readJSON _ = Error "Cannot read SomeOutput from JSON."++instance JSONSchema SomeOutput where+ schema _ = Choice [] -- TODO: should be something like Any
+ src/Rest/Types/Container/Resource.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE+ DeriveDataTypeable+ , DeriveGeneric+ , TemplateHaskell+ , TypeFamilies+ , EmptyDataDecls+ #-}+module Rest.Types.Container.Resource+ ( Resource (..)+ , Resources (..)++ , KeyValues+ , Value (..)+ ) where++import Data.Aeson hiding (Value)+import Data.JSON.Schema (JSONSchema (..), gSchema)+import Data.Typeable+import GHC.Generics+import Generics.Generic.Aeson+import Generics.Regular (PF, deriveAll)+import Generics.Regular.XmlPickler (gxpickle)+import Text.XML.HXT.Arrow.Pickle+import qualified Data.JSON.Schema as Json++import Rest.Types.Container++type KeyValues = StringMap String Value++newtype Value = Value { unValue :: String } deriving (Show, Typeable)++instance XmlPickler Value where+ xpickle = xpElem "value" $ xpWrap (Value, unValue) xpText0++instance ToJSON Value where toJSON = toJSON . unValue+instance FromJSON Value where parseJSON = fmap Value . parseJSON++instance JSONSchema Value where+ schema _ = Json.Value 0 (-1)++data Resource = Resource+ { uri :: String+ , headers :: KeyValues+ , parameters :: KeyValues+ , input :: String+ } deriving (Generic, Show, Typeable)++deriveAll ''Resource "PFResource"+type instance PF Resource = PFResource++instance XmlPickler Resource where+ xpickle = gxpickle++instance ToJSON Resource where toJSON = gtoJson+instance FromJSON Resource where parseJSON = gparseJson+instance JSONSchema Resource where schema = gSchema++-------------------------------------------------------------------------------++newtype Resources = Resources [Resource] deriving (Generic, Typeable)++deriveAll ''Resources "PFResources"+type instance PF Resources = PFResources++instance XmlPickler Resources where+ xpickle = gxpickle++instance ToJSON Resources where toJSON = gtoJson+instance FromJSON Resources where parseJSON = gparseJson+instance JSONSchema Resources where schema = gSchema
+ src/Rest/Types/Error.hs view
@@ -0,0 +1,144 @@+{-# LANGUAGE+ DeriveDataTypeable+ , DeriveGeneric+ , EmptyDataDecls+ , GADTs+ , ScopedTypeVariables+ , StandaloneDeriving+ , TemplateHaskell+ , TypeFamilies+ #-}+module Rest.Types.Error+ ( DataError(..)+ , DomainReason(..)+ , Status(..)+ , fromEither+ , toEither+ , Reason_+ , Reason(..)+ , SomeReason(..)+ ) where++import Control.Monad.Error+import Data.Aeson hiding (Success)+import Data.JSON.Schema+import Data.Typeable+import GHC.Generics+import Generics.Generic.Aeson+import Generics.Regular (PF, deriveAll)+import Generics.Regular.XmlPickler (gxpickle)+import Text.XML.HXT.Arrow.Pickle+import Text.XML.HXT.Arrow.Pickle.Schema+import Text.XML.HXT.Arrow.Pickle.Xml++-- Error utilities.++data DataError+ = ParseError String+ | PrintError String+ | MissingField String+ | UnsupportedFormat String+ deriving (Eq, Generic, Show)++data DomainReason a = DomainReason { responseCode :: Int, reason :: a } deriving (Eq, Generic)++instance Show a => Show (DomainReason a) where+ showsPrec a (DomainReason _ e) = showParen (a >= 11) (showString "Domain " . showsPrec 11 e)++instance XmlPickler a => XmlPickler (DomainReason a) where+ xpickle = xpWrap (DomainReason (error "No error function defined for DomainReason parsed from JSON"), reason) xpickle++instance ToJSON a => ToJSON (DomainReason a) where+ toJSON (DomainReason _ e) = toJSON e+instance FromJSON a => FromJSON (DomainReason a) where+ parseJSON = fmap (DomainReason (error "No error function defined for DomainReason parsed from JSON")) . parseJSON+++instance JSONSchema a => JSONSchema (DomainReason a) where+ schema = schema . fmap reason++data Status a b = Failure a | Success b deriving (Generic, Typeable)++$(deriveAll ''Status "PFStatus")+type instance PF (Status a b) = PFStatus a b++instance (XmlPickler a, XmlPickler b) => XmlPickler (Status a b) where+ xpickle = gxpickle++instance (ToJSON a, ToJSON b) => ToJSON (Status a b) where toJSON = gtoJson+instance (FromJSON a, FromJSON b) => FromJSON (Status a b) where parseJSON = gparseJson++instance (JSONSchema a, JSONSchema b) => JSONSchema (Status a b) where+ schema = gSchema++fromEither :: Either a b -> Status a b+fromEither = either Failure Success++toEither :: Status a b -> Either a b+toEither (Success x) = Right x+toEither (Failure y) = Left y++type Reason_ = Reason ()++data Reason a+ -- Thrown in the router.+ = UnsupportedRoute+ | UnsupportedMethod+ | UnsupportedVersion++ -- Thrown during generic IO.+ | IdentError DataError+ | HeaderError DataError+ | ParamError DataError+ | InputError DataError+ | OutputError DataError++ -- Generic errors thrown in specific handlers.+ | NotFound+ | NotAllowed+ | AuthenticationFailed+ | Busy+ | Gone++ -- Custom domain reasons.+ | CustomReason (DomainReason a)+ deriving (Eq, Generic, Show, Typeable)++instance Error DataError++instance Error (Reason e)++$(deriveAll ''DataError "PFDataError")+$(deriveAll ''Reason "PFReason")++type instance PF DataError = PFDataError+type instance PF (Reason e) = PFReason e++instance XmlPickler DataError where xpickle = gxpickle+instance XmlPickler e => XmlPickler (Reason e) where xpickle = gxpickle++instance ToJSON DataError where toJSON = gtoJson+instance FromJSON DataError where parseJSON = gparseJson+instance ToJSON e => ToJSON (Reason e) where toJSON = gtoJson+instance FromJSON e => FromJSON (Reason e) where parseJSON = gparseJson++instance JSONSchema DataError where schema = gSchema+instance JSONSchema e => JSONSchema (Reason e) where schema = gSchema++data SomeReason where+ SomeReason :: (XmlPickler e, JSONSchema e, ToJSON e) => Reason e -> SomeReason++instance Error SomeReason++deriving instance Typeable SomeReason++instance XmlPickler SomeReason where+ xpickle = PU+ (\(SomeReason e) st -> appPickle xpickle e st)+ (throwMsg "Cannot unpickle SomeReason.")+ Any++instance ToJSON SomeReason where toJSON (SomeReason r) = toJSON r++instance JSONSchema SomeReason where+ schema _ = Choice [] -- TODO: this should be something like Any
+ src/Rest/Types/ShowUrl.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE TypeSynonymInstances+ , FlexibleInstances+ #-}+module Rest.Types.ShowUrl (ShowUrl(..)) where++import Data.UUID++class ShowUrl a where+ showUrl :: a -> String++instance ShowUrl String where showUrl = id+instance ShowUrl Int where showUrl = show+instance ShowUrl Integer where showUrl = show+instance ShowUrl UUID where showUrl = show