refactor a bit + add GS2
This commit is contained in:
parent
2b23253a8d
commit
66456cafa2
4 changed files with 81 additions and 9 deletions
|
@ -2,11 +2,12 @@
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
{-# LANGUAGE DeriveGeneric #-}
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
{-# LANGUAGE TypeOperators #-}
|
{-# LANGUAGE TypeOperators #-}
|
||||||
|
module GS1 where
|
||||||
|
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import Data.Time.Calendar
|
import Data.Time.Calendar
|
||||||
import GHC.Generics
|
import GHC.Generics
|
||||||
import Network.Wai.Handler.Warp (run)
|
import Network.Wai
|
||||||
import Servant
|
import Servant
|
||||||
|
|
||||||
data User = User
|
data User = User
|
||||||
|
@ -37,9 +38,5 @@ userAPI = Proxy
|
||||||
server :: Server UserAPI
|
server :: Server UserAPI
|
||||||
server = return users
|
server = return users
|
||||||
|
|
||||||
runServer :: Int -> IO ()
|
app :: Application
|
||||||
runServer port = run port (serve userAPI server)
|
app = serve userAPI server
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = runServer 8081
|
|
||||||
|
|
||||||
|
|
49
servant-examples/getting-started/GS2.hs
Normal file
49
servant-examples/getting-started/GS2.hs
Normal file
|
@ -0,0 +1,49 @@
|
||||||
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
|
{-# LANGUAGE TypeOperators #-}
|
||||||
|
module GS2 where
|
||||||
|
|
||||||
|
import Data.Aeson
|
||||||
|
import Data.Time.Calendar
|
||||||
|
import GHC.Generics
|
||||||
|
import Network.Wai
|
||||||
|
import Servant
|
||||||
|
|
||||||
|
data User = User
|
||||||
|
{ name :: String
|
||||||
|
, age :: Int
|
||||||
|
, email :: String
|
||||||
|
, registration_date :: Day
|
||||||
|
} deriving (Eq, Show, Generic)
|
||||||
|
|
||||||
|
-- orphan ToJSON instance for Day. necessary to derive one for User
|
||||||
|
instance ToJSON Day where
|
||||||
|
-- display a day in YYYY-mm-dd format
|
||||||
|
toJSON d = toJSON (showGregorian d)
|
||||||
|
|
||||||
|
instance ToJSON User
|
||||||
|
|
||||||
|
type UserAPI = "users" :> Get '[JSON] [User]
|
||||||
|
:<|> "albert" :> Get '[JSON] User
|
||||||
|
:<|> "isaac" :> Get '[JSON] User
|
||||||
|
|
||||||
|
isaac :: User
|
||||||
|
isaac = User "Isaac Newton" 372 "isaac@newton.co.uk" (fromGregorian 1683 3 1)
|
||||||
|
|
||||||
|
albert :: User
|
||||||
|
albert = User "Albert Einstein" 136 "ae@mc2.org" (fromGregorian 1905 12 1)
|
||||||
|
|
||||||
|
users :: [User]
|
||||||
|
users = [isaac, albert]
|
||||||
|
|
||||||
|
userAPI :: Proxy UserAPI
|
||||||
|
userAPI = Proxy
|
||||||
|
|
||||||
|
server :: Server UserAPI
|
||||||
|
server = return users
|
||||||
|
:<|> return albert
|
||||||
|
:<|> return isaac
|
||||||
|
|
||||||
|
app :: Application
|
||||||
|
app = serve userAPI server
|
24
servant-examples/getting-started/getting-started.hs
Normal file
24
servant-examples/getting-started/getting-started.hs
Normal file
|
@ -0,0 +1,24 @@
|
||||||
|
import Network.Wai
|
||||||
|
import Network.Wai.Handler.Warp
|
||||||
|
import System.Environment
|
||||||
|
|
||||||
|
import qualified GS1
|
||||||
|
import qualified GS2
|
||||||
|
|
||||||
|
app :: String -> Maybe Application
|
||||||
|
app n = case n of
|
||||||
|
"1" -> Just GS1.app
|
||||||
|
"2" -> Just GS2.app
|
||||||
|
_ -> Nothing
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = do
|
||||||
|
args <- getArgs
|
||||||
|
case args of
|
||||||
|
[n] -> maybe usage (run 8081) (app n)
|
||||||
|
_ -> usage
|
||||||
|
|
||||||
|
usage :: IO ()
|
||||||
|
usage = do
|
||||||
|
putStrLn "Usage:\t getting-started N"
|
||||||
|
putStrLn "\t\twhere N is the number of the example you want to run."
|
|
@ -13,8 +13,9 @@ category: Web
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
cabal-version: >=1.10
|
cabal-version: >=1.10
|
||||||
|
|
||||||
executable getting-started-1
|
executable getting-started
|
||||||
main-is: GS1.hs
|
main-is: getting-started.hs
|
||||||
|
other-modules: GS1, GS2
|
||||||
build-depends:
|
build-depends:
|
||||||
aeson >= 0.8
|
aeson >= 0.8
|
||||||
, base >= 4.7
|
, base >= 4.7
|
||||||
|
@ -22,6 +23,7 @@ executable getting-started-1
|
||||||
, servant
|
, servant
|
||||||
, servant-server
|
, servant-server
|
||||||
, time
|
, time
|
||||||
|
, wai
|
||||||
, warp
|
, warp
|
||||||
hs-source-dirs: getting-started
|
hs-source-dirs: getting-started
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
Loading…
Reference in a new issue