Free monads dom experiment

FreeDom.purs

module FreeDom where

import Control.Monad.Free
import Control.Monad.Free.Trans
import DOM
import DOM.HTML
import DOM.HTML.Window
import DOM.Node.Node
import DOM.Node.Types
import Data.Array
import Data.Maybe
import Data.Traversable
import Prelude
import DOM.Node.HTMLCollection as HC
import Control.Applicative (pure)
import Control.Monad (class Monad, bind)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Control.Monad.Eff.Unsafe (unsafeCoerceEff)
import DOM.HTML.Types (htmlDocumentToDocument)
import DOM.Node.Document (documentElement)
import DOM.Node.Element (getElementsByTagName)
import Data.Functor (class Functor, (<$>))
import Unsafe.Coerce (unsafeCoerce)

htmlCollectionToArray :: forall e. HTMLCollection -> Eff ( dom :: DOM | e ) (Array Element)
htmlCollectionToArray elms = do
  len <- HC.length elms
  catMaybes <$> for (range 0 len) \i -> do
    HC.item i elms

removeNode :: forall e. Node -> Eff (dom :: DOM | e) Node
removeNode n = do
  pa <- parentNode n
  case pa of
    (Just p) -> removeChild n p
    otherwise -> pure n

findDomElements :: forall e. String -> Element -> Eff (dom :: DOM | e) (Array Node)
findDomElements name elm = map (map elementToNode) (getElementsByTagName name elm >>= htmlCollectionToArray)

removeDomElements :: forall e. Array Node -> Eff ( dom :: DOM | e ) (Array Node)
removeDomElements elms = sequence (removeNode <$> elms)

data DomF node elem a
   = FindElements String elem (Array node -> a)
   | RemoveElements (Array node) (Array node -> a)

instance functorDomF :: Functor (DomF node elem) where
  map f (FindElements s e cont) = FindElements s e (f <<< cont)
  map f (RemoveElements arr cont) = RemoveElements arr (f <<< cont)

findElements :: forall node elem. String -> elem -> Free (DomF node elem) (Array node)
findElements name root = liftF (FindElements name root id)

removeElements :: forall node elem. Array node -> Free (DomF node elem) (Array node)
removeElements elms = liftF (RemoveElements elms id)

program :: forall node elem. elem -> Free (DomF node elem) Unit
program root = do
  elms <- findElements "b" root
  void $ removeElements elms

realInterpreter :: forall e a. Free (DomF Node Element) a -> Eff ( dom :: DOM | e) a
realInterpreter =
  runFreeM $ case _ of (FindElements s e cont)   -> cont <$> findDomElements s e
                       (RemoveElements arr cont) -> cont <$> removeDomElements arr