Halogen Components

halogen.purs

module Main where
  import Debug.Trace
  import Halogen

  main = do
    trace "Hello sailor!"

module Halogen where
  import Control.Monad.State.Trans
  import Control.Monad.State.Class
  import Control.Monad.Free
  import Control.Plus

  import qualified Data.Map as Map

  import Data.Tuple 
  import Data.Either
  import Data.Maybe
  import Data.Identity
  import Data.Void
  import Data.Inject
  import Data.Functor.Coproduct
  import Data.Profunctor
  import Data.Profunctor.Strong

  data HTML p i = HTML p i

  foreign import todo :: forall a. a
  
  foreign import data Aff :: # ! -> * -> *
  foreign import data HALOGEN :: !
  foreign import data HTMLElement :: *

  type HalogenEffects eff = (halogen :: HALOGEN | eff)

  newtype Component s f g p = Component 
    { render  :: s -> HTML p (f Unit),
      query   :: forall i. Free f i -> StateT s g i }

  type ComponentPure s f p = forall g. (Monad g) => Component s f g p

  type Driver f eff = forall i. f i -> Aff (HalogenEffects eff) i

  runComponent :: forall eff s f. (Functor f) =>
    Component s f (Aff (HalogenEffects eff)) Void ->
    s                                             ->
    Aff (HalogenEffects eff) (Tuple HTMLElement (Driver f eff))
  runComponent c s = todo

  data ChildF p f i = ChildF p (f i)

  type ComponentState s f g p = Tuple s (Component s f g p)

  type InstalledState s s' f' g p p' = 
    { parent   :: s, 
      children :: Map.Map p (ComponentState s' f' g p'), 
      factory  :: p -> ComponentState s' f' g p' }

  data QueryT s' f' p p' g s a = QueryT (StateT (InstalledState s s' f' g p p') g a)

  -- queries a particular child from the parent:
  query :: forall s s' f' p p' g. p -> (forall i. Free f' i -> QueryT s' f' p p' g s (Maybe i))
  query p q = todo

  -- lifts an effect into the QueryT monad:
  effect :: forall s' f' p p' g s a. (Monad g) => g a -> QueryT s' f' p p' g s a
  effect ga = todo

  -- MonadState for QueryT so parents can manipulate their own state
  instance monadStateQueryT :: MonadState s (QueryT s' f' p p' g s) where
    state f = todo

  instance functorQueryT :: Functor (QueryT s' f' p p' g s) where
    (<$>) f fa = todo

  instance applyQueryT :: Apply (QueryT s' f' p p' g s) where
    (<*>) f fa = todo

  instance applicativeQueryT :: Applicative (QueryT s' f' p p' g s) where
    pure a = todo

  instance bindQueryT :: Bind (QueryT s' f' p p' g s) where
    (>>=) fa f = todo

  instance monadQueryT :: Monad (QueryT s' f' p p' g s)

  instance functorChildF :: (Functor f) => Functor (ChildF p f) where
    (<$>) f (ChildF p fi) = ChildF p (f <$> fi)

  {- 
  test = do 
    state <- get
    effect $ doEffect
    set state
    resp <- query editor getContent
    return $ fromMaybe "" resp
  -}

  installR :: forall s f g pl pr s' f' p'. (Ord pr, Plus g) =>
    Component s f (QueryT s' f' pr p' g s) (Either pl pr) ->   -- parent
    (pr -> Tuple s' (Component s' f' g p'))               ->   -- factory
    Component (InstalledState s s' f' g pl p') (Coproduct f (ChildF pr f')) g (Either pl p')
  installR a f = todo

  installL :: forall s f g pl pr s' f' p'. (Ord pl, Plus g) =>
    Component s f (QueryT s' f' pl p' g s) (Either pl pr) ->   -- parent
    (pl -> Tuple s' (Component s' f' g p'))               ->   -- factory
    Component (InstalledState s s' f' g pr p') (Coproduct f (ChildF pl f')) g (Either pr p')
  installL a f = todo

  installAll :: forall s f g p s' f' p'. (Ord p, Plus g) =>
    Component s f (QueryT s' f' p p' g s) p               ->   -- parent
    (p -> Tuple s' (Component s' f' g p'))                ->   -- factory
    Component (InstalledState s s' f' g p p') (Coproduct f (ChildF p f')) g p'
  installAll a f = todo

  -- functor instance allows changing placeholders
  instance functorComponent :: Functor (Component s f g) where
    (<$>) f fa = todo

module ClickComponent where
  import Control.Monad.State.Trans
  import Control.Monad.State.Class(modify)
  import Control.Monad.Free
  import Control.Monad.Rec.Class

  import Data.Inject
  import Data.Void
  import Data.Identity

  import Halogen  
  
  data Input a = ClickIncrement a | ClickDecrement a

  instance functorMyComponent :: Functor Input where
    (<$>) f (ClickIncrement a) = ClickIncrement (f a)
    (<$>) f (ClickDecrement a) = ClickDecrement (f a)

  clickIncrement :: forall g. (Functor g, Inject Input g) => Free g Unit
  clickIncrement = liftF (inj (ClickIncrement unit) :: g Unit)

  clickDecrement :: forall g. (Functor g, Inject Input g) => Free g Unit
  clickDecrement = liftF (inj (ClickDecrement unit) :: g Unit)

  counterComponent :: forall g. (MonadRec g) => Component Number Input g Void
  counterComponent = Component { render : render, query : query }
    where
      eval :: forall g a. (Monad g) => Input (Free Input a) -> StateT Number g (Free Input a)
      eval (ClickIncrement next) = do
        modify (+1)
        return next
      eval (ClickDecrement next) = do
        modify (flip (-) 1)
        return next
      
      render :: Number -> HTML Void (Input Unit)
      render n = todo
      
      query :: forall g i. (MonadRec g) => Free Input i -> StateT Number g i
      query = runFreeM eval

  test :: Free Input Unit
  test = do
    clickIncrement
    clickIncrement
    clickDecrement

module EditorComponent where
  import Control.Monad.State.Trans
  import Control.Monad.State.Class(modify)
  import Control.Monad.Free
  import Control.Monad.Rec.Class
  import Control.Monad.Eff
  import Control.Monad.Trans(lift)
  import Control.Apply((*>))

  import Data.Inject
  import Data.Void
  import Data.Identity

  import Halogen  

  data Input a = GetContent (String -> a) | SetContent a String | GetCursor (Number -> a)

  instance functorInput :: Functor Input where
    (<$>) = todo
  
  getContent :: forall g. (Functor g, Inject Input g) => Free g String
  getContent = liftF (inj (GetContent id) :: g String)
  
  setContent :: forall g. (Functor g, Inject Input g) => String -> Free g Unit
  setContent s = liftF (inj (SetContent unit s) :: g Unit)

  getCursor :: forall g. (Functor g, Inject Input g) => Free g Number
  getCursor = liftF (inj (GetCursor id) :: g Number)
  
  editorComponent :: forall eff. Component Unit Input (Eff (dom :: DOM | eff)) Void
  editorComponent = Component { render : render, query : query }
    where 
      eval :: forall eff a. Input (Free Input a) -> StateT Unit (Eff (dom :: DOM | eff)) (Free Input a)
      eval (GetContent f  ) = lift $       f <$> effectfulGetContent
      eval (SetContent n s) = lift $ const n <$> effectfulSetContent s
      eval (GetCursor  f  ) = lift $       f <$> effectfulGetCursor
      
      render s = todo
      
      query :: forall eff i. Free Input i -> StateT Unit (Eff (dom :: DOM | eff)) i
      query = runFreeM eval

  test :: Free Input Unit
  test = do
    cursor  <- getCursor
    content <- getContent
    setContent $ content ++ (show cursor)

  foreign import data DOM :: !
  
  foreign import effectfulGetContent :: forall eff. Eff (dom :: DOM | eff) String
  foreign import effectfulSetContent :: forall eff. String -> Eff (dom :: DOM | eff) Unit
  foreign import effectfulGetCursor  :: forall eff. Eff (dom :: DOM | eff) Number