Last active
January 19, 2018 09:23
-
-
Save spocke/0934ad7992e289b89de32b082f7c42f7 to your computer and use it in GitHub Desktop.
Free monads dom experiment
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment