From 616b203792e044595348af971e7469f6abe1a24f Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Sat, 9 May 2015 16:05:09 +0200 Subject: [PATCH] examples: add GS10 --- servant-examples/getting-started/GS10.hs | 94 +++++++++++++++++++ servant-examples/getting-started/GS9.hs | 28 +++--- .../getting-started/getting-started.hs | 2 + servant-examples/servant-examples.cabal | 8 +- 4 files changed, 118 insertions(+), 14 deletions(-) create mode 100644 servant-examples/getting-started/GS10.hs diff --git a/servant-examples/getting-started/GS10.hs b/servant-examples/getting-started/GS10.hs new file mode 100644 index 00000000..3456df2f --- /dev/null +++ b/servant-examples/getting-started/GS10.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE MultiParamTypeClasses #-} +module GS10 where + +import Data.ByteString.Lazy (ByteString) +import Data.Text.Lazy (pack) +import Data.Text.Lazy.Encoding (encodeUtf8) +import Network.HTTP.Types +import Network.Wai +import Servant +import Servant.Docs +import Servant.Docs.Pandoc (pandoc) +import Text.Pandoc.Options (def, WriterOptions(..)) +import Text.Pandoc.Writers.HTML (writeHtmlString) +import qualified GS3 + +type DocsAPI = GS3.API :<|> Raw + +instance ToCapture (Capture "x" Int) where + toCapture _ = DocCapture "x" "(integer) position on the x axis" + +instance ToCapture (Capture "y" Int) where + toCapture _ = DocCapture "y" "(integer) position on the y axis" + +instance ToSample GS3.Position GS3.Position where + toSample _ = Just (GS3.Position 3 14) + +instance ToParam (QueryParam "name" String) where + toParam _ = + DocQueryParam "name" + ["Alp", "John Doe", "..."] + "Name of the person to say hello to." + Normal + +instance ToSample GS3.HelloMessage GS3.HelloMessage where + toSamples _ = + [ ("When a value is provided for 'name'", GS3.HelloMessage "Hello, Alp") + , ("When 'name' is not specified", GS3.HelloMessage "Hello, anonymous coward") + ] + +ci :: GS3.ClientInfo +ci = GS3.ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"] + +instance ToSample GS3.ClientInfo GS3.ClientInfo where + toSample _ = Just ci + +instance ToSample GS3.Email GS3.Email where + toSample _ = Just (GS3.emailForClient ci) + +api :: Proxy DocsAPI +api = Proxy + +docsBS :: ByteString +docsBS = encodeUtf8 + . pack + . writeHtmlString opts + . pandoc + $ docsWithIntros [intro] GS3.api + + where opts = def { writerHtml5 = True + , writerTableOfContents = True + , writerHighlight = True + , writerStandalone = True + , writerTemplate = + concat + [ "" + , "" + , "" + , "API Docs - $title$" + , "" + , "" + , "$toc$" + , "
" + , "$body$" + , "" + , "" + ] + } + intro = DocIntro "Welcome" ["This is our super webservice's API.", "Enjoy!"] + +server :: Server DocsAPI +server = GS3.server :<|> serveDocs + + where serveDocs _ respond = + respond $ responseLBS ok200 [html] docsBS + + html = ("Content-Type", "text/html") + +app :: Application +app = serve api server diff --git a/servant-examples/getting-started/GS9.hs b/servant-examples/getting-started/GS9.hs index 3d7a16c6..23b65514 100644 --- a/servant-examples/getting-started/GS9.hs +++ b/servant-examples/getting-started/GS9.hs @@ -2,20 +2,22 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE OverloadedStrings #-} module GS9 where import Control.Applicative import Control.Monad.IO.Class import Data.Aeson -import Data.Char -import Data.List +import Data.Text (Text) import GHC.Generics -import qualified Language.Javascript.JQuery as JQ import Math.Probable import Network.Wai import Servant import Servant.JQuery +import qualified Data.Text as T +import qualified Language.Javascript.JQuery as JQ + data Point = Point { x :: Double , y :: Double @@ -29,24 +31,24 @@ randomPoint = liftIO . mwc $ Point <$> d <*> d where d = doubleIn (-1, 1) data Search a = Search - { query :: String + { query :: Text , results :: [a] } deriving Generic -mkSearch :: String -> [a] -> Search a +mkSearch :: Text -> [a] -> Search a mkSearch = Search instance ToJSON a => ToJSON (Search a) data Book = Book - { author :: String - , title :: String + { author :: Text + , title :: Text , year :: Int } deriving Generic instance ToJSON Book -book :: String -> String -> Int -> Book +book :: Text -> Text -> Int -> Book book = Book books :: [Book] @@ -59,18 +61,18 @@ books = , book "Richard Bird" "Introduction to Functional Programming using Haskell" 1998 ] -searchBook :: Monad m => Maybe String -> m (Search Book) +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' `isInfixOf` map toLower (author b) - || q' `isInfixOf` map toLower (title b) + where books' = filter (\b -> q' `T.isInfixOf` T.toLower (author b) + || q' `T.isInfixOf` T.toLower (title b) ) books - q' = map toLower q + q' = T.toLower q type API = "point" :> Get '[JSON] Point - :<|> "books" :> QueryParam "q" String :> Get '[JSON] (Search Book) + :<|> "books" :> QueryParam "q" Text :> Get '[JSON] (Search Book) type API' = API :<|> Raw diff --git a/servant-examples/getting-started/getting-started.hs b/servant-examples/getting-started/getting-started.hs index d0b90950..b1335af7 100644 --- a/servant-examples/getting-started/getting-started.hs +++ b/servant-examples/getting-started/getting-started.hs @@ -10,6 +10,7 @@ import qualified GS5 import qualified GS6 import qualified GS7 import qualified GS9 +import qualified GS10 app :: String -> (Application -> IO ()) -> IO () app n f = case n of @@ -22,6 +23,7 @@ app n f = case n of "7" -> f GS7.app "8" -> f GS3.app "9" -> GS9.writeJSFiles >> f GS9.app + "10" -> f GS10.app _ -> usage main :: IO () diff --git a/servant-examples/servant-examples.cabal b/servant-examples/servant-examples.cabal index dab0ab5f..7bc9e77a 100644 --- a/servant-examples/servant-examples.cabal +++ b/servant-examples/servant-examples.cabal @@ -15,19 +15,25 @@ cabal-version: >=1.10 executable getting-started main-is: getting-started.hs - other-modules: GS1, GS2, GS3, GS4, GS5, GS6, GS7, GS8, GS9 + other-modules: GS1, GS2, GS3, GS4, GS5, GS6, GS7, GS8, GS9, GS10 build-depends: aeson >= 0.8 , base >= 4.7 + , bytestring , directory , either + , http-types , js-jquery , lucid + , pandoc , probable , servant + , servant-docs , servant-jquery , servant-lucid + , servant-pandoc >= 0.2 , servant-server + , text , time , transformers , wai