106 lines
2.6 KiB
Haskell
106 lines
2.6 KiB
Haskell
{-# 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 Servant.JS.JQuery
|
|
import System.Random
|
|
|
|
import qualified Data.Text as T
|
|
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
|
|
|
|
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 :: String
|
|
apiJS = jsForAPI api jquery
|
|
|
|
writeJSFiles :: IO ()
|
|
writeJSFiles = do
|
|
writeFile "tutorial/t9/api.js" apiJS
|
|
jq <- readFile =<< JQ.file
|
|
writeFile "tutorial/t9/jq.js" jq
|
|
|
|
app :: Application
|
|
app = serve api' server'
|