HTTPure routing duplex example

Example.purs

module Main where

import Prelude hiding ((/))

import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..))
import Effect.Console (log)
import HTTPure (ServerM, found', headers, notFound, ok, serve)
import Routing.Duplex (RouteDuplex', as, optional, print, root, segment, string)
import Routing.Duplex.Generic as G
import Routing.Duplex.Generic.Syntax ((/), (?))

data Route
  = Home
  | Profile String
  | Account String
  | Search { q :: String, sorting :: Maybe Sort }

derive instance Generic Route _

data Sort = Asc | Desc

derive instance Generic Sort _

sortToString :: Sort -> String
sortToString = case _ of
  Asc -> "asc"
  Desc -> "desc"

sortFromString :: String -> Either String Sort
sortFromString = case _ of
  "asc" -> Right Asc
  "desc" -> Right Desc
  val -> Left $ "Not a sort: " <> val

sort :: RouteDuplex' String -> RouteDuplex' Sort
sort = as sortToString sortFromString

route :: RouteDuplex' Route
route = root $ G.sum
  { "Home": G.noArgs
  , "Profile": "profile" / string segment
  , "Account": "account" / string segment
  , "Search": "search" ? { q: string, sorting: optional <<< sort }
  }

main :: ServerM
main = serve 8080 route router $ log "Server now up on port 8080"
  where
  router { route: Right Home } = ok "hello world!"
  router { route: Right (Profile profile) } = ok $ "hello " <> profile <> "!"
  router { route: Right (Account account) } = found' redirect ""
    where
    redirect = headers [ Tuple "Location" $ print route $ Profile account ]
  router { route: Right (Search { q, sorting }) } = ok $ "searching for query " <> q <> " " <> case sorting of
    Just Asc -> "ascending"
    Just Desc -> "descending"
    Nothing -> "defaulting to ascending"
  router { route: Left err } = notFound