{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}

module Ohm.Component
  (
    Processor(..)
  , idProcessor
  , handles
  , Component(..)
  , appModel
  , runComponent'
  , runComponent
  , runComponentDebug
  , forkProcessor
  ) where

import Control.Lens (Prism', preview)
import Control.Monad.Trans.Reader
import Control.Monad.State
import Data.Foldable (traverse_)
import Data.Profunctor
import MVC hiding (handles)
import Ohm.HTML (Renderer, domChannel, newTopLevelContainer, renderTo)

-- | Converts @UI Events@ to @Model Events@ in a monad for external communication
--
-- see "Pipes.Tutorial" for more on function @a -> 'Producer' b m ()@
newtype Processor m edom ein = Processor
  { 
    runProcessor :: edom -> Producer ein m ()
  } deriving (Monoid)

-- | Pass @UI Events@ directly to the model
--
-- Use this in the case of simple components that use the same type
-- for both @UI Events@ and @Model Events@
idProcessor :: (Monad m) => Processor m e e
idProcessor = Processor yield

instance (Monad m) => Functor (Processor m ein) where
  fmap f (Processor p) = Processor (p ~> yield . f)

instance (Monad m) => Profunctor (Processor m) where
  lmap f (Processor p) = Processor (p . f)
  rmap = fmap
  
-- | Use a Prism' to determine which part of a message to handle
handles :: Monad m => Prism' b a -> Processor m a c -> Processor m b c  
handles prism p = Processor $ traverse_ (runProcessor p) . preview prism


--------------------------------------------------------------------------------

data Component env ein model edom = Component {
   
    -- | The processing function of an 'MVC.Model' for this component
    model :: ein -> model -> model
    
    -- | A renderer for 'MVC.Model' creating 'HTML' produces @UI Events@
  , render :: Renderer edom model
  
    -- | A processor of events emitted from the UI
  , domEventsProcessor :: Processor (ReaderT env IO) edom ein
  }

-- | Convert's the 'model' function from a 'Component' to an 'MVC.Model'
appModel :: (e -> m -> m) ->  Model m e m
appModel fn = asPipe $ forever $ do
  e <- await
  lift $ modify (fn e)
  yield =<< lift get

  
--------------------------------------------------------------------------------
{- | Runs a 'Component'

Running a component forks two IO threads:

 * The first is for @UI Events@. The thead processes them, running any
   IO actions and feeding @Model Events@ into the 'MVC.Model' 'Controller'
 
 * The second is the thread which calls 'MVC.runMVC' and updates the DOM
-}
runComponent'
  ::  forall model env ein edom.
     (model -> IO ())
  -- ^ An action to run every time the model updates (used by 'runComponentDebug')
  -> model
  -- ^ Initial model state
  -> env
  -- ^ Configuration available in 'ReaderT'
  -> Component env ein model edom
  -- ^ The component to run
  -> IO (Output ein)
  -- ^ Returns an 'Output' that accepts @Model Events@ from external systems
runComponent' dbg s env Component{..} = do
  (domSink, domSource) <- spawn unbounded
  (modelSink, modelSource) <- spawn unbounded
  
  forkProcessor env $ for (fromInput domSource) (runProcessor domEventsProcessor)
           >-> (toOutput modelSink)
  void . forkIO . void $ runMVC s (appModel model) $ app modelSource domSink
  return modelSink
  where
    -- Create an MVC app
    app :: Input ein -> Output edom -> Managed (View model, Controller ein)
    app eventSource domSink = managed $ \k -> do
      let render' = render (domChannel domSink)
      componentEl <- newTopLevelContainer
      renderTo componentEl $ render' s
      k (asSink (debugRender render' componentEl), asInput eventSource)

    -- Render the current model by patching the DOM
    -- debugRender :: (model -> HTML) -> VNodePresentation -> model -> IO ()
    debugRender f el mdl = do
      renderTo el $ f mdl
      dbg mdl
      

-- | 'runComponent'' printing the model at each modification
runComponentDebug
  ::  forall model env ein edom. (Show model)
  => model
  -> env
  -> Component env ein model edom
  -> IO (Output ein)      
runComponentDebug = runComponent' print

-- | 'runComponent'' with no extra action
runComponent
  ::  forall model env ein edom.
     model
  -> env
  -> Component env ein model edom
  -> IO (Output ein)      
runComponent = runComponent' (void . return)


-- Run the event processor over the events produced by the dom
forkProcessor :: env -> Effect (ReaderT env IO) () -> IO ()
forkProcessor env = void . forkIO . (flip runReaderT $ env) . runEffect
