{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} module T9 where 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 import qualified Data.Text as T import qualified Data.Text.IO as TIO import qualified Language.Javascript.JQuery as JQ 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'') data Search a = Search { query :: Text , results :: [a] } deriving Generic mkSearch :: Text -> [a] -> Search a mkSearch = Search instance ToJSON a => ToJSON (Search a) data Book = Book { author :: Text , title :: Text , year :: Int } deriving Generic instance ToJSON Book book :: Text -> Text -> Int -> Book 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 ] searchBook :: Monad m => Maybe Text -> m (Search Book) searchBook Nothing = return (mkSearch "" books) searchBook (Just q) = return (mkSearch q books') where books' = filter (\b -> q' `T.isInfixOf` T.toLower (author b) || q' `T.isInfixOf` T.toLower (title b) ) books q' = T.toLower q type API = "point" :> Get '[JSON] Point :<|> "books" :> QueryParam "q" Text :> Get '[JSON] (Search Book) type API' = API :<|> Raw IO Application api :: Proxy API api = Proxy api' :: Proxy API' api' = Proxy server :: Server API server = randomPoint :<|> searchBook server' :: Server API' server' = server :<|> serveDirectory "tutorial/t9" apiJS :: Text apiJS = jsForAPI api jquery writeJSFiles :: IO () writeJSFiles = do TIO.writeFile "tutorial/t9/api.js" apiJS jq <- TIO.readFile =<< JQ.file TIO.writeFile "tutorial/t9/jq.js" jq app :: Application app = serve api' EmptyConfig server'