module Rest.Dictionary.Types
(
Format (..)
, Dict
, headers
, params
, inputs
, outputs
, errors
, empty
, Modifier
, Ident (..)
, Header (..)
, Param (..)
, Input (..)
, Output (..)
, Error (..)
, Dicts (..)
, dicts
, Inputs
, Outputs
, Errors
, SomeError (..)
)
where
import Data.Aeson
import Data.ByteString.Lazy (ByteString)
import Data.JSON.Schema
import Data.Label ((:->), lens)
import Data.Label.Derive
import Data.Text.Lazy (Text)
import Data.Typeable
import Network.Multipart (BodyPart)
import Text.XML.HXT.Arrow.Pickle
import Rest.Error
import Rest.Info
data Format
= XmlFormat
| JsonFormat
| StringFormat
| FileFormat
| MultipartFormat
| NoFormat
deriving (Eq, Ord, Enum, Bounded, Show)
data Ident id where
ReadId :: (Info id, Read id, Show id) => Ident id
StringId :: Ident String
deriving instance Show (Ident id)
data Header h where
NoHeader :: Header ()
Header :: [String] -> ([Maybe String] -> Either DataError h) -> Header h
TwoHeaders :: Header h -> Header k -> Header (h,k)
instance Show (Header h) where
showsPrec _ NoHeader = showString "NoHeader"
showsPrec n (Header hs _) = showParen (n > 9) (showString "Header " . showsPrec 10 hs)
showsPrec n (TwoHeaders h k) = showParen (n > 9) ( showString "TwoHeaders "
. showsPrec 10 h
. showString " "
. showsPrec 10 k
)
data Param p where
NoParam :: Param ()
Param :: [String] -> ([Maybe String] -> Either DataError p) -> Param p
TwoParams :: Param p -> Param q -> Param (p, q)
instance Show (Param p) where
showsPrec _ NoParam = showString "NoParam"
showsPrec n (Param ns _) = showParen (n > 9) (showString "Param " . showsPrec 10 ns)
showsPrec n (TwoParams p q) = showParen (n > 9) ( showString "TwoParams "
. showsPrec 10 p
. showString " "
. showsPrec 10 q
)
data Input i where
JsonI :: (Typeable i, FromJSON i, JSONSchema i) => Input i
ReadI :: (Info i, Read i, Show i) => Input i
StringI :: Input String
FileI :: Input ByteString
XmlI :: (Typeable i, XmlPickler i) => Input i
XmlTextI :: Input Text
RawXmlI :: Input ByteString
deriving instance Show (Input i)
deriving instance Eq (Input i)
deriving instance Ord (Input i)
data Output o where
FileO :: Output (ByteString, String)
RawXmlO :: Output ByteString
JsonO :: (Typeable o, ToJSON o, JSONSchema o) => Output o
XmlO :: (Typeable o, XmlPickler o) => Output o
StringO :: Output String
MultipartO :: Output [BodyPart]
deriving instance Show (Output o)
deriving instance Eq (Output o)
deriving instance Ord (Output o)
data Error e where
JsonE :: (ToResponseCode e, Typeable e, ToJSON e, JSONSchema e) => Error e
XmlE :: (ToResponseCode e, Typeable e, XmlPickler e) => Error e
deriving instance Show (Error e)
deriving instance Eq (Error e)
deriving instance Ord (Error e)
type Inputs i = Dicts Input i
type Outputs o = Dicts Output o
type Errors e = Dicts Error e
data Dicts f a where
None :: Dicts f ()
Dicts :: [f a] -> Dicts f a
deriving instance Show (f a) => Show (Dicts f a)
dicts :: Dicts f a :-> [f a]
dicts = lens getDicts modDicts
where
getDicts None = []
getDicts (Dicts ds) = ds
modDicts :: ([f a] -> [f a]) -> Dicts f a -> Dicts f a
modDicts _ None = None
modDicts f (Dicts ds) = Dicts (f ds)
fclabels [d|
data Dict h p i o e = Dict
{ headers :: Header h
, params :: Param p
, inputs :: Inputs i
, outputs :: Outputs o
, errors :: Errors e
} deriving Show
|]
empty :: Dict () () () () ()
empty = Dict NoHeader NoParam None None None
data SomeError where
SomeError :: Errors e -> Reason e -> SomeError
type Modifier h p i o e = Dict () () () () () -> Dict h p i o e