eeva/servant
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Convert servant-foreign to use text

Browse Source
This commit is contained in:
Arian van Putten 2015-10-02 10:23:57 +02:00
parent 52b58d0fe9
commit e17987e5ff
2 changed files with 28 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
servant-foreign/servant-foreign.cabal
View File

@ -29,6 +29,7 @@ library
build-depends: base == 4.* build-depends: base == 4.*
, lens == 4.* , lens == 4.*
, servant == 0.5.* , servant == 0.5.*
, text
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010
ghc-options: -Wall ghc-options: -Wall

52
servant-foreign/src/Servant/Foreign.hs
View File

@ -12,6 +12,7 @@
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE OverloadedStrings #-}
-- | Generalizes all the data needed to make code generation work with -- | Generalizes all the data needed to make code generation work with
-- arbitrary programming languages. -- arbitrary programming languages.
@ -51,38 +52,37 @@ import Control.Applicative
#endif #endif
import Control.Lens (makeLenses, (%~), (&), (.~), import Control.Lens (makeLenses, (%~), (&), (.~),
(<>~), _last) (<>~), _last)
import Data.Char (toLower, toUpper) import Data.Monoid ((<>))
import Data.List import Data.Text
import Data.Proxy import Data.Proxy
import GHC.Exts (Constraint) import GHC.Exts (Constraint)
import GHC.TypeLits import GHC.TypeLits
import Servant.API import Servant.API
import Prelude hiding (concat)
-- | Function name builder that simply concat each part together -- | Function name builder that simply concat each part together
concatCase :: FunctionName -> String concatCase :: FunctionName -> Text
concatCase = concat concatCase = concat
-- | Function name builder using the snake_case convention. -- | Function name builder using the snake_case convention.
-- each part is separated by a single underscore character. -- each part is separated by a single underscore character.
snakeCase :: FunctionName -> String snakeCase :: FunctionName -> Text
snakeCase = intercalate "_" snakeCase = intercalate "_"
-- | Function name builder using the CamelCase convention. -- | Function name builder using the CamelCase convention.
-- each part begins with an upper case character. -- each part begins with an upper case character.
camelCase :: FunctionName -> String camelCase :: FunctionName -> Text
camelCase [] = "" camelCase [] = ""
camelCase (p:ps) = concat $ p : camelCase' ps camelCase (p:ps) = concat $ p : camelCase' ps
where camelCase' [] = [] where camelCase' [] = []
camelCase' (r:rs) = capitalize r : camelCase' rs camelCase' (r:rs) = toUpper r : camelCase' rs
capitalize [] = []
capitalize (x:xs) = toUpper x : xs
type Arg = String type Arg = Text
data Segment = Segment { _segment :: SegmentType, _matrix :: [MatrixArg] } data Segment = Segment { _segment :: SegmentType, _matrix :: [MatrixArg] }
deriving (Eq, Show) deriving (Eq, Show)
data SegmentType = Static String -- ^ a static path segment. like "/foo" data SegmentType = Static Text -- ^ a static path segment. like "/foo"
| Cap Arg -- ^ a capture. like "/:userid" | Cap Arg -- ^ a capture. like "/:userid"
deriving (Eq, Show) deriving (Eq, Show)
@ -100,11 +100,11 @@ data QueryArg = QueryArg
} deriving (Eq, Show) } deriving (Eq, Show)
data HeaderArg = HeaderArg data HeaderArg = HeaderArg
{ headerArgName :: String { headerArgName :: Text
} }
| ReplaceHeaderArg | ReplaceHeaderArg
{ headerArgName :: String { headerArgName :: Text
, headerPattern :: String , headerPattern :: Text
} deriving (Eq, Show) } deriving (Eq, Show)
@ -118,8 +118,8 @@ data Url = Url
defUrl :: Url defUrl :: Url
defUrl = Url [] [] defUrl = Url [] []
type FunctionName = [String] type FunctionName = [Text]
type Method = String type Method = Text
data Req = Req data Req = Req
{ _reqUrl :: Url { _reqUrl :: Url
@ -175,7 +175,7 @@ instance (KnownSymbol sym, HasForeign sublayout)
req & reqUrl.path <>~ [Segment (Cap str) []] req & reqUrl.path <>~ [Segment (Cap str) []]
& funcName %~ (++ ["by", str]) & funcName %~ (++ ["by", str])
where str = symbolVal (Proxy :: Proxy sym) where str = pack . symbolVal $ (Proxy :: Proxy sym)
instance Elem JSON list => HasForeign (Delete list a) where instance Elem JSON list => HasForeign (Delete list a) where
type Foreign (Delete list a) = Req type Foreign (Delete list a) = Req
@ -198,7 +198,7 @@ instance (KnownSymbol sym, HasForeign sublayout)
foreignFor Proxy req = foreignFor Proxy req =
foreignFor subP (req & reqHeaders <>~ [HeaderArg hname]) foreignFor subP (req & reqHeaders <>~ [HeaderArg hname])
where hname = symbolVal (Proxy :: Proxy sym) where hname = pack . symbolVal $ (Proxy :: Proxy sym)
subP = Proxy :: Proxy sublayout subP = Proxy :: Proxy sublayout
instance Elem JSON list => HasForeign (Post list a) where instance Elem JSON list => HasForeign (Post list a) where
@ -223,7 +223,7 @@ instance (KnownSymbol sym, HasForeign sublayout)
foreignFor (Proxy :: Proxy sublayout) $ foreignFor (Proxy :: Proxy sublayout) $
req & reqUrl.queryStr <>~ [QueryArg str Normal] req & reqUrl.queryStr <>~ [QueryArg str Normal]
where str = symbolVal (Proxy :: Proxy sym) where str = pack . symbolVal $ (Proxy :: Proxy sym)
instance (KnownSymbol sym, HasForeign sublayout) instance (KnownSymbol sym, HasForeign sublayout)
=> HasForeign (QueryParams sym a :> sublayout) where => HasForeign (QueryParams sym a :> sublayout) where
@ -233,7 +233,7 @@ instance (KnownSymbol sym, HasForeign sublayout)
foreignFor (Proxy :: Proxy sublayout) $ foreignFor (Proxy :: Proxy sublayout) $
req & reqUrl.queryStr <>~ [QueryArg str List] req & reqUrl.queryStr <>~ [QueryArg str List]
where str = symbolVal (Proxy :: Proxy sym) where str = pack . symbolVal $ (Proxy :: Proxy sym)
instance (KnownSymbol sym, HasForeign sublayout) instance (KnownSymbol sym, HasForeign sublayout)
=> HasForeign (QueryFlag sym :> sublayout) where => HasForeign (QueryFlag sym :> sublayout) where
@ -243,7 +243,7 @@ instance (KnownSymbol sym, HasForeign sublayout)
foreignFor (Proxy :: Proxy sublayout) $ foreignFor (Proxy :: Proxy sublayout) $
req & reqUrl.queryStr <>~ [QueryArg str Flag] req & reqUrl.queryStr <>~ [QueryArg str Flag]
where str = symbolVal (Proxy :: Proxy sym) where str = pack . symbolVal $ (Proxy :: Proxy sym)
instance (KnownSymbol sym, HasForeign sublayout) instance (KnownSymbol sym, HasForeign sublayout)
=> HasForeign (MatrixParam sym a :> sublayout) where => HasForeign (MatrixParam sym a :> sublayout) where
@ -253,8 +253,8 @@ instance (KnownSymbol sym, HasForeign sublayout)
foreignFor (Proxy :: Proxy sublayout) $ foreignFor (Proxy :: Proxy sublayout) $
req & reqUrl.path._last.matrix <>~ [QueryArg strArg Normal] req & reqUrl.path._last.matrix <>~ [QueryArg strArg Normal]
where str = symbolVal (Proxy :: Proxy sym) where str = pack . symbolVal $ (Proxy :: Proxy sym)
strArg = str ++ "Value" strArg = str <> "Value"
instance (KnownSymbol sym, HasForeign sublayout) instance (KnownSymbol sym, HasForeign sublayout)
=> HasForeign (MatrixParams sym a :> sublayout) where => HasForeign (MatrixParams sym a :> sublayout) where
@ -264,7 +264,7 @@ instance (KnownSymbol sym, HasForeign sublayout)
foreignFor (Proxy :: Proxy sublayout) $ foreignFor (Proxy :: Proxy sublayout) $
req & reqUrl.path._last.matrix <>~ [QueryArg str List] req & reqUrl.path._last.matrix <>~ [QueryArg str List]
where str = symbolVal (Proxy :: Proxy sym) where str = pack . symbolVal $ (Proxy :: Proxy sym)
instance (KnownSymbol sym, HasForeign sublayout) instance (KnownSymbol sym, HasForeign sublayout)
=> HasForeign (MatrixFlag sym :> sublayout) where => HasForeign (MatrixFlag sym :> sublayout) where
@ -274,13 +274,13 @@ instance (KnownSymbol sym, HasForeign sublayout)
foreignFor (Proxy :: Proxy sublayout) $ foreignFor (Proxy :: Proxy sublayout) $
req & reqUrl.path._last.matrix <>~ [QueryArg str Flag] req & reqUrl.path._last.matrix <>~ [QueryArg str Flag]
where str = symbolVal (Proxy :: Proxy sym) where str = pack . symbolVal $ (Proxy :: Proxy sym)
instance HasForeign Raw where instance HasForeign Raw where
type Foreign Raw = Method -> Req type Foreign Raw = Method -> Req
foreignFor Proxy req method = foreignFor Proxy req method =
req & funcName %~ ((toLower <$> method) :) req & funcName %~ ((toLower method) :)
& reqMethod .~ method & reqMethod .~ method
instance (Elem JSON list, HasForeign sublayout) => HasForeign (ReqBody list a :> sublayout) where instance (Elem JSON list, HasForeign sublayout) => HasForeign (ReqBody list a :> sublayout) where
@ -299,7 +299,7 @@ instance (KnownSymbol path, HasForeign sublayout)
req & reqUrl.path <>~ [Segment (Static str) []] req & reqUrl.path <>~ [Segment (Static str) []]
& funcName %~ (++ [str]) & funcName %~ (++ [str])
where str = map (\c -> if c == '.' then '_' else c) $ symbolVal (Proxy :: Proxy path) where str = Data.Text.map (\c -> if c == '.' then '_' else c) . pack . symbolVal $ (Proxy :: Proxy path)
instance HasForeign sublayout => HasForeign (RemoteHost :> sublayout) where instance HasForeign sublayout => HasForeign (RemoteHost :> sublayout) where
type Foreign (RemoteHost :> sublayout) = Foreign sublayout type Foreign (RemoteHost :> sublayout) = Foreign sublayout