git.iko.soy/typeable/servant
on v0.4.3.1 help sign in
typeable/servant/servant-examples/tutorial/T9.hs
104 lines 2.5 kB history raw
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE TypeFamilies #-}
3{-# LANGUAGE DeriveGeneric #-}
4{-# LANGUAGE TypeOperators #-}
5{-# LANGUAGE OverloadedStrings #-}
6module T9 where
8import Control.Applicative
9import Control.Monad.IO.Class
10import Data.Aeson
11import Data.Text (Text)
12import GHC.Generics
13import Network.Wai
14import Servant
15import Servant.JQuery
16import System.Random
18import qualified Data.Text as T
19import qualified Language.Javascript.JQuery as JQ
21data Point = Point
22 { x :: Double
23 , y :: Double
24 } deriving Generic
26instance ToJSON Point
28randomPoint :: MonadIO m => m Point
29randomPoint = liftIO . getStdRandom $ \g ->
30 let (rx, g') = randomR (-1, 1) g
31 (ry, g'') = randomR (-1, 1) g'
32 in (Point rx ry, g'')
34data Search a = Search
35 { query :: Text
36 , results :: [a]
37 } deriving Generic
39mkSearch :: Text -> [a] -> Search a
40mkSearch = Search
42instance ToJSON a => ToJSON (Search a)
44data Book = Book
45 { author :: Text
46 , title :: Text
47 , year :: Int
48 } deriving Generic
50instance ToJSON Book
52book :: Text -> Text -> Int -> Book
53book = Book
55books :: [Book]
56books =
57 [ book "Paul Hudak" "The Haskell School of Expression: Learning Functional Programming through Multimedia" 2000
58 , book "Bryan O'Sullivan, Don Stewart, and John Goerzen" "Real World Haskell" 2008
59 , book "Miran Lipovača" "Learn You a Haskell for Great Good!" 2011
60 , book "Graham Hutton" "Programming in Haskell" 2007
61 , book "Simon Marlow" "Parallel and Concurrent Programming in Haskell" 2013
62 , book "Richard Bird" "Introduction to Functional Programming using Haskell" 1998
63 ]
65searchBook :: Monad m => Maybe Text -> m (Search Book)
66searchBook Nothing = return (mkSearch "" books)
67searchBook (Just q) = return (mkSearch q books')
69 where books' = filter (\b -> q' `T.isInfixOf` T.toLower (author b)
70 || q' `T.isInfixOf` T.toLower (title b)
71 )
72 books
73 q' = T.toLower q
75type API = "point" :> Get '[JSON] Point
76 :<|> "books" :> QueryParam "q" Text :> Get '[JSON] (Search Book)
78type API' = API :<|> Raw
80api :: Proxy API
81api = Proxy
83api' :: Proxy API'
84api' = Proxy
86server :: Server API
87server = randomPoint
88 :<|> searchBook
90server' :: Server API'
91server' = server
92 :<|> serveDirectory "tutorial/t9"
94apiJS :: String
95apiJS = jsForAPI api
97writeJSFiles :: IO ()
98writeJSFiles = do
99 writeFile "tutorial/t9/api.js" apiJS
100 jq <- readFile =<< JQ.file
101 writeFile "tutorial/t9/jq.js" jq
103app :: Application
104app = serve api' server'