Isomorphic web apps

in Haskell

LilleFP12
2019-02-27

Julien Dehos

Introduction to Haskell

The Haskell programming language

  • static typing, purely functional, lazy evaluation
  • compilers: Ghc, Ghcjs, Asterius...
  • users: Facebook (Sigma), Microsoft (Bond), LumiGuide, Well-typed, Tweag.io, Galois...

State of the Haskell ecosystem

  • server-side web programming:
    • "mature"
    • warp, servant, yesod, snap, authenticate...
  • front-end web programming:
    • "immature"
    • ghcjs, reflex, miso... (Elm, Purescript)

Learning curves

Haskell is simple (≠ easy)

  • function
  • type
  • algebraic data type
  • type class

Function

Function

  • definition:
  • 
    Prelude> lerp a b x = a + x*(b-a)
    
  • application:
  • 
    Prelude> lerp 2 4 0.5
    3.0
    

Function

  • partial application:
  • 
    Prelude> lerp24 = lerp 2 4
    
    Prelude> lerp24 0.5
    3.0
    
  • lambda function:
  • 
    Prelude> lerp24 = \ x -> lerp 2 4 x
    

Function

  • chaining functions:
  • 
    Prelude> half x = x / 2
    
    Prelude> lerp24 (half (half 2))    -- the () define the priorities
    3.0
    
    Prelude> lerp24 $ half $ half 2    -- $ is the application operator
    3.0
    

Function

  • composition:
  • 
    Prelude> lerp24_after_2_half = lerp24 . half . half
    
    Prelude> lerp24_after_2_half 2
    3.0
    
    Prelude> lerp24_after_2_half = lerp 2 4 . half . half
    

Function

  • pattern matching:
  • 
    formatNumber 1 = "one"
    formatNumber _ = "many"
    
  • case:
  • 
    formatNumber x = case x of
        1 -> "one"
        otherwise -> "many"
    
  • ...

Type

Type

  • static typing, inference...
  • predefined types:
  • 
    Int
    Double
    String
    Char
    Bool 
    ...
    

Type

  • function type:
  • 
    half :: Double -> Double
    half = (/2)
    
  • currying:
  • 
    lerp :: Double -> Double -> Double -> Double
    lerp a b x = a + x*(b-a)
    
    -- or: lerp = \ a -> \ b -> \ x -> a + x*(b-a)
    

Type

  • list:
  • 
    Prelude> [13, 37] :: [Int]
    [13,37]
    
    Prelude> 13:37:[]
    [13,37]
    
  • list comprehension
  • map/filter/reduce
  • recursion, tail recursion...

algebraic data type

algebraic data type

  • sum type:
  • 
    data Color = Blue | White | Red
    
    getCode :: Color -> String
    getCode Blue  = "#0000FF"
    getCode White = "#FFFFFF"
    getCode Red   = "#FF0000"
    
    main = putStrLn $ getCode Red
    
    
    #FF0000
    

algebraic data type

  • product type:
  • 
    data Rectangle = Rectangle Double Double
    
    getArea :: Rectangle -> Double
    getArea (Rectangle w h) = w*h
    
    main = print $ getArea $ Rectangle 4 2
    
    
    8.0
    

algebraic data type

  • algebraic type (sum of product type):
  • 
    data Shape = Disk Double | Rectangle Double Double
    
    getArea :: Shape -> Double
    getArea (Disk r) = pi*r^2
    getArea (Rectangle w h) = w*h
    
    main = do
        print $ getArea $ Disk 2
        print $ getArea $ Rectangle 4 2
    
    
    12.566370614359172
    8.0
    

algebraic data type

  • record:
  • 
    data Rectangle = Rectangle
        { rectangleWidth :: Double
        , height_        :: Double
        } 
    
    r1 = Rectangle 4 2
    
    r2 = Rectangle { height_ = 2, rectangleWidth = 4 }
    
    r3 = r1 { rectangleWidth = 42 }
    
    w3 :: Double
    w3 = rectangleWidth r3
    

algebraic data type

  • parametric type:
  • 
    data Rectangle a = Rectangle a a
    
    r1 :: Rectangle Int
    r1 = Rectangle 4 2
    
    r2 :: Rectangle Double
    r2 = Rectangle 42 13.37
    

algebraic data type

  • type constraint:
  • 
    data Rectangle a = Rectangle a a
    
    getArea :: Num a => Rectangle a -> a
    getArea (Rectangle w h) = w*h
    
    main = do
        print $ getArea $ Rectangle (21::Int) 2
        print $ getArea $ Rectangle (21::Double) 2
    
    
    42
    42.0
    

type class

type class

  • type class: a set of function signatures
  • instance: a type implementing these functions
  • (≈ Java interface)

type class

  • defining a type class:
  • 
    class Show a where
        show :: a -> String
    

type class

  • instantiation:
  • 
    data Color = Blue | White | Red
    
    instance Show Color where
        show Blue  = "Blue"
        show White = "White"
        show Red   = "Red"
    
    main = putStrLn $ show Red
    -- or: main = print Red
    
    
    Red
    

type class

  • derivation:
  • 
    data Color = Blue | White | Red
        deriving (Show)
    
    main = print Red
    
    
    Red
    

some useful data types

some useful data types

  • Maybe:
  • 
    data Maybe a = Nothing | Just a
    
    
    safeSqrt :: Double -> Maybe Double
    safeSqrt x = if x > 0 then Just (sqrt x) else Nothing
    
    main = do
        print $ safeSqrt (-1)
        print $ safeSqrt 1764
    
    
    Nothing
    Just 42.0
    

some useful data types

  • Either:
  • 
    data Either a b = Left a | Right b
    
    
    safeSqrt :: Double -> Either String Double
    safeSqrt x = if x > 0 then Right (sqrt x) else Left "invalid number"
    
    main = do
        print $ safeSqrt (-1)
        print $ safeSqrt 1764
    
    
    Left "invalid number"
    Right 42.0
    

some useful type classes

type class

  • predefined type classes:

some useful type classes

  • the "No Such Typeclass":
  • 
    import Data.Char (toUpper)
    
    getName :: IO String        -- define IO actions
    getName = do                -- using the "do notation"
        putStrLn "Name ?" 
        line <- getLine
        pure $ map toUpper line
    
    main :: IO ()
    main = do
        name <- getName
        putStrLn $ "Hello " ++ name
    

Isomorphic web apps in Haskell

"Isomorphic JS"

Running an isomorphic app: initial load

Running an isomorphic app: SPA flow

Example: heroes-1.0

Demo

Example: heroes-1.0

what we need

  • file/api server
  • single-page app / several-page app
  • type-safe XMLHttpRequest
  • isomorphic routing/rendering

what we build

  • server: ghc Common.hs server.hs → server
  • client: ghcjs Common.hs client.hs → all.js

the main client page

  • dynamically generated in the final isomorphic app
  • temporary hack in first apps (/test.html):

<!DOCTYPE html>
<html>
  <head>
    <meta charset="utf-8">
    <script type="text/javascript" src="static/all.js" async defer> </script>
  </head>
  <body> </body>
</html>

Web API

Aeson (the father of Jason)

  • JSON parsing/encoding (fast, simple/flexible)
  • using type classes, encoding/decoding functions

-- Common.hs

data Hero = Hero
    { heroName :: MisoString
    , heroImage :: MisoString
    } deriving (Eq, Generic, Show)

instance FromJSON Hero  -- parse Hero from JSON data

instance ToJSON Hero    -- encode Hero to JSON data

Aeson


main :: IO ()
main = do
    BS.putStrLn $ encode $ Hero "toto" "42"
    testDec "{\"heroName\":\"toto\", \"heroImage\":\"42\"}"
    testDec "{\"heroName\":\"toto\", \"heroImage\":42}"
    testDec "{\"heroName\":\"toto\"}"
    testDec "{\"heroName\":\"toto\", \"heroImage\":\"42\", \"x\":7}"

testDec = print . (decode :: BS.ByteString -> Maybe Hero)

{"heroImage":"42","heroName":"toto"}
Just (Hero {heroName = "toto", heroImage = "42"})
Nothing
Nothing
Just (Hero {heroName = "toto", heroImage = "42"})

Servant

  • web API as a Haskell type
  • for writing type-safe web apps, deriving clients (Haskell, JavaScript...), generating documentation...
  • tutorial, cookbook

define common routes


-- Common.hs

type HeroesApi = "heroes" :>  Get '[JSON] [Hero] 
-- ex: /heroes

type AddApi =  
    "add" :> Capture "x" Int :> Capture "y" Int :> Get '[JSON] Int
-- ex: /add/20/22

type StaticApi = "static" :> Raw 
-- ex: /static/scoobydoo.png

define and serve the API


-- server.hs

type ServerApi
    =    HeroesApi
    :<|> AddApi
    :<|> StaticApi
    :<|> Raw    -- temporary hack for serving /test.html

server :: Server ServerApi
server 
    =    pure heroes
    :<|> (\ x y -> pure $ x + y)
    :<|> serveDirectoryFileServer "static"
    :<|> serveDirectoryFileServer "./"    -- temporary hack

heroes = [ Hero "Scooby Doo" "scoobydoo.png"
         , Hero "Sponge Bob" "spongebob.png" ]

main server function


-- server.hs

main :: IO ()
main = run 3000 $ serve (Proxy @ServerApi) server

test with curl


$ curl localhost:3000/heroes
[{"heroImage":"scoobydoo.png","heroName":"Scooby Doo"}
,{"heroImage":"spongebob.png","heroName":"Sponge Bob"}]

$ curl localhost:3000/add/22/20
42

$ curl localhost:3000/test.html
<!DOCTYPE html>
<html>
  <head>
    <meta charset="utf-8">
    <script type="text/javascript" src="static/all.js" async defer> </script>
  </head>
  <body> </body>
</html>

XHR


-- client.hs

main :: IO ()
main = do
    heroes <- xhrHeroes
    print heroes

xhrHeroes :: IO [Hero]
xhrHeroes = do
    let uri = ms "heroes"
    let request = Request GET uri Nothing [] False NoData
    response <- xhrByteString request
    pure $ fromMaybe [] $ decodeStrict $ fromJust $ contents response

heroes-0.1

Demo

heroes-0.1

Front-end web app

Miso

  • "isomorphic" front-end framework
  • with HTML DSL, virtual-dom, type-safe routing, server-sent events, websockets, FFI...
  • using ghcjs
  • influenced by Elm, Redux and Bobril

The Elm Architecture

model and actions


-- Common.hs

data Model = Model 
    { heroes_ :: [Hero]
    } deriving (Eq)

initModel :: Model
initModel = Model []

data Action
    = NoOp
    | PopHeroes         -- remove one hero in the model
    | SetHeroes [Hero]  -- set heroes in the model
    | FetchHeroes       -- request the API (XHR)
    deriving (Eq)

update function


-- client.hs

updateModel :: Action -> Model -> Effect Action Model

updateModel NoOp m = noEff m

updateModel PopHeroes m =
    if null (heroes_ m)
    then noEff m
    else noEff m { heroes_ = tail (heroes_ m) }
-- remove first hero if the list is not empty

updateModel (SetHeroes heroes) m = noEff m { heroes_ = heroes }

updateModel FetchHeroes m = m <# (SetHeroes <$> xhrHeroes)
-- request the API and handle the results with a SetHeroes action

home view


-- Common.hs

homeView :: Model -> View Action
homeView m = div_ 
    []
    [ h1_ [] [ text "Heroes - Home" ]
    , button_ [ onClick FetchHeroes ] [ text "FetchHeroes" ]
    , button_ [ onClick PopHeroes ] [ text "PopHeroes" ]
    , ul_ [] (map fmtHero $ heroes_ m)
    , p_ [] [ a_ [href_ "heroes"] [ text "GET: heroes" ] ] 
    , p_ [] [ a_ [href_ "add/20/22"] [ text "GET: add 20 22" ] ] 
    ]
    where fmtHero h = li_ [] 
            [ text $ heroName h
            , br_ []
            , img_ [ src_ $ concat ["static/", heroImage h] ]
            ]

main app


-- client.hs

main :: IO ()
main = startApp App
    { initialAction = NoOp
    , model = initModel
    , update = updateModel
    , view = homeView
    , events = defaultEvents
    , subs = []
    , mountPoint = Nothing
    }

heroes-0.2

Demo

heroes-0.2

Isomorphic routing

Problem: hard-coded strings for URIs


-- client.hs

xhrHeroes =
    let uri = ms "heroes"
    ...

-- Common.hs

homeView m = div_ 
    ...
    , p_ [] [ a_ [href_ "add/20/22"] [ text "GET: add 20 22" ] ] 
    ]
    where fmtHero h = 
            ...
            , img_ [ src_ $ concat ["static/", heroImage h] ]
            ]

derive links from the API


-- Common.hs

type PublicApi = HeroesApi :<|> AddApi :<|> StaticApi

linkHeroes :: URI
linkHeroes = linkURI $ safeLink (Proxy @PublicApi) (Proxy @HeroesApi)

linkAdd :: Int -> Int -> URI
linkAdd x y = linkURI (safeLink (Proxy @PublicApi) (Proxy @AddApi) x y)

linkStatic :: URI
linkStatic = linkURI $ safeLink (Proxy @PublicApi) (Proxy @StaticApi)

mkStatic :: MisoString -> MisoString
mkStatic filename = concat [ms $ show linkStatic, "/", filename]

use links for URIs


-- client.hs

xhrHeroes = 
    let uri = ms $ show linkHeroes
    ...

-- Common.hs

homeView m = 
    ...
    , p_ [] [ a_ [href_ $ ms $ show $ linkAdd 20 22 ] [ text "GET: add 20 22" ] ] 
    ]
    where fmtHero h = 
            ...
            , img_ [ src_ $ mkStatic (heroImage h) ]
            ]

Client routes

define API & links


-- Common.hs

type HomeRoute = View Action
type AboutRoute = "about" :> View Action
type ClientRoutes = HomeRoute :<|> AboutRoute

homeRoute :: URI
homeRoute = linkURI $ safeLink (Proxy @ClientRoutes) (Proxy @HomeRoute)

aboutRoute :: URI
aboutRoute = linkURI $ safeLink (Proxy @ClientRoutes) (Proxy @AboutRoute)

define client views


-- Common.hs

clientViews :: (Model -> View Action) :<|> (Model -> View Action)
clientViews = homeView :<|> aboutView

homeView :: Model -> View Action
homeView m = div_ 
    []
    [ h1_ [] [ text "Heroes - Home" ]
    , button_ [ onClick $ ChangeUri aboutRoute ] [ text "About" ]
...

aboutView :: Model -> View Action
...

define client routing


-- Common.hs

viewModel :: Model -> View Action
viewModel m = 
    case runRoute (Proxy @ClientRoutes) clientViews uri_ m of
        Left _ -> text "not found"
        Right v -> v

-- find the view function (homeView or aboutView)
-- from the current client route (homeRoute or aboutRoute)

add current URI & actions


-- Common.hs

data Model = Model 
    { heroes_ :: [Hero]
    , uri_ :: URI           -- current client route 
    } deriving (Eq)

initModel :: URI -> Model
initModel = Model []

data Action
    = NoOp
    ...
    | SetUri URI       -- set the current client route in the model
    | ChangeUri URI    -- ask to change the current client route
    deriving (Eq)

handle current URI


-- client.hs

...

updateModel (SetUri uri) m = noEff m { uri_ = uri }

updateModel (ChangeUri uri) m = m <# (pushURI uri >> pure NoOp)
                                   -- send a uri event

main :: IO ()
main = startApp App 
    { model = initModel homeRoute
    , view = viewModel
    , subs = [ uriSub SetUri ]   -- subscribe to uri events
    ...
    }

heroes-0.4

Demo

heroes-0.4

Isomorphic rendering

add client routes in server API


-- server.hs

type ServerApi
    =    HeroesApi
    :<|> AddApi
    :<|> StaticApi
    :<|> ToServerRoutes ClientRoutes HtmlPage Action  -- client routes

serve client routes


-- server.hs

server :: Server ServerApi
server 
    =    pure heroes
    :<|> (\ x y -> pure $ x + y)
    :<|> serveDirectoryFileServer "static"
    :<|> (handleHome :<|> handleAbout)       -- client routes

handleHome :: Handler (HtmlPage (View Action))
handleHome = pure $ HtmlPage $ homeView $ initModel homeRoute
-- render homeRoute using homeView

handleAbout :: Handler (HtmlPage (View Action))
handleAbout = pure $ HtmlPage $ aboutView $ initModel aboutRoute
-- render aboutRoute using aboutView

define server-side rendering


-- server.hs

import qualified Lucid as L

newtype HtmlPage a = HtmlPage a
    deriving (Show, Eq)

instance L.ToHtml a => L.ToHtml (HtmlPage a) where
    toHtmlRaw = L.toHtml
    toHtml (HtmlPage x) = L.doctypehtml_ $ do
        L.head_ $ do
            L.meta_ [L.charset_ "utf-8"]
            L.with 
                (L.script_ mempty) 
                [L.src_ (mkStatic "all.js"), L.async_ mempty, L.defer_ mempty] 
        L.body_ (L.toHtml x)
        -- dynamically render the main page, containing a client view

start client app


-- client.hs

main :: IO ()
main = miso $ \ currentUri -> App 
    { model = initModel currentUri
    ...

-- start client app using a given client route

heroes-0.5

Demo

heroes-0.5

Conclusion

Isomorphic web apps in Haskell

  • Miso: Elm-like framework
  • Servant: web API, server...
  • isomorphic routing & rendering
  • type-safety
  • in Haskell

But

  • building ghcjs+servant+miso takes about 2 hours and more than 4 GB RAM
  • SPA size (but closurecompiler+gzip: 2.5M → 293K)
  • learning curves (but nice communities !)

Slides & source code

Thank you !

Questions ?