@@ -0,0 +1,101 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE TypeFamilies #-}
3+{-# LANGUAGE DeriveGeneric #-}
4+{-# LANGUAGE TypeOperators #-}
5+module GS9 where
6+
7+import Control.Applicative
8+import Control.Monad.IO.Class
9+import Data.Aeson
10+import Data.Char
11+import Data.List
12+import GHC.Generics
13+import qualified Language.Javascript.JQuery as JQ
14+import Math.Probable
15+import Network.Wai
16+import Servant
17+import Servant.JQuery
18+
19+data Point = Point
20+ { x :: Double
21+ , y :: Double
22+ } deriving Generic
23+
24+instance ToJSON Point
25+
26+randomPoint :: MonadIO m => m Point
27+randomPoint = liftIO . mwc $ Point <$> d <*> d
28+
29+ where d = doubleIn (-1, 1)
30+
31+data Search a = Search
32+ { query :: String
33+ , results :: [a]
34+ } deriving Generic
35+
36+mkSearch :: String -> [a] -> Search a
37+mkSearch = Search
38+
39+instance ToJSON a => ToJSON (Search a)
40+
41+data Book = Book
42+ { author :: String
43+ , title :: String
44+ , year :: Int
45+ } deriving Generic
46+
47+instance ToJSON Book
48+
49+book :: String -> String -> Int -> Book
50+book = Book
51+
52+books :: [Book]
53+books =
54+ [ book "Paul Hudak" "The Haskell School of Expression: Learning Functional Programming through Multimedia" 2000
55+ , book "Bryan O'Sullivan, Don Stewart, and John Goerzen" "Real World Haskell" 2008
56+ , book "Miran Lipovača" "Learn You a Haskell for Great Good!" 2011
57+ , book "Graham Hutton" "Programming in Haskell" 2007
58+ , book "Simon Marlow" "Parallel and Concurrent Programming in Haskell" 2013
59+ , book "Richard Bird" "Introduction to Functional Programming using Haskell" 1998
60+ ]
61+
62+searchBook :: Monad m => Maybe String -> m (Search Book)
63+searchBook Nothing = return (mkSearch "" books)
64+searchBook (Just q) = return (mkSearch q books')
65+
66+ where books' = filter (\b -> q' `isInfixOf` map toLower (author b)
67+ || q' `isInfixOf` map toLower (title b)
68+ )
69+ books
70+ q' = map toLower q
71+
72+type API = "point" :> Get '[JSON] Point
73+ :<|> "books" :> QueryParam "q" String :> Get '[JSON] (Search Book)
74+
75+type API' = API :<|> Raw
76+
77+api :: Proxy API
78+api = Proxy
79+
80+api' :: Proxy API'
81+api' = Proxy
82+
83+server :: Server API
84+server = randomPoint
85+ :<|> searchBook
86+
87+server' :: Server API'
88+server' = server
89+ :<|> serveDirectory "getting-started/gs9"
90+
91+apiJS :: String
92+apiJS = jsForAPI api
93+
94+writeJSFiles :: IO ()
95+writeJSFiles = do
96+ writeFile "getting-started/gs9/api.js" apiJS
97+ jq <- readFile =<< JQ.file
98+ writeFile "getting-started/gs9/jq.js" jq
99+
100+app :: Application
101+app = serve api' server'