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 +3/−0
- LICENSE +21/−0
- README.md +35/−0
- Setup.hs +2/−0
- example/Data/Gender.hs +4/−0
- example/Data/Person.hs +39/−0
- example/Data/Selector.hs +26/−0
- example/Data/ToAttribute.hs +37/−0
- example/Frontend/Css.hs +65/−0
- example/Frontend/Html.hs +49/−0
- example/Frontend/Js.hs +68/−0
- example/Main.hs +18/−0
- jmonkey.cabal +87/−0
- src/JMonkey.hs +33/−0
- src/JMonkey/Action.hs +149/−0
- src/JMonkey/Data.hs +37/−0
- src/JMonkey/Interpreter.hs +108/−0
- test/Spec.hs +2/−0
+ 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++[](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"