git clone https://github.com/emhoracek/monadic-party-fn
cd monadic-party-fn
brew install postgresql || apt-get postgresql
stack setup
stack build
Q: Is it possible to write a function like this?
Q: How would a web app like this be limited?
How does the type need to change
to deal with all this?
sayHello = do
name <- getLine
putStrLn ("Hello " ++ name)
getLine :: IO Text
putStrLn :: IO ()
simple & easy to use
no Template Haskell
no language extensions required
the way the typed routes work is really cool :o
data Ctxt = Ctxt { req :: FnRequest
, db :: Pool Connection
, redis :: Redis.Connection
, config :: Config
... etc ... }
myHandler :: Ctxt -> UserId -> IO (Maybe Response)
myHandler ctxt userId = do
mUser <- getUserById (db ctxt) userId
...
getUserById :: Pool Connection -> UserId -> IO (Maybe User)
data Ctxt = Ctxt { req :: FnRequest
, enviroment :: String
, sendMail :: (String -> IO ())
... etc ... }
data MyCtxt = MyCtxt { likesPizza :: Bool
, request :: FnRequest
, favoriteColor :: Text }
You can make whatever datatype you want, with whatever fields you want! Just make sure to include a field for Fn's `FnRequest`
data TinyCtxt = TinyCtxt FnRequest
src/FirstSite.hs
data Character =
Character { charaName :: String
, charaClass :: Class }
data Class = Bard | Fighter | Druid | Paladin
character = Character "Hela" Fighter
> print character <interactive>:10:1: error: • No instance for (Show Character) arising from a use of ‘print’
print :: Show a => a -> IO ()
src/Typeclasses.hs
data Character =
Character { charaName :: String
, charaClass :: Class }
deriving Show
data Class = Bard | Fighter | Druid | Paladin
deriving Show
character = Character "Hela" Fighter
> character Character {charaName = "Hela", charaClass = Fighter}
src/Typeclasses.hs
data Character =
Character { charaName :: String
, charaClass :: Class }
instance Show Character where
show (Character cName cClass) =
cName ++ " is the " ++ show cClass
data Class = Bard | Fighter | Druid | Paladin
deriving Show
character = Character "Hela" Fighter
> character Hela is the Fighter
src/Typeclasses.hs
data Ctxt = Ctxt FnRequest
instance RequestContext Ctxt where
getRequest (Ctxt req) = req
setRequest (Ctxt oldReq) newReq = Ctxt newReq
Make your type an instance of RequestContext!
data Context = Context { likesPizza :: Bool
, request :: FnRequest
, favoriteColor :: Text }
instance RequestContext Context where
getRequest context = request context
setRequest context newReq = context { request = newReq }
src/FirstSite.hs
Web Application Interface
Common interface for frameworks and libraries
Lots of nice middleware for logging, sessions, etc
the actual server
import Web.Fn
import Network.Wai (Application)
import Network.Wai.Handler.Warp (run)
main :: IO ()
main = run 8000 waiApp
initCtxt :: Ctxt
initCtxt = Ctxt defaultFnRequest
waiApp :: Application
waiApp = toWAI initCtxt site
run :: Int → Application → IO ()
toWAI :: ctxt → (ctxt → IO Response) → Application
site :: ctxt → IO Response
src/FirstSite.hs
site :: Ctxt -> IO Response
site ctxt =
route ctxt [ end ==> indexH ]
`fallthrough` notFoundText "Page not found."
indexH :: Ctxt -> IO (Maybe Response)
indexH ctxt = okText "Welcome to my first Haskell website."
src/FirstSite.hs
import Web.Fn
import Network.Wai (Application, Response)
import Network.Wai.Handler.Warp (run)
data Ctxt = Ctxt FnRequest
instance RequestContext Ctxt where
getRequest (Ctxt req) = req
setRequest (Ctxt oldReq) newReq = Ctxt newReq
site :: Ctxt -> IO Response
site ctxt =
route ctxt [ end ==> indexH ]
`fallthrough` notFoundText "Page not found."
indexH :: Ctxt -> IO (Maybe Response)
indexH ctxt = okText "Welcome to my first Haskell website."
main :: IO ()
main = run 8000 waiApp
initCtxt :: Ctxt
initCtxt = Ctxt defaultFnRequest
waiApp :: Application
waiApp = toWAI initCtxt site
src/FirstSite.hs
routes :: Ctxt -> IO (Maybe Response)
routes ctxt =
route ctxt [ {- maybe matches ==> maybe handles -}
, {- maybe matches ==> maybe handles -}
, {- maybe matches ==> maybe handles -} ]
site :: Ctxt -> IO Response
site = routes ctxt `fallthrough` notFoundText "not found"
maybe a route matches, maybe a handler returns a response
if not: fallthrough to this other response
end path "blah" method "GET" anything
matches when there's nothing left
matches "blah"
matches only GET requests
matches anything!
segment param "blah"
passes a segment to the handler
passes the value of param "blah" to the the handler
site :: Ctxt -> IO Response
site ctxt =
route ctxt [ end ==> indexH
, path "hello" // segment ==> helloNameH ]
`fallthrough` notFoundText "Page not found."
helloNameH :: Ctxt -> Text -> IO (Maybe Response)
helloNameH ctxt name = okText ("Hello, " <> name <> "!")
helloNameH handles "/hello/party"
"Hello, party!"
site :: Ctxt -> IO Response
site ctxt =
route ctxt [ end ==> indexH
, path "hello" // param "name" ==> helloNameH ]
`fallthrough` notFoundText "Page not found."
helloNameH :: Ctxt -> Text -> IO (Maybe Response)
helloNameH ctxt name = okText ("Hello, " <> name <> "!")
helloNameH handles "/hello?name=party"
site :: Ctxt -> IO Response
site ctxt =
route ctxt [ end ==> indexH
, path "hello" // segment ==> helloNameH
, path "hello" // param "name" ==> helloNameH ]
`fallthrough` notFoundText "Page not found."
helloNameH :: Ctxt -> Text -> IO (Maybe Response)
helloNameH ctxt name = okText ("Hello, " <> name <> "!")
helloNameH handles "/hello/party" and "/hello?name=party"
Maybe?
data Maybe a = Just a | Nothing
Maybe String = Just String | Nothing
Maybe Int = Just Int | Nothing
Maybe (String -> Int) = Just (String -> Int) | Nothing
listToMaybe :: [a] -> Maybe a
listToMaybe [1,2,3] = Just 1
listToMaybe [] = Nothing
*** Exception: Prelude.head: empty list
head :: [a] -> a
head [1,2,3] = 1
head [] = ???
site :: Ctxt -> IO Response
site ctxt =
route ctxt [ end ==> indexH
, path "hello" // segment ==> helloNameH
, path "hello" // segment ==> rudeHelloH ]
`fallthrough` notFoundText "Page not found."
helloNameH :: Ctxt -> Text -> IO (Maybe Response)
helloNameH ctxt name =
if name == "Libby"
then return Nothing
else okText ("Hello, " <> name <> "!")
rudeHelloH :: Ctxt -> Text -> IO (Maybe Response)
rudeHelloH ctxt name = okText "ugh, you again"
site :: Ctxt -> IO Response
site ctxt =
route ctxt [ end ==> indexH
, path "add" // segment
// segment
==> addNumbersH
, path "add" // segment
// segment
==> addWordsH ]
`fallthrough` notFoundText "Page not found."
Same pattern, but two different handlers
localhost:8000/add/(segment)/(segment)
addNumbersH :: Ctxt -> Int -> Int -> IO (Maybe Response)
addNumbersH ctxt number1 number2 =
let sum = number1 + number2 in
okText (tshow number1 <> " plus " <>
tshow number2 <> " is " <> tshow sum <> ".")
addWordsH :: Ctxt -> Text -> Text -> IO (Maybe Response)
addWordsH ctxt word1 word2 =
okText (word1 <> " plus " <> word2 <>
" is " <> word1 <> word2 <> ".")
localhost:8000/add/1/2
1 plus 2 is 3
localhost:8000/add/monadic/party
monadic plus party is monadic party
site :: Ctxt -> IO Response
site ctxt =
route ctxt [ end ==> indexH
, path "hello" // param "name" ==> helloH
, path "add" // segment // segment ==> addNumbersH
, path "add" // segment // segment ==> addWordsH ]
`fallthrough` notFoundText "Page not found."
addNumbersH :: Ctxt -> Int -> Int -> IO (Maybe Response)
addNumbersH ctxt number1 number2 =
let sum = number1 + number2 in
okText (tshow number1 <> " plus " <>
tshow number2 <> " is " <> tshow sum <> ".")
addWordsH :: Ctxt -> Text -> Text -> IO (Maybe Response)
addWordsH ctxt word1 word2 =
okText (word1 <> " plus " <> word2 <> " is " <> word1 <> word2 <> ".")
no arguments
one Text argument
two Int arguments
two Text arguments
this is a list of Routes that all seem very different -- how are they the same type?
https://slides.com/emhoracek/web-dev-with-fn-21/