Full Stack Haskell

Michael Beidler @ Metal Toad & Typechecked

Motivation

  • Take advantage of Haskell's advanced type system to write correct, performant, easy-to-refactor code.
  • Replace legacy business applications with Haskell.
  • Minimize time writing UI components.

We've all seen this...

cation

A full-stack Haskell web application template/example.

https://github.com/mbeidler/cation

1

+

cation-server

cation-client

cation-common

GHC

GHCJS

Servant - A Type-Level Web DSL

Define your API in types.

type API = "echo" :> Capture "message" :> Get '[JSON] String

From the type, you can:

  • Write servers

    • For the above type, you only need to provide a handler function:

echo :: String -> Handler String
echo = return
  • Obtain client functions (e.g. in Haskell, JavaScript or other languages)
    • ​react-flux-servant gives us a function for making AJAX calls:
req (Proxy :: Proxy API) "test"
  • Generate documentation
    • ​There are several documentation packages you can use. cation uses servant-swagger to generate Swagger docs.

Type-checked REST Conventions

{-# LANGUAGE DataKinds      #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeOperators  #-}
module Cation.Common.Api.Combinators where

import           Cation.Common.Conventions  (Key)
import           GHC.TypeLits               (Symbol)
import           Servant.API

type GetR (path :: Symbol) resource
  = path :> Get '[JSON] [resource]

type PostR (path :: Symbol) createType resource
  = path :> ReqBody '[JSON] createType :> Post '[JSON] resource

type PutR (path :: Symbol) resource
  = path :> ReqBody '[JSON] resource :> Put '[JSON] resource

type GetByIdR (path :: Symbol) (capture :: Symbol) resource
  = path :> Capture capture Key :> Get '[JSON] resource

type DeleteR (path :: Symbol) (capture :: Symbol)
  = path :> Capture capture Key :> Delete '[JSON] Key

Example: A Contacts API

data CreateContact = CreateContact
  { cContactFirstName :: Text
  , cContactLastName  :: Text
  , cContactEmail     :: Text
  , cContactPhone     :: Maybe Text
  } deriving (Generic, NFData)

$(deriveJSON (jsonOpts 8) ''CreateContact)

data Contact = Contact
  { contactId        :: Key
  , contactFirstName :: Text
  , contactLastName  :: Text
  , contactEmail     :: Text
  , contactPhone     :: Maybe Text
  } deriving (Generic, NFData)

$(deriveJSON (jsonOpts 7) ''Contact)

type Contacts = "contacts"

type GetContacts   = GetR     Contacts Contact
type PostContact   = PostR    Contacts CreateContact Contact
type PutContact    = PutR     Contacts Contact
type GetContact    = GetByIdR Contacts "id" Contact
type DeleteContact = DeleteR  Contacts "id"

type ContactsAPI = GetContacts
              :<|> PostContact
              :<|> PutContact
              :<|> GetContact
              :<|> DeleteContact

GHCJS

A Haskell to JavaScript compiler that uses the GHC API.

Thanks Luite Stegeman!

GHCJS

  • Full Haskell either on nodejs or in the browser. I've so far only encountered one library that couldn't be cross-compiled. Libraries depending on native functions must provide JS shims.
  • FFI is pretty straight-forward although documentation was lacking until recently.
  • GHCJSi allows you to iterate UI changes quickly without re-compile.
  • ghcjs-base provides implementations for some of the browser API, e.g. local storage, canvas, web workers, etc.

react-flux

A binding to React based on the Flux design.

  • Excellent Documentation

  • Uses stack

  • Good Performance

  • Easy to integrate with 3rd party React components

  • Lucid-like template DSL

  • Views are pure. IO lives only in the store

  • react-flux-servant

class FlavorForm extends React.Component {
  constructor(props) {
    super(props);
    this.state = {value: 'coconut'};

    this.handleChange = this.handleChange.bind(this);
    this.handleSubmit = this.handleSubmit.bind(this);
  }

  handleChange(event) {
    this.setState({value: event.target.value});
  }

  handleSubmit(event) {
    alert('Your favorite flavor is: ' + this.state.value);
    event.preventDefault();
  }

  render() {
    return (
      <form onSubmit={this.handleSubmit}>
        <label>
          Pick your favorite La Croix flavor:
          <select value={this.state.value} 
                  onChange={this.handleChange}>
            <option value="grapefruit">Grapefruit</option>
            <option value="lime">Lime</option>
            <option value="coconut">Coconut</option>
            <option value="mango">Mango</option>
          </select>
        </label>
        <input type="submit" value="Submit" />
      </form>
    );
  }
}
flavorForm :: ReactView ()
flavorForm = defineStatefulView "flavorForm" "coconut" $
  \state args ->
    form_ [] $ do
      label_ [] $ do
        "Pick your favorite La Croix flavor: "
        select_ [ "value" $= state
                , onChange $ \e _ -> 
                    ([], Just (target e "value")) ] $ do
          option_ [ "value" $= "grapefruit" ] "Grapefruit"
          option_ [ "value" $= "lime" ] "Lime"
          option_ [ "value" $= "coconut" ] "Coconut"
          option_ [ "value" $= "mango" ] "Mango"
      input_ [ "type" $= "submit"
             , "value" $= "Submit" ]

JavaScript (ES6)

Haskell

Flux Architecture

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric  #-}
{-# LANGUAGE TypeFamilies   #-}
module Cation.Client.Components.Contacts.Store where

import           Cation.Client.Api          (Response, cfg, onResp, req)
import           Cation.Common.Api.Contacts
import           Control.DeepSeq            (NFData)
import           Data.Proxy                 (Proxy (..))
import           GHC.Generics               (Generic)
import           React.Flux
import           React.Flux.Addons.Servant  (request)

data ContactsStore
  = ContactsInit
  | ContactsState { contacts :: [Contact] }
  deriving (Generic, NFData)

data ContactsAction
  = LoadContacts
  | LoadContactsComplete (Response [Contact])
  deriving (Generic, NFData)

instance StoreData ContactsStore where
  type StoreAction ContactsStore = ContactsAction

  transform action state =
    case action of
      LoadContacts -> do
        req (Proxy :: Proxy GetContacts) (dispatch . LoadContactsComplete)
        return state
      LoadContactsComplete response ->
        onResp (pure . ContactsState) response state

dispatch :: ContactsAction -> IO [SomeStoreAction]
dispatch action = pure [SomeStoreAction contactsStore action]

contactsStore :: ReactStore ContactsStore
contactsStore = mkStore ContactsInit

Example Flux Store

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
module Cation.Client.Components.Contacts.View where

import           Cation.Client.Components.Contacts.Store
import           Cation.Client.Components.Table
import           Cation.Common.Api.Contacts
import           Data.Default
import           Data.Maybe                              (fromMaybe)
import           React.Flux                              hiding (table_)

contactsApp :: ReactView ()
contactsApp = defineControllerView "contactsApp" contactsStore render
  where
    render :: ContactsStore -> () -> ReactElementM handler ()
    render state () =
      div_ [ "className" $= "panel panel-default" ] $ do
        div_ [ "className" $= "panel-heading" ] $
          div_ [ "className" $= "container-fluid" ] $
            div_ [ "className" $= "row" ] $ do
              h3_ [ "className" $= "mt-md col flex-first" ] "Contacts"
        div_ [ "className" $= "panel-body" ] $
          case state of
            ContactsInit ->
              div_ [ "className" $= "text-center" ] $
                i_ [ "className" $= "fa fa-cog fa-spin fa-2x fa-fw" ] mempty
            ContactsState{..} ->
              div_ (contactTable_ contacts)

contactTableCfg :: TableCfg Contact handler
contactTableCfg =
  def { tblColumns =
          [ defCol "First Name" (elemText . contactFirstName)
          , defCol "Last Name" (elemText . contactLastName)
          , defCol "Email" (elemText . contactEmail)
          , defCol "Phone" (elemText . fromMaybe "" . contactPhone) ] }

contactTable_ :: [Contact] -> ReactElementM handler ()
contactTable_ = table_ contactTableCfg

Example View

These Fail at Compile-Time

  • Attempting to perform IO in a view
    • Showing a JS alert on button click.
  • Missing arguments to req
    • All path segments must be specified.
  • Wrong model types for a request that includes a BODY.
  • Misspelled URLs
  • Server implementation failing to implement handler type computed at compile-time.
    • TypedHoles extension lets you see what functions you need to implement.

Calling Haskell from JavaScript

main = syncCallback' go >>= runHsReactApp
  where
    go = reactRender "app" app ()

foreign import javascript "runHsReactApp = $1"
  runHsReactApp :: Callback a -> IO ()

-- Then from JavaScript:
runHsReactApp()

Where we can improve

  • react-flux requires you to add more keys than would be required in normal JSX markup. Understand why that is and fix.
  • webpack integration? Better JS import management.

Coming Soon

  • Added auth support to react-flux-servant
  • servant-auth0 integration

GHCJSi Demo

Full Stack Haskell

By mbeidler

Full Stack Haskell

  • 1,678