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