git.iko.soy/typeable/servant
on master help sign in
examples: add GS10
616b203Alp Mestanogullari
servant-examples/getting-started/GS10.hsnew file+94
@@ -0,0 +1,94 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE TypeFamilies #-}
3+{-# LANGUAGE TypeOperators #-}
4+{-# LANGUAGE FlexibleInstances #-}
5+{-# LANGUAGE OverloadedStrings #-}
6+{-# LANGUAGE MultiParamTypeClasses #-}
7+module GS10 where
8+
9+import Data.ByteString.Lazy (ByteString)
10+import Data.Text.Lazy (pack)
11+import Data.Text.Lazy.Encoding (encodeUtf8)
12+import Network.HTTP.Types
13+import Network.Wai
14+import Servant
15+import Servant.Docs
16+import Servant.Docs.Pandoc (pandoc)
17+import Text.Pandoc.Options (def, WriterOptions(..))
18+import Text.Pandoc.Writers.HTML (writeHtmlString)
19+import qualified GS3
20+
21+type DocsAPI = GS3.API :<|> Raw
22+
23+instance ToCapture (Capture "x" Int) where
24+ toCapture _ = DocCapture "x" "(integer) position on the x axis"
25+
26+instance ToCapture (Capture "y" Int) where
27+ toCapture _ = DocCapture "y" "(integer) position on the y axis"
28+
29+instance ToSample GS3.Position GS3.Position where
30+ toSample _ = Just (GS3.Position 3 14)
31+
32+instance ToParam (QueryParam "name" String) where
33+ toParam _ =
34+ DocQueryParam "name"
35+ ["Alp", "John Doe", "..."]
36+ "Name of the person to say hello to."
37+ Normal
38+
39+instance ToSample GS3.HelloMessage GS3.HelloMessage where
40+ toSamples _ =
41+ [ ("When a value is provided for 'name'", GS3.HelloMessage "Hello, Alp")
42+ , ("When 'name' is not specified", GS3.HelloMessage "Hello, anonymous coward")
43+ ]
44+
45+ci :: GS3.ClientInfo
46+ci = GS3.ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"]
47+
48+instance ToSample GS3.ClientInfo GS3.ClientInfo where
49+ toSample _ = Just ci
50+
51+instance ToSample GS3.Email GS3.Email where
52+ toSample _ = Just (GS3.emailForClient ci)
53+
54+api :: Proxy DocsAPI
55+api = Proxy
56+
57+docsBS :: ByteString
58+docsBS = encodeUtf8
59+ . pack
60+ . writeHtmlString opts
61+ . pandoc
62+ $ docsWithIntros [intro] GS3.api
63+
64+ where opts = def { writerHtml5 = True
65+ , writerTableOfContents = True
66+ , writerHighlight = True
67+ , writerStandalone = True
68+ , writerTemplate =
69+ concat
70+ [ "<!DOCTYPE html><html>"
71+ , "<head>"
72+ , "<meta charset=\"UTF-8\">"
73+ , "<title>API Docs - $title$</title>"
74+ , "</head>"
75+ , "<body>"
76+ , "$toc$"
77+ , "<hr />"
78+ , "$body$"
79+ , "</body>"
80+ , "</html>"
81+ ]
82+ }
83+ intro = DocIntro "Welcome" ["This is our super webservice's API.", "Enjoy!"]
84+
85+server :: Server DocsAPI
86+server = GS3.server :<|> serveDocs
87+
88+ where serveDocs _ respond =
89+ respond $ responseLBS ok200 [html] docsBS
90+
91+ html = ("Content-Type", "text/html")
92+
93+app :: Application
94+app = serve api server
servant-examples/getting-started/GS9.hs+15−13
@@ -2,20 +2,22 @@
2{-# LANGUAGE TypeFamilies #-}
2{-# LANGUAGE TypeFamilies #-}
3{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE DeriveGeneric #-}
4{-# LANGUAGE TypeOperators #-}
4{-# LANGUAGE TypeOperators #-}
5+{-# LANGUAGE OverloadedStrings #-}
5module GS9 where
6module GS9 where
6
7
7import Control.Applicative
8import Control.Applicative
8import Control.Monad.IO.Class
9import Control.Monad.IO.Class
9import Data.Aeson
10import Data.Aeson
10−import Data.Char
11+import Data.Text (Text)
11−import Data.List
12import GHC.Generics
12import GHC.Generics
13−import qualified Language.Javascript.JQuery as JQ
14import Math.Probable
13import Math.Probable
15import Network.Wai
14import Network.Wai
16import Servant
15import Servant
17import Servant.JQuery
16import Servant.JQuery
18
17
18+import qualified Data.Text as T
19+import qualified Language.Javascript.JQuery as JQ
20+
19data Point = Point
21data Point = Point
20 { x :: Double
22 { x :: Double
21 , y :: Double
23 , y :: Double
@@ -29,24 +31,24 @@ randomPoint = liftIO . mwc $ Point <$> d <*> d
29 where d = doubleIn (-1, 1)
31 where d = doubleIn (-1, 1)
30
32
31data Search a = Search
33data Search a = Search
32− { query :: String
34+ { query :: Text
33 , results :: [a]
35 , results :: [a]
34 } deriving Generic
36 } deriving Generic
35
37
36−mkSearch :: String -> [a] -> Search a
38+mkSearch :: Text -> [a] -> Search a
37mkSearch = Search
39mkSearch = Search
38
40
39instance ToJSON a => ToJSON (Search a)
41instance ToJSON a => ToJSON (Search a)
40
42
41data Book = Book
43data Book = Book
42− { author :: String
44+ { author :: Text
43− , title :: String
45+ , title :: Text
44 , year :: Int
46 , year :: Int
45 } deriving Generic
47 } deriving Generic
46
48
47instance ToJSON Book
49instance ToJSON Book
48
50
49−book :: String -> String -> Int -> Book
51+book :: Text -> Text -> Int -> Book
50book = Book
52book = Book
51
53
52books :: [Book]
54books :: [Book]
@@ -59,18 +61,18 @@ books =
59 , book "Richard Bird" "Introduction to Functional Programming using Haskell" 1998
61 , book "Richard Bird" "Introduction to Functional Programming using Haskell" 1998
60 ]
62 ]
61
63
62−searchBook :: Monad m => Maybe String -> m (Search Book)
64+searchBook :: Monad m => Maybe Text -> m (Search Book)
63searchBook Nothing = return (mkSearch "" books)
65searchBook Nothing = return (mkSearch "" books)
64searchBook (Just q) = return (mkSearch q books')
66searchBook (Just q) = return (mkSearch q books')
65
67
66− where books' = filter (\b -> q' `isInfixOf` map toLower (author b)
68+ where books' = filter (\b -> q' `T.isInfixOf` T.toLower (author b)
67− || q' `isInfixOf` map toLower (title b)
69+ || q' `T.isInfixOf` T.toLower (title b)
68 )
70 )
69 books
71 books
70− q' = map toLower q
72+ q' = T.toLower q
71
73
72type API = "point" :> Get '[JSON] Point
74type API = "point" :> Get '[JSON] Point
73− :<|> "books" :> QueryParam "q" String :> Get '[JSON] (Search Book)
75+ :<|> "books" :> QueryParam "q" Text :> Get '[JSON] (Search Book)
74
76
75type API' = API :<|> Raw
77type API' = API :<|> Raw
76
78
servant-examples/getting-started/getting-started.hs+2
@@ -10,6 +10,7 @@ import qualified GS5
10import qualified GS6
10import qualified GS6
11import qualified GS7
11import qualified GS7
12import qualified GS9
12import qualified GS9
13+import qualified GS10
13
14
14app :: String -> (Application -> IO ()) -> IO ()
15app :: String -> (Application -> IO ()) -> IO ()
15app n f = case n of
16app n f = case n of
@@ -22,6 +23,7 @@ app n f = case n of
22 "7" -> f GS7.app
23 "7" -> f GS7.app
23 "8" -> f GS3.app
24 "8" -> f GS3.app
24 "9" -> GS9.writeJSFiles >> f GS9.app
25 "9" -> GS9.writeJSFiles >> f GS9.app
26+ "10" -> f GS10.app
25 _ -> usage
27 _ -> usage
26
28
27main :: IO ()
29main :: IO ()
servant-examples/servant-examples.cabal+7−1
@@ -15,19 +15,25 @@ cabal-version: >=1.10
15
15
16executable getting-started
16executable getting-started
17 main-is: getting-started.hs
17 main-is: getting-started.hs
18− other-modules: GS1, GS2, GS3, GS4, GS5, GS6, GS7, GS8, GS9
18+ other-modules: GS1, GS2, GS3, GS4, GS5, GS6, GS7, GS8, GS9, GS10
19 build-depends:
19 build-depends:
20 aeson >= 0.8
20 aeson >= 0.8
21 , base >= 4.7
21 , base >= 4.7
22+ , bytestring
22 , directory
23 , directory
23 , either
24 , either
25+ , http-types
24 , js-jquery
26 , js-jquery
25 , lucid
27 , lucid
28+ , pandoc
26 , probable
29 , probable
27 , servant
30 , servant
31+ , servant-docs
28 , servant-jquery
32 , servant-jquery
29 , servant-lucid
33 , servant-lucid
34+ , servant-pandoc >= 0.2
30 , servant-server
35 , servant-server
36+ , text
31 , time
37 , time
32 , transformers
38 , transformers
33 , wai
39 , wai