00-Route.hs

{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}

module Common.Route where

{- -- You will probably want these imports for composing Encoders.
import Prelude hiding (id, (.))
import Control.Category
-}

import Data.Text (Text)
import Data.Functor.Identity
import Data.Functor.Sum

import Obelisk.Route
import Obelisk.Route.TH

data BackendRoute :: * -> * where
  -- | Used to handle unparseable routes.
  BackendRoute_Missing :: BackendRoute ()
  -- You can define any routes that will be handled specially by the backend here.
  -- i.e. These do not serve the frontend, but do something different, such as serving static files.

data FrontendRoute :: * -> * where
  FrontendRoute_Main :: FrontendRoute ()
  FrontendRoute_A    :: FrontendRoute ()
  FrontendRoute_B    :: FrontendRoute (Maybe (R ExampleSubRoute))
  -- This type is used to define frontend routes, i.e. ones for which the backend will serve the frontend.
 
data ExampleSubRoute :: * -> * where
  ExampleSubRoute_1  :: ExampleSubRoute ()
  ExampleSubRoute_2  :: ExampleSubRoute ()

backendRouteEncoder
  :: Encoder (Either Text) Identity (R (Sum BackendRoute (ObeliskRoute FrontendRoute))) PageName
backendRouteEncoder = handleEncoder (const (InL BackendRoute_Missing :/ ())) $
  pathComponentEncoder $ \case
    InL backendRoute -> case backendRoute of
      BackendRoute_Missing -> PathSegment "missing" $ unitEncoder mempty
    InR obeliskRoute -> obeliskRouteSegment obeliskRoute $ \case
      -- The encoder given to PathEnd determines how to parse query parameters,
      -- in this example, we have none, so we insist on it.
      FrontendRoute_Main -> PathEnd $ unitEncoder mempty
      FrontendRoute_A    -> PathSegment "a" $ unitEncoder mempty
      FrontendRoute_B    -> PathSegment "b" $ maybeEncoder (unitEncoder mempty) $ pathComponentEncoder $ \case
        ExampleSubRoute_1 -> PathSegment "1" $ unitEncoder mempty
        ExampleSubRoute_2 -> PathSegment "2" $ unitEncoder mempty


concat <$> mapM deriveRouteComponent
  [ ''BackendRoute
  , ''FrontendRoute
  , ''ExampleSubRoute
  ]

01-Frontend.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}
module Frontend where

import Obelisk.Frontend
import Obelisk.Route
import Obelisk.Route.Frontend
import Reflex.Dom.Core
import Data.Text (Text)
import Control.Monad.Fix (MonadFix)
import Control.Monad.IO.Class (MonadIO)
 
import Common.Route

data MenuData = MenuData [Text] deriving Show

frontend :: Frontend (R FrontendRoute)
frontend = Frontend
  { _frontend_head = el "title" $ text "Obelisk Minimal Example"
  , _frontend_body = body
  }

body :: forall t x m. (ObeliskWidget t x (R FrontendRoute) m) => RoutedT t (R FrontendRoute) m ()
body = do
  -- You'd make a backend call here instead
  -- This only gets loaded once even when we click around links.
  loadEv <- (MenuData ["a","b","c"] <$) <$> (getPostBuild >>= delay 1) 
  menuDataDyn <- holdDyn (MenuData []) loadEv
  display menuDataDyn 
  el "div" $ routeLink (FrontendRoute_Main :/ ()) $ text "Home"
  el "div" $ routeLink (FrontendRoute_A :/ ()) $ text "A"
  el "div" $ routeLink (FrontendRoute_B :/ Nothing) $ text "B"

  subRoute_ $ \case
    FrontendRoute_Main -> blank
    FrontendRoute_A    -> routeA menuDataDyn
    FrontendRoute_B    -> routeB

routeA :: (DomBuilder t m, PostBuild t m) => Dynamic t MenuData -> m ()
routeA mdDyn = do
  el "h1" $ text "This is page A"
  display mdDyn 

routeB 
  :: ( DomBuilder t m
     , RouteToUrl (R FrontendRoute) m
     , SetRoute t (R FrontendRoute) m
     , MonadFix m
     , MonadHold t m
     , PostBuild t m
     , PerformEvent t m
     , TriggerEvent t m
     , MonadIO (Performable m)
     ) 
  => RoutedT t (Maybe (R ExampleSubRoute)) m ()
routeB = do
  -- This gets reloaded every time we navigate from home/A to B, only.
  -- It doesn't get reloaded when we go between b.1 and b.2
  loadEv <- (MenuData ["b.1","b.2"] <$) <$> (getPostBuild >>= delay 1) 
  menuDataDyn <- holdDyn (MenuData []) loadEv
  el "h1" $ text "This is page B"
  display menuDataDyn 
  el "div" $ routeLink (FrontendRoute_B :/ (Just $ ExampleSubRoute_1 :/ ())) $ text "B.1"
  el "div" $ routeLink (FrontendRoute_B :/ (Just $ ExampleSubRoute_2 :/ ())) $ text "B.2"
  maybeRoute_ blank $ subRoute_ $ \case
    ExampleSubRoute_1 -> el "p" $ text "Section B.1"
    ExampleSubRoute_2 -> el "p" $ text "Section B.2"