git.iko.soy/servant-reflex
on develop help sign in
servant-reflex/testserver/Main.hs
77 lines 2.5 kB history raw
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE PolyKinds #-}
5{-# LANGUAGE TypeFamilies #-}
6{-# LANGUAGE TypeOperators #-}
8import Data.Aeson
9import Data.Bool
10import Data.Char (toUpper)
11import qualified Data.List as L
12import Data.Monoid
13import Data.Proxy
14import Data.Text hiding (length, null, map, head, toUpper)
15import qualified Data.Text as T
16import GHC.Generics
17import Snap.Http.Server
18import Snap.Core
19import Servant.Server.Internal.SnapShims
21import Servant -- hiding (serveDirectory)
22import Servant.Server
23-- import Snap.Util.FileServe
24import API
25import Snap
27-- * Example
29-- | A greet message data type
30newtype Greet = Greet { _msg :: Text }
31 deriving (Generic, Show)
33instance FromJSON Greet
34instance ToJSON Greet
36testApi :: Proxy API
37testApi = Proxy
39data App = App
41-- Server-side handlers.
42--
43-- There's one handler per endpoint, which, just like in the type
44-- that represents the API, are glued together using :<|>.
45--
46-- Each handler runs in the 'ExceptT ServantErr IO' monad.
47server :: Server API (Handler App App)
48server = return () :<|> return 100 :<|> sayhi :<|> dbl :<|> multi :<|> serveDirectory "static"
49 where sayhi :: Maybe Text -> [Text] -> Bool -> Handler App App Text
50 sayhi nm greetings withGusto = case nm of
51 Nothing -> return ("Sorry, who are you?" :: Text)
52 Just n -> do
53 let modifier = bool id T.toUpper withGusto
54 greetPart
55 | null greetings = "Hi, "
56 | length greetings == 1 = L.head greetings <> ", "
57 | otherwise = T.intercalate ", " (L.init greetings)
58 <> ", and " <> L.last greetings <> ", "
59 return . modifier $ greetPart <> n
60 dbl x = return $ x * 2
61 multi = return . bool "Box unchecked" "Box Checked"
63-- Turn the server into a WAI app. 'serve' is provided by servant,
64-- more precisely by the Servant.Server module.
65test :: Application (Handler App App)
66test = serve testApi server
68initApp :: SnapletInit App App
69initApp = makeSnaplet "myapp" "example" Nothing $ do
70 addRoutes [("", applicationToSnap test)
71 ,("", serveDirectory "static")
72 ]
73 return App
75-- Put this all to work!
76main :: IO ()
77main = serveSnaplet mempty initApp