e17987e · servant · git.iko.soy

12{-# LANGUAGE TypeFamilies #-}

13{-# LANGUAGE TypeOperators #-}

14{-# LANGUAGE UndecidableInstances #-}

15+{-# LANGUAGE OverloadedStrings #-}

15

16

16-- | Generalizes all the data needed to make code generation work with

17-- | Generalizes all the data needed to make code generation work with

17-- arbitrary programming languages.

18-- arbitrary programming languages.

51#endif

52#endif

52import Control.Lens (makeLenses, (%~), (&), (.~),

53import Control.Lens (makeLenses, (%~), (&), (.~),

53 (<>~), _last)

54 (<>~), _last)

54−import Data.Char (toLower, toUpper)

55+import Data.Monoid ((<>))

55−import Data.List

56+import Data.Text

56import Data.Proxy

57import Data.Proxy

57import GHC.Exts (Constraint)

58import GHC.Exts (Constraint)

58import GHC.TypeLits

59import GHC.TypeLits

59import Servant.API

60import Servant.API

61+import Prelude hiding (concat)

60

62

61-- | Function name builder that simply concat each part together

63-- | Function name builder that simply concat each part together

62−concatCase :: FunctionName -> String

64+concatCase :: FunctionName -> Text

63concatCase = concat

65concatCase = concat

64

66

65-- | Function name builder using the snake_case convention.

67-- | Function name builder using the snake_case convention.

66-- each part is separated by a single underscore character.

68-- each part is separated by a single underscore character.

67−snakeCase :: FunctionName -> String

69+snakeCase :: FunctionName -> Text

68snakeCase = intercalate "_"

70snakeCase = intercalate "_"

69

71

70-- | Function name builder using the CamelCase convention.

72-- | Function name builder using the CamelCase convention.

71-- each part begins with an upper case character.

73-- each part begins with an upper case character.

72−camelCase :: FunctionName -> String

74+camelCase :: FunctionName -> Text

73camelCase [] = ""

75camelCase [] = ""

74camelCase (p:ps) = concat $ p : camelCase' ps

76camelCase (p:ps) = concat $ p : camelCase' ps

75 where camelCase' [] = []

77 where camelCase' [] = []

76− camelCase' (r:rs) = capitalize r : camelCase' rs

78+ camelCase' (r:rs) = toUpper r : camelCase' rs

77− capitalize [] = []

78− capitalize (x:xs) = toUpper x : xs

79

80−type Arg = String

80+type Arg = Text

81

82data Segment = Segment { _segment :: SegmentType, _matrix :: [MatrixArg] }

83 deriving (Eq, Show)

84

85−data SegmentType = Static String -- ^ a static path segment. like "/foo"

85+data SegmentType = Static Text -- ^ a static path segment. like "/foo"

86 | Cap Arg -- ^ a capture. like "/:userid"

87 deriving (Eq, Show)

88

100 } deriving (Eq, Show)

101

102data HeaderArg = HeaderArg

103− { headerArgName :: String

103+ { headerArgName :: Text

104 }

105 | ReplaceHeaderArg

106− { headerArgName :: String

106+ { headerArgName :: Text

107− , headerPattern :: String

107+ , headerPattern :: Text

108 } deriving (Eq, Show)

109

110

118defUrl :: Url

119defUrl = Url [] []

120

121−type FunctionName = [String]

121+type FunctionName = [Text]

122−type Method = String

122+type Method = Text

123

124data Req = Req

125 { _reqUrl :: Url

175 req & reqUrl.path <>~ [Segment (Cap str) []]

176 & funcName %~ (++ ["by", str])

177

178− where str = symbolVal (Proxy :: Proxy sym)

178+ where str = pack . symbolVal $ (Proxy :: Proxy sym)

179

180instance Elem JSON list => HasForeign (Delete list a) where

181 type Foreign (Delete list a) = Req

198 foreignFor Proxy req =

199 foreignFor subP (req & reqHeaders <>~ [HeaderArg hname])

200

201− where hname = symbolVal (Proxy :: Proxy sym)

201+ where hname = pack . symbolVal $ (Proxy :: Proxy sym)

202 subP = Proxy :: Proxy sublayout

203

204instance Elem JSON list => HasForeign (Post list a) where

223 foreignFor (Proxy :: Proxy sublayout) $

224 req & reqUrl.queryStr <>~ [QueryArg str Normal]

225

226− where str = symbolVal (Proxy :: Proxy sym)

226+ where str = pack . symbolVal $ (Proxy :: Proxy sym)

227

228instance (KnownSymbol sym, HasForeign sublayout)

229 => HasForeign (QueryParams sym a :> sublayout) where

233 foreignFor (Proxy :: Proxy sublayout) $

234 req & reqUrl.queryStr <>~ [QueryArg str List]

235

236− where str = symbolVal (Proxy :: Proxy sym)

236+ where str = pack . symbolVal $ (Proxy :: Proxy sym)

237

238instance (KnownSymbol sym, HasForeign sublayout)

239 => HasForeign (QueryFlag sym :> sublayout) where

243 foreignFor (Proxy :: Proxy sublayout) $

244 req & reqUrl.queryStr <>~ [QueryArg str Flag]

245

246− where str = symbolVal (Proxy :: Proxy sym)

246+ where str = pack . symbolVal $ (Proxy :: Proxy sym)

247

248instance (KnownSymbol sym, HasForeign sublayout)

249 => HasForeign (MatrixParam sym a :> sublayout) where

253 foreignFor (Proxy :: Proxy sublayout) $

254 req & reqUrl.path._last.matrix <>~ [QueryArg strArg Normal]

255

256− where str = symbolVal (Proxy :: Proxy sym)

256+ where str = pack . symbolVal $ (Proxy :: Proxy sym)

257− strArg = str ++ "Value"

257+ strArg = str <> "Value"

258

259instance (KnownSymbol sym, HasForeign sublayout)

260 => HasForeign (MatrixParams sym a :> sublayout) where

264 foreignFor (Proxy :: Proxy sublayout) $

265 req & reqUrl.path._last.matrix <>~ [QueryArg str List]

266

267− where str = symbolVal (Proxy :: Proxy sym)

267+ where str = pack . symbolVal $ (Proxy :: Proxy sym)

268

269instance (KnownSymbol sym, HasForeign sublayout)

270 => HasForeign (MatrixFlag sym :> sublayout) where

274 foreignFor (Proxy :: Proxy sublayout) $

275 req & reqUrl.path._last.matrix <>~ [QueryArg str Flag]

276

277− where str = symbolVal (Proxy :: Proxy sym)

277+ where str = pack . symbolVal $ (Proxy :: Proxy sym)

278

279instance HasForeign Raw where

280 type Foreign Raw = Method -> Req

281

282 foreignFor Proxy req method =

283− req & funcName %~ ((toLower <$> method) :)

283+ req & funcName %~ ((toLower method) :)

284 & reqMethod .~ method

285

286instance (Elem JSON list, HasForeign sublayout) => HasForeign (ReqBody list a :> sublayout) where

299 req & reqUrl.path <>~ [Segment (Static str) []]

300 & funcName %~ (++ [str])

301

302− where str = map (\c -> if c == '.' then '_' else c) $ symbolVal (Proxy :: Proxy path)

302+ where str = Data.Text.map (\c -> if c == '.' then '_' else c) . pack . symbolVal $ (Proxy :: Proxy path)

303

304instance HasForeign sublayout => HasForeign (RemoteHost :> sublayout) where

305 type Foreign (RemoteHost :> sublayout) = Foreign sublayout