modified isomorphic miso example for dmjio

ClientMain.hs

{-# LANGUAGE TypeApplications  #-}
{-# LANGUAGE TypeOperators     #-}

module Main where

import qualified Common
import Data.Proxy ( Proxy(..) )
import Control.Lens ( (^.), (+=), (-=), (.=), makeLenses )
import qualified Servant.API as S
import Servant.API ( (:<|>)(..) )
import qualified Servant.Links as S
import qualified Miso

import Miso ( View, App(..) )
import qualified Miso.String as Miso

main :: IO ()
main =
  Miso.miso $ \currentURI -> App
    { initialAction = Common.NoOp
    , model         = Common.initialModel currentURI
    , update        = Miso.fromTransition . updateModel
    , view          = Common.viewModel
    , events        = Miso.defaultEvents
    , subs          = [ Miso.uriSub Common.HandleChangeURI ]
    , mountPoint    = Nothing
    }

updateModel
    :: Common.Action
    -> Miso.Transition Common.Action Common.Model ()
updateModel action =
    case action of
      Common.NoOp          -> pure ()
      Common.AddOne        -> Common.counterValue += 1
      Common.SubtractOne   -> Common.counterValue -= 1
      Common.ChangeURI uri ->
        Miso.scheduleIO $ do
          Miso.pushURI uri
          pure Common.NoOp
      Common.HandleChangeURI uri -> Common.uri .= uri

Common.hs

{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE DataKinds                  #-}

module Common where

import Control.Lens
import Data.Proxy ( Proxy(..) )

import qualified Servant.API as S
import qualified Servant.Links as S
import Servant.API ( (:<|>)(..), (:>) )

import qualified Miso
import Miso ( View )
import Miso.Html
import qualified Miso.String as Miso

import qualified Network.URI as Network

-- asdf
data Model
   = Model
     { _uri          :: !Network.URI
     , _counterValue :: !Int
     }
     deriving (Eq, Show)

initialModel :: Network.URI -> Model
initialModel uri =
    Model
    { _uri = uri
    , _counterValue = 0
    }

data Action
  = NoOp
  | AddOne
  | SubtractOne
  | ChangeURI !Network.URI
  | HandleChangeURI !Network.URI
  deriving (Show, Eq)

-- Holds a servant route tree of `View action`
type ViewRoutes = Home :<|> Flipped

-- Home route, contains two buttons and a field
type Home = View Action

-- Flipped route, same as Home, but with the buttons flipped
type Flipped = "flipped" :> View Action

makeLenses ''Model

-- Checks which URI is open and shows the appropriate view
viewModel :: Model -> View Action
viewModel m =
    case Miso.runRoute (Proxy @ViewRoutes) viewTree _uri m of
      Left _routingError -> page404View
      Right v   -> v

-- Servant tree of view functions
-- Should follow the structure of ViewRoutes
viewTree
    ::      (Model -> View Action)
       :<|> (Model -> View Action)
viewTree = homeView :<|> flippedView

-- View function of the Home route
homeView :: Model -> View Action
homeView m =
    div_ []
      [ div_ [] 
        [ text "sdf" -- change this and reload
        , text $ Miso.ms $ show $ _uri m 
        ]
      , div_
        []
        [ button_ [ onClick SubtractOne ] [ text "-" ]
        , text $ Miso.ms $ show 5
        , button_ [ onClick AddOne ] [ text "+" ]
        ]
      , button_ [ onClick $ ChangeURI flippedLink ] [ text "Go to /flipped" ]
      ]

-- View function of the Home route
flippedView :: Model -> View Action
flippedView m =
    div_ []
      [ div_
        []
        [ button_ [ onClick AddOne ] [ text "+" ]
        , text $ Miso.ms $ show $ _counterValue m
        , button_ [ onClick SubtractOne ] [ text "-" ]
        ]
      , button_ [ onClick $ ChangeURI homeLink ] [ text "Go back to /" ]
      ]

page404View :: View Action
page404View =
    text "Yo, 404, page unknown. Go to / or /flipped. Shoo!"

-- Network.URI that points to the home route
homeLink :: Network.URI
homeLink = S.linkURI $ S.safeLink pViewRoutes pHome

-- Network.URI that points to the flipped route
flippedLink :: Network.URI
flippedLink =
    S.linkURI $ S.safeLink pViewRoutes (Proxy @Flipped)

pViewRoutes :: Proxy ViewRoutes
pViewRoutes = Proxy

pHome :: Proxy Home
pHome = Proxy

ServerMain.hs

{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeOperators              #-}

module Main where

import qualified Common
import           Data.Proxy

import qualified Lucid                                as L
import qualified Lucid.Base                           as L

import qualified Network.HTTP.Types                   as HTTP
import qualified Network.Wai                          as Wai
import qualified Network.Wai.Handler.Warp             as Wai
import qualified Network.Wai.Middleware.Gzip          as Wai
import qualified Network.Wai.Middleware.RequestLogger as Wai

import qualified Servant as S
import           Servant ( (:>), (:<|>)(..) )

import qualified System.IO                            as IO

import qualified Miso

import           Database.Beam
import           Database.Beam.Postgres
import           Database.Beam.Backend.SQL
import qualified Database.Beam.Query.Internal  as B
import           Data.Pool

port :: Int
port = 3003

main :: IO ()
main = do
    IO.hPutStrLn IO.stderr ("Running on port " <> show port <> "...")

    Wai.run port $ Wai.logStdout $ compress app
  where
    compress :: Wai.Middleware
    compress = Wai.gzip Wai.def { Wai.gzipFiles = Wai.GzipCompress }

app :: Wai.Application
app =
    S.serve (Proxy @ServerAPI)
        (    static
        :<|> serverHandlers
        :<|> S.Tagged page404
        )
  where
    static :: S.Server StaticAPI
    static = S.serveDirectoryWebApp "server/static"

    serverHandlers :: S.Server ServerRoutes
    serverHandlers = homeServer :<|> flippedServer

    -- Handles the route for the home page, rendering Common.homeView.
    homeServer :: S.Server (Miso.ToServerRoutes Common.Home HtmlPage Common.Action)
    homeServer =
        pure $ HtmlPage $
          Common.viewModel $
          Common.initialModel Common.homeLink

    -- Renders the /flipped page.
    flippedServer :: S.Server (Miso.ToServerRoutes Common.Flipped HtmlPage Common.Action)
    flippedServer =
        pure $ HtmlPage $
          Common.viewModel $
          Common.initialModel Common.flippedLink

    -- The 404 page is a Wai application because the endpoint is Raw.
    -- It just renders the page404View and sends it to the client.
    page404 :: Wai.Application
    page404 _ respond = respond $ Wai.responseLBS
        HTTP.status404 [("Content-Type", "text/html")] $
        L.renderBS $ L.toHtml Common.page404View

-- | Represents the top level Html code. Its value represents the body of the
-- page.
newtype HtmlPage a = HtmlPage a
  deriving (Show, Eq)

instance L.ToHtml a => L.ToHtml (HtmlPage a) where
    toHtmlRaw = L.toHtml
    toHtml (HtmlPage x) = do
        L.doctype_
        L.head_ $ do
          L.title_ "Unbooru"
          L.meta_ [L.charset_ "utf-8"]

          L.with (L.script_ mempty)
            [ L.makeAttribute "src" "/static/all.js"
            , L.makeAttribute "async" mempty
            , L.makeAttribute "defer" mempty
            ]

        L.body_ (L.toHtml x)

-- Converts the ClientRoutes (which are a servant tree of routes leading to
-- some `View action`) to lead to `Get '[Html] (HtmlPage (View Common.Action))`
type ServerRoutes
   = Miso.ToServerRoutes Common.ViewRoutes HtmlPage Common.Action

-- The server serves static files besides the ServerRoutes, among which is the
-- javascript file of the client.
type ServerAPI =
       StaticAPI
  :<|> ServerRoutes
  :<|> S.Raw -- This will show the 404 page for any unknown route

type StaticAPI = "static" :> S.Raw