Futbol Monad + friends

Main.purs

module Main where

import Prelude

import App.Control.Monad (Futbol, runFutbol)
import App.Types (AppEffects, SomeEffects)
import Control.Monad.Aff.AVar (AVAR)
import Control.Monad.Aff.Console (CONSOLE)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Exception (EXCEPTION)
import Control.Monad.Eff.Now (NOW)
import Control.Monad.Eff.Ref (REF)
import DOM (DOM)
import Data.JSDate (LOCALE)
import Halogen as H
import Halogen.Aff as HA
import Halogen.VDom.Driver (runUI)
import Network.HTTP.Affjax as AX
import ParentComponent (ui)

-- | Run the app.
main :: Eff (HA.HalogenEffects SomeEffects) Unit
main = HA.runHalogenAff do
  body <- HA.awaitBody
  let ui' = H.hoist (runFutbol "HI") ui
  runUI ui' unit =<< HA.awaitBody

Monad.purs

module App.Control.Monad
 (Futbol,
  FutbolM,
  FutbolF (..),
  Environment,
  runFutbol
  ) where

import App.Types (AppEffects, SomeEffects)
import Control.Monad.Eff (Eff, kind Effect)
import Control.Monad.Free (Free, liftF, foldFree)
import Control.Monad.Reader (class MonadAsk)
import Halogen.Aff (HalogenEffects)
import Prelude (class Applicative, class Apply, class Bind, class Functor, class Monad, type (~>), Unit, discard, flip, id, pure, unit, ($), (<$>), (<<<))
import Control.Monad.Aff (Aff)

type Environment = String

data FutbolF (eff :: # Effect) env a
  = Ask (env -> a)

-- FutbolM is the monad ?
type Futbol = FutbolM (HalogenEffects SomeEffects) Environment

-- TODO: FutbolF is the functor ?
newtype FutbolM eff env a = FutbolM (Free (FutbolF eff env) a)

-- TODO: Why do you need to "un" the monad
unFutbolM :: forall eff env. FutbolM eff env ~> Free (FutbolF eff env)
unFutbolM (FutbolM e) = e

derive newtype instance functorFutbolM :: Functor (FutbolM eff env)
derive newtype instance applyFutbolM :: Apply (FutbolM eff env)
derive newtype instance applicativeFutbolM :: Applicative (FutbolM eff env)
derive newtype instance bindFutbolM :: Bind (FutbolM eff env)
derive newtype instance monadFutbolM :: Monad (FutbolM eff env)

instance monadAskAlerterM :: MonadAsk env (FutbolM eff env) where
  ask = FutbolM <<< liftF <<< Ask $ id

runFutbol :: Environment -> Futbol ~> Aff (HalogenEffects SomeEffects)
runFutbol env = foldFree go <<< unFutbolM

   where

   go :: FutbolF (HalogenEffects SomeEffects) Environment ~> Aff (HalogenEffects SomeEffects)
   go = case _ of
    Ask k ->
      pure (k env)

ParentComponent.purs

ui :: H.Component HH.HTML Query Unit Void Futbol
ui = H.lifecycleParentComponent
  { initialState: const initialState
  , render
  , eval
  , initializer: Just (H.action Initialize)
  , finalizer: Just (H.action Finalize)
  , receiver: const Nothing
  }
  where

  render :: State -> H.ParentHTML Query DateSectionQuery Slot Futbol
  render state =
    HH.div
      [ HP.class_ $ wrap "Parent-container" ]
      [
        HH.h1_ [ HH.text "Fixtures" ]
      , HH.h1_ [ HH.text "Fixtures" ]

      ]

  eval :: Query ~> H.ParentDSL State Query DateSectionQuery Slot Void Futbol

Types.purs

module App.Types


type AppEffects eff =
  ( console :: CONSOLE
  , dom :: DOM
  , ajax :: AX.AJAX
  , now :: NOW
  , locale :: LOCALE
  | eff)

type SomeEffects =
  ( console :: CONSOLE
  , ajax :: AX.AJAX
  , now :: NOW
  , locale :: LOCALE
  )