servant/servant-examples/tutorial/T9.hs

106 lines
2.7 KiB
Haskell
Raw Normal View History

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
2015-05-09 16:05:09 +02:00
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
2015-05-10 13:39:18 +02:00
module T9 where
2015-05-09 12:27:45 +02:00
import Control.Applicative
import Control.Monad.IO.Class
import Data.Aeson
import Data.Text (Text)
import GHC.Generics
import Network.Wai
import Servant
import Servant.JS
import System.Random
2015-05-09 12:27:45 +02:00
2015-05-09 16:05:09 +02:00
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
2015-05-09 16:05:09 +02:00
import qualified Language.Javascript.JQuery as JQ
2015-05-09 12:27:45 +02:00
data Point = Point
{ x :: Double
, y :: Double
} deriving Generic
instance ToJSON Point
randomPoint :: MonadIO m => m Point
randomPoint = liftIO . getStdRandom $ \g ->
let (rx, g') = randomR (-1, 1) g
(ry, g'') = randomR (-1, 1) g'
in (Point rx ry, g'')
2015-05-09 12:27:45 +02:00
data Search a = Search
2015-05-09 16:05:09 +02:00
{ query :: Text
2015-05-09 12:27:45 +02:00
, results :: [a]
} deriving Generic
2015-05-09 16:05:09 +02:00
mkSearch :: Text -> [a] -> Search a
2015-05-09 12:27:45 +02:00
mkSearch = Search
instance ToJSON a => ToJSON (Search a)
data Book = Book
2015-05-09 16:05:09 +02:00
{ author :: Text
, title :: Text
2015-05-09 12:27:45 +02:00
, year :: Int
} deriving Generic
instance ToJSON Book
2015-05-09 16:05:09 +02:00
book :: Text -> Text -> Int -> Book
2015-05-09 12:27:45 +02:00
book = Book
books :: [Book]
books =
[ book "Paul Hudak" "The Haskell School of Expression: Learning Functional Programming through Multimedia" 2000
, book "Bryan O'Sullivan, Don Stewart, and John Goerzen" "Real World Haskell" 2008
, book "Miran Lipovača" "Learn You a Haskell for Great Good!" 2011
, book "Graham Hutton" "Programming in Haskell" 2007
, book "Simon Marlow" "Parallel and Concurrent Programming in Haskell" 2013
, book "Richard Bird" "Introduction to Functional Programming using Haskell" 1998
]
2015-05-09 16:05:09 +02:00
searchBook :: Monad m => Maybe Text -> m (Search Book)
2015-05-09 12:27:45 +02:00
searchBook Nothing = return (mkSearch "" books)
searchBook (Just q) = return (mkSearch q books')
2015-05-09 16:05:09 +02:00
where books' = filter (\b -> q' `T.isInfixOf` T.toLower (author b)
|| q' `T.isInfixOf` T.toLower (title b)
2015-05-09 12:27:45 +02:00
)
books
2015-05-09 16:05:09 +02:00
q' = T.toLower q
2015-05-09 12:27:45 +02:00
type API = "point" :> Get '[JSON] Point
2015-05-09 16:05:09 +02:00
:<|> "books" :> QueryParam "q" Text :> Get '[JSON] (Search Book)
2015-05-09 12:27:45 +02:00
type API' = API :<|> Raw
api :: Proxy API
api = Proxy
api' :: Proxy API'
api' = Proxy
server :: Server API
server = randomPoint
:<|> searchBook
server' :: Server API'
server' = server
2015-05-10 13:39:18 +02:00
:<|> serveDirectory "tutorial/t9"
2015-05-09 12:27:45 +02:00
apiJS :: Text
apiJS = jsForAPI api jquery
2015-05-09 12:27:45 +02:00
writeJSFiles :: IO ()
writeJSFiles = do
TIO.writeFile "tutorial/t9/api.js" apiJS
jq <- TIO.readFile =<< JQ.file
TIO.writeFile "tutorial/t9/jq.js" jq
2015-05-09 12:27:45 +02:00
app :: Application
app = serve api' EmptyConfig server'