packages feed

jmonkey (empty) → 0.1.0.0

raw patch · 18 files changed

+783/−0 lines, 18 filesdep +basedep +casingdep +claysetup-changed

Dependencies added: base, casing, clay, free, http-types, jmacro, jmonkey, lucid, text, wai, warp

Files

+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for jmonkey++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2018 peus++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,35 @@+# jmonkey++[![Build status](https://travis-ci.org/opyapeus/jmonkey.svg?branch=master)](https://travis-ci.org/opyapeus/jmonkey)++Jmonkey is very restricted but handy EDSL for javascript.++The DOM effect that jmonkey can do is just to change classes and ids of HTML elements.++So it only supports some on-actions and condition checks.++Instead of limited functions, it can be called internally unlike other rich javascript EDSLs that require external calls.++If you manage some states for complex frontend actions, jmonkey won't be usable.++Jmonkey may be useful when you implement some actions that css can not handle.++## Example++A practical implementation is shown in [example](example).++Clone this repository first, and execute following.++```sh+stack run+```++Then access to localhost:3000.++## Documentation++- [API documentation on Hackage](#TODO)++## Contribution++If you find a bug or want new features or else, making issues and PRs are very welcome.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ example/Data/Gender.hs view
@@ -0,0 +1,4 @@+module Data.Gender where++data Gender = Man | Woman | Trans+    deriving (Show, Eq)
+ example/Data/Person.hs view
@@ -0,0 +1,39 @@+module Data.Person where++import           Data.Gender++data Person = Person+  { name :: String+  , age  :: Int+  , gender  :: Gender+  } deriving (Show, Eq)++people :: [Person]+people =+  [ Person "A" 20 Man+  , Person "B" 21 Woman+  , Person "C" 22 Trans+  , Person "D" 23 Man+  , Person "E" 24 Woman+  , Person "F" 25 Trans+  , Person "G" 26 Man+  , Person "H" 27 Woman+  , Person "I" 28 Trans+  , Person "J" 29 Man+  , Person "K" 30 Woman+  , Person "L" 31 Trans+  , Person "M" 32 Man+  , Person "N" 33 Woman+  , Person "O" 34 Trans+  , Person "P" 35 Man+  , Person "Q" 36 Woman+  , Person "R" 37 Trans+  , Person "S" 38 Man+  , Person "T" 39 Woman+  , Person "U" 40 Trans+  , Person "V" 41 Man+  , Person "W" 42 Woman+  , Person "X" 43 Trans+  , Person "Y" 44 Man+  , Person "Z" 45 Woman+  ]
+ example/Data/Selector.hs view
@@ -0,0 +1,26 @@+module Data.Selector where++import           Data.Gender++data Selector = Id IdName | Class ClassName+    deriving (Show, Eq)++data IdName+    = Button Gender+    | ButtonAll+    deriving (Show, Eq)++data ClassName+    = First+    | Second+    | Third+    | Hide+    | Tab+    | Current+    | AboveHeader+    | Head+    | HeadFixed+    | Content+    | Box+    | Group Gender+    deriving (Show, Eq)
+ example/Data/ToAttribute.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances #-}++module Data.ToAttribute where++import           Data.Text                      ( pack )+import           Text.Casing                    ( kebab )+import           Lucid                          ( Attribute+                                                , id_+                                                , class_+                                                )+import qualified Clay                          as C+                                                ( Selector )+import           Clay.Selector                  ( selectorFromText )+import qualified JMonkey                       as J+                                                ( Selector(..) )+import           Data.Selector++class ToAttribute a where+    toAttr :: Selector -> a++instance ToAttribute Attribute where+    toAttr (Id v) = id_ . pack . kebab . show $ v+    toAttr (Class v) = class_ . pack . kebab. show $ v++instance ToAttribute C.Selector where+    toAttr (Id v) = selectorFromText . mappend "#" . pack . kebab . show $ v+    toAttr (Class v) = selectorFromText . mappend "." . pack . kebab . show $ v++instance ToAttribute J.Selector where+    toAttr (Id v) = J.Id . kebab . show $ v+    toAttr (Class v) = J.Class . kebab . show $ v++-- TODO: div [class_ "a", class_ "b"] "X" -> <div class="ab">X</div>+-- NOTE: https://github.com/chrisdone/lucid/issues/84+toClasses :: [ClassName] -> Attribute+toClasses = class_ . pack . unwords . map (kebab . show)
+ example/Frontend/Css.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE OverloadedStrings #-}++module Frontend.Css where++import           Clay+import           Data.Gender+import           Data.Selector+import           Data.ToAttribute++zero :: Size LengthUnit+zero = 0++p100 :: Size Percentage+p100 = 100++clayCss :: Css+clayCss = do+    body ? do+        sym margin  zero+        sym padding zero+        backgroundColor "#ffffff"++    toAttr (Class AboveHeader) ? do+        height (px 200)+        backgroundColor "#add8e6"++    toAttr (Class Head) ? do+        backgroundColor "#f8f8ff"+        position absolute+        width p100++        toAttr (Class Tab) ? do+            display inlineBlock+            width (px 150)++        toAttr (Class Current) ? do+            backgroundColor "#d3d3d3"+            fontWeight bold++    toAttr (Class HeadFixed) ? do+        position fixed+        top zero++    toAttr (Class Content) ? do+        display flex+        flexWrap (FlexWrap "wrap") -- FIXME: flexWrap wrap+        justifyContent spaceBetween+        listStyleType none+        sym margin  zero+        sym padding zero++        toAttr (Class Box) ? do+            width (px 200)+            sym padding (px 20)+            marginBottom (px 30)++    toAttr (Class First) ? backgroundColor "#ff0000"+    toAttr (Class Second) ? backgroundColor "#00ff00"+    toAttr (Class Third) ? backgroundColor "#0000ff"++    toAttr (Class $ Group Man) ? backgroundColor "#00ced1"+    toAttr (Class $ Group Woman) ? backgroundColor "#f08080"+    toAttr (Class $ Group Trans) ? backgroundColor "#eee8aa"++    toAttr (Class Hide) ? display none
+ example/Frontend/Html.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE OverloadedStrings #-}++module Frontend.Html where++import           Lucid+import           JMonkey                        ( interpretString )+import           Clay                           ( render )+import           Frontend.Css+import           Frontend.Js+import           Data.Gender+import           Data.Person+import           Data.Selector+import           Data.ToAttribute++lucidHtml :: [Person] -> Html ()+lucidHtml ps = do+    doctype_+    html_ $ do+        head_ $ do+            meta_ [charset_ "UTF-8"]+            meta_+                [ name_ "viewport"+                , content_ "width=device-width, initial-scale=1.0"+                ]+            style_ [type_ "text/css"] $ render clayCss+            title_ "Example"+        body_ $ do+            div_ [toAttr (Class AboveHeader)] $ do+                div_ [toAttr (Class First)] "yay!"+                h1_ "Various People"+            header_ [toAttr (Class Head)] $ do+                div_ [toAttr (Id ButtonAll), toClasses [Tab, Current]] "All"+                div_ [toAttr (Id $ Button Man), toAttr (Class Tab)]+                    $ toHtml (show Man)+                div_ [toAttr (Id $ Button Woman), toAttr (Class Tab)]+                    $ toHtml (show Woman)+                div_ [toAttr (Id $ Button Trans), toAttr (Class Tab)]+                    $ toHtml (show Trans)+            div_ . ul_ [toAttr (Class Content)] $ mapM_ box ps+            script_ [type_ "text/javascript"] $ interpretString jMonkeyJs++box :: Person -> Html ()+box p = li_ [toClasses [Box, Group (gender p)]] . dl_ $ do+    dt_ "Name"+    dd_ $ toHtml (name p)+    dt_ "Age"+    dd_ $ toHtml (show $ age p)+    dt_ "Gender"+    dd_ $ toHtml (show $ gender p)
+ example/Frontend/Js.hs view
@@ -0,0 +1,68 @@+module Frontend.Js where++import           JMonkey                 hiding ( Id+                                                , Class+                                                )+import           Data.Gender+import           Data.Selector           hiding ( Selector )+import           Data.ToAttribute++jMonkeyJs :: JMonkey+jMonkeyJs = do+    -- Header to be fixed from the middle+    header <- select $ toAttr (Class Head)+    onScroll win $ ifel (YOffset Grater 200)+                        (add header $ toAttr (Class HeadFixed))+                        (remove header $ toAttr (Class HeadFixed))++    -- Loops automatically change classes+    d <- select $ toAttr (Class First)+    onTime Endless 3000+        $ ifel+              (Possess d $ toAttr (Class First))+              (do+                  remove d $ toAttr (Class First)+                  add d $ toAttr (Class Second)+              )+        $ ifel+              (Possess d $ toAttr (Class Second))+              (do+                  remove d $ toAttr (Class Second)+                  add d $ toAttr (Class Third)+              )+        $ ifThen+              (Possess d $ toAttr (Class Third))+              (do+                  remove d $ toAttr (Class Third)+                  add d $ toAttr (Class First)+              )++    -- People filter+    groupMan   <- select $ toAttr (Class $ Group Man)+    groupWoman <- select $ toAttr (Class $ Group Woman)+    groupTrans <- select $ toAttr (Class $ Group Trans)+    btnMan     <- select $ toAttr (Id $ Button Man)+    btnWoman   <- select $ toAttr (Id $ Button Woman)+    btnTrans   <- select $ toAttr (Id $ Button Trans)+    btnAll     <- select $ toAttr (Id ButtonAll)+    onClick btnMan $ do+        removeAdds groupMan [groupWoman, groupTrans] $ toAttr (Class Hide)+        addRemoves btnMan [btnWoman, btnTrans, btnAll] $ toAttr (Class Current)+    onClick btnWoman $ do+        removeAdds groupWoman [groupMan, groupTrans] $ toAttr (Class Hide)+        addRemoves btnWoman [btnMan, btnTrans, btnAll] $ toAttr (Class Current)+    onClick btnTrans $ do+        removeAdds groupTrans [groupMan, groupWoman] $ toAttr (Class Hide)+        addRemoves btnTrans [btnMan, btnWoman, btnAll] $ toAttr (Class Current)+    onClick btnAll $ do+        removes [groupMan, groupWoman, groupTrans] $ toAttr (Class Hide)+        addRemoves btnAll [btnMan, btnWoman, btnTrans] $ toAttr (Class Current)+  where+    removeAdds :: Target -> [Target] -> Selector -> JMonkey+    removeAdds t ts sel = do+        remove t sel+        adds ts sel+    addRemoves :: Target -> [Target] -> Selector -> JMonkey+    addRemoves t ts sel = do+        add t sel+        removes ts sel
+ example/Main.hs view
@@ -0,0 +1,18 @@+module Main where++import           Network.Wai.Handler.Warp       ( run )+import           Network.Wai                    ( Application+                                                , responseLBS+                                                )+import           Network.HTTP.Types             ( status200 )+import           Lucid                          ( renderBS )+import           Frontend.Html+import           Data.Person++main :: IO ()+main = run 3000 app++app :: Application+app _ respond = do+    let bs = renderBS $ lucidHtml people+    respond $ responseLBS status200 [] bs
+ jmonkey.cabal view
@@ -0,0 +1,87 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 6fed5e823fdf4f4e59fa32ae04797bc55a4ed6fec67f5c2110f60fc2a17ea948++name:           jmonkey+version:        0.1.0.0+description:    Please see the README on GitHub at <https://github.com/opyapeus/jmonkey#readme>+homepage:       https://github.com/opyapeus/jmonkey#readme+bug-reports:    https://github.com/opyapeus/jmonkey/issues+author:         peus+maintainer:     opyapeus@gmail.com+copyright:      2018 peus+license:        MIT+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/opyapeus/jmonkey++library+  exposed-modules:+      JMonkey+      JMonkey.Action+      JMonkey.Data+      JMonkey.Interpreter+  other-modules:+      Paths_jmonkey+  hs-source-dirs:+      src+  build-depends:+      base >=4.7 && <5+    , casing+    , free+    , jmacro+  default-language: Haskell2010++executable jmonkey-example-exe+  main-is: Main.hs+  other-modules:+      Data.Gender+      Data.Person+      Data.Selector+      Data.ToAttribute+      Frontend.Css+      Frontend.Html+      Frontend.Js+      Paths_jmonkey+  hs-source-dirs:+      example+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , casing+    , clay+    , free+    , http-types+    , jmacro+    , jmonkey+    , lucid+    , text+    , wai+    , warp+  default-language: Haskell2010++test-suite jmonkey-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_jmonkey+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , casing+    , free+    , jmacro+    , jmonkey+  default-language: Haskell2010
+ src/JMonkey.hs view
@@ -0,0 +1,33 @@+-- | Jmonkey is very restricted but handy EDSL for javascript.+--+-- It's backend uses <http://hackage.haskell.org/package/free free> for designing DSL and <http://hackage.haskell.org/package/jmacro jmacro> for interpreter.+--+-- Here is some examples.+--+-- Click btn element then add "clicked" class to target elements.+--+-- @+-- btn <- select (Id "btn")+-- target <- select (Class "target")+-- onClick btn $ add target (Class "clicked")+-- @+--+-- If target element(s) have "hide" class then remove, otherwise add "hide" class.+--+-- @+-- ifel (Having target (Class "hide"))+--      (remove target (Class "hide"))+--      (add target (Class "hide"))+-- @+--+-- Once you define some actions like aboves, you can get javascript string easily by `interpretString`.+module JMonkey+  ( module JMonkey.Action+  , module JMonkey.Data+  , module JMonkey.Interpreter+  )+where++import           JMonkey.Action+import           JMonkey.Data+import           JMonkey.Interpreter
+ src/JMonkey/Action.hs view
@@ -0,0 +1,149 @@+{-# LANGUAGE DeriveFunctor #-}++-- | JMonkey actions.+module JMonkey.Action+  (+  -- * Types+    JMonkey+  , JMonkeyM+  , Action(..)+  , Cond(..)+  -- * Show+  , putLog+  , alert+  -- * Selection+  , select+  -- * Selector Modification+  , add+  , adds+  , remove+  , removes+  -- * On Event+  , on+  , onClick+  , onScroll+  , onChange+  -- * Time Triggered Event+  , onTime+  -- * Conditional Action+  , ifel+  , ifThen+  , elThen+  )+where++import           Control.Monad.Free+import           JMonkey.Data++-- | Empty JMonkey monad.+type JMonkey = JMonkeyM ()++-- | JMonkey monad designed with free monad.+type JMonkeyM = Free Action++-- | JMonkey action AST.+data Action n+  = Log String n+  | Alert String n+  | Select Selector (Target -> n)+  | Add Target Selector n+  | Remove Target Selector n+  | On String Target JMonkey n+  | OnTime Repeat Int JMonkey n+  | If Cond JMonkey JMonkey n+  deriving Functor++-- | JMonkey conditions.+-- These mean boolean value.+data Cond+  = Possess Target Selector -- ^ if all the target have the selector+  | YOffset CompOp Double -- ^ if window.pageYOffset satisfies with given comparision operator and threshold value  ++-- | Show console log.+putLog :: String -> JMonkey+putLog s = liftF $ Log s ()++-- | Show alert.+alert :: String -> JMonkey+alert s = liftF $ Alert s ()++-- | Select target by given selector.+select :: Selector -> JMonkeyM Target+select sel = liftF $ Select sel id++-- | Add class or id to the target.+-- +-- For multiple selectors+--+-- @+-- f :: Target -> [Selector] -> JMonkey+-- f t = mapM_ (`add` t)+-- @+add :: Target -> Selector -> JMonkey+add t sel = liftF $ Add t sel ()++-- | Add class or id to the targets.+-- +-- For multiple selectors+--+-- @+-- f :: [Target] -> [Selector] -> JMonkey+-- f ts = mapM_ (`adds` ts)+-- @+adds :: [Target] -> Selector -> JMonkey+adds ts sel = mapM_ (\t -> add t sel) ts++-- | Remove class or id from the target.+remove :: Target -> Selector -> JMonkey+remove t sel = liftF $ Remove t sel ()++-- | Remove class or id from the targets.+removes :: [Target] -> Selector -> JMonkey+removes ts sel = mapM_ (\t -> remove t sel) ts++-- | Make event.+on+  :: String -- ^ an event name like "click", "scroll", ...etc+  -> Target -- ^ a target related to the event+  -> JMonkey -- ^ an action triggered by the event+  -> JMonkey+on s t act = liftF $ On s t act ()++-- | Same as `on` "click".+onClick :: Target -> JMonkey -> JMonkey+onClick t act = liftF $ On "click" t act ()++-- | Same as `on` "scroll".+onScroll :: Target -> JMonkey -> JMonkey+onScroll t act = liftF $ On "scroll" t act ()++-- | Same as `on` "change".+onChange :: Target -> JMonkey -> JMonkey+onChange t act = liftF $ On "change" t act ()++-- | Make time triggered event.+onTime+  :: Repeat -- ^ repetition+  -> Int -- ^ delay time (milliseconds)+  -> JMonkey -- ^ an action on the time+  -> JMonkey+onTime r t act = liftF $ OnTime r t act ()++-- | Make conditional action.+ifel+  :: Cond -- ^ a condition+  -> JMonkey -- ^ an action do when the condition is satisfied+  -> JMonkey -- ^ an action do when the condition is not satisfied+  -> JMonkey+ifel c tA fA = liftF $ If c tA fA ()++-- | Only true conditional action of `ifel`+ifThen :: Cond -> JMonkey -> JMonkey+ifThen c tA = ifel c tA noop++-- | Only false conditional action of `ifel`+elThen :: Cond -> JMonkey -> JMonkey+elThen c = ifel c noop++noop :: JMonkey+noop = Pure ()
+ src/JMonkey/Data.hs view
@@ -0,0 +1,37 @@+-- | JMonkey data types.+module JMonkey.Data+    (+    -- * Types+      Selector(..)+    , Target(..)+    , CompOp(..)+    , Repeat(..)+    -- * Target+    , doc+    , win+    )+where++-- | Represents id and class.+data Selector = Id String | Class String+    deriving (Show, Eq)++-- | Represents javascript element(s).+data Target = Elem String | Elems String+    deriving (Show, Eq)++-- | Comparision operator.+data CompOp = Equal | Grater | Less+    deriving (Show, Eq)++-- | Repetition.+data Repeat = Once | Endless+    deriving (Show, Eq)++-- | Document element. +doc :: Target+doc = Elem "document"++-- | Window element. +win :: Target+win = Elem "window"
+ src/JMonkey/Interpreter.hs view
@@ -0,0 +1,108 @@+{-# LANGUAGE QuasiQuotes #-}++-- | JMonkey interpreter using jmacro backend.+module JMonkey.Interpreter +        ( +        -- * Interpreter+          interpretString+        , interpretJStat+        ) where++import           Control.Monad.Free+import           Language.Javascript.JMacro+import           Text.Casing+import           JMonkey.Action+import           JMonkey.Data++-- | Interpret to javascript string. +interpretString :: JMonkey -> String+interpretString = show . renderJs . interpretJStat++toStr :: Selector -> String+toStr (Id s) = '#' : s+toStr (Class s) = '.' : s++onEvent :: String -> String+onEvent = mappend "on"++jvar :: String -> JStat+jvar s = DeclStat (StrI s) Nothing++jref :: String -> JExpr+jref = ValExpr . JVar . StrI++-- TODO: check when compiling?+forbidden :: JStat+forbidden = [jmacro| throw "forbidden action: id corresponds to multiple elements." |]++-- | Interpret to jmacro statement. +interpretJStat :: JMonkey -> JStat+interpretJStat (Free (Log s n)) = [jmacro| console.log `s` |] <> interpretJStat n+interpretJStat (Free (Alert s n)) = [jmacro| alert `s` |] <> interpretJStat n+interpretJStat (Free (Select sel@(Id s) n)) = [jmacro|+        `jvar tmp`;+        `jref tmp` = document.querySelector(`toStr sel`);+|] <> interpretJStat (n $ Elem tmp)+        where tmp = "i_" ++ snake s -- TODO: allocate by generator?+interpretJStat (Free (Select sel@(Class s) n)) = [jmacro|+        `jvar tmps`;+        `jref tmps` = document.querySelectorAll(`toStr sel`);+|] <> interpretJStat (n $ Elems tmps)+        where tmps = "c_" ++ snake s -- TODO: allocate by generator?+interpretJStat (Free (Add (Elem t) (Class s) n)) = [jmacro| `jref t`.classList.add(`s`); |] <> interpretJStat n+interpretJStat (Free (Add (Elem t) sel@(Id _) n)) = [jmacro| `jref t`.id = `toStr sel`; |] <> interpretJStat n+interpretJStat (Free (Add (Elems t) (Class s) n)) = [jmacro|+        `jref t`.forEach( function e {+                e.classList.add(`s`);+        })+|] <> interpretJStat n+interpretJStat (Free (Add (Elems _) (Id _) n)) = forbidden <> interpretJStat n+interpretJStat (Free (Remove (Elem t) (Class s) n)) = [jmacro| `jref t`.classList.remove(`s`); |] <> interpretJStat n+interpretJStat (Free (Remove (Elem t) sel@(Id _) n)) = [jmacro| if (`jref t`.id == `toStr sel`) { `jref t`.id = ""; } |] <> interpretJStat n+interpretJStat (Free (Remove (Elems t) (Class s) n)) = [jmacro|+        `jref t`.forEach( function e {+                e.classList.remove(`s`);+        })+|] <> interpretJStat n+interpretJStat (Free (Remove (Elems _) (Id _) n)) = forbidden <> interpretJStat n        +interpretJStat (Free (On s (Elem t) a n)) = [jmacro|+        `jref t`[`event`] = function {+                `interpretJStat a`;+        }+|] <> interpretJStat n+        where event = onEvent s+interpretJStat (Free (On s (Elems t) a n)) = [jmacro|+        `jref t`.forEach( function e {+                e[`event`] = function { `interpretJStat a`; }+        });+|] <> interpretJStat n+        where event = onEvent s+interpretJStat (Free (OnTime Once i a n)) = [jmacro|+        var f = function { `interpretJStat a`; };+        setTimeout(f, `i`);+|] <> interpretJStat n+interpretJStat (Free (OnTime Endless i a n)) = [jmacro|+        var f = function { `interpretJStat a`; };+        setInterval(f, `i`);+|] <> interpretJStat n+interpretJStat (Free (If (Possess target sel) tA fA n)) = case (target, sel) of+        (Elem t, Class s) -> ifElse [jmacroE| `jref t`.classList.contains(`s`) |] tA fA <> interpretJStat n+        (Elems t, Class s) -> ifElse [jmacroE| Array.from(`jref t`).every(function e { return e.classList.contains(`s`); }) |] tA fA <> interpretJStat n+        (Elem t, Id s) -> ifElse [jmacroE| `jref t`.id == `s` |] tA fA <> interpretJStat n+        (Elems _, Id _) -> forbidden <> interpretJStat n+interpretJStat (Free (If (YOffset op v) tA fA n)) =+        let cond = case op of+                Equal -> [jmacroE| window.pageYOffset == `v` |]+                Grater -> [jmacroE| window.pageYOffset > `v` |]+                Less -> [jmacroE| window.pageYOffset < `v` |]+        in ifElse cond tA fA <> interpretJStat n+interpretJStat (Pure _) = nullStat++ifElse :: JExpr -> JMonkey -> JMonkey -> JStat+ifElse cond tA fA = [jmacro|+        if (`cond`) {+                `interpretJStat tA`;+        } else {+                `interpretJStat fA`;+        }+|] 
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"