|
1 | | -module ECharts.Monad |
2 | | - ( DSL |
3 | | - , DSLMonad(DSL) |
4 | | - , buildObj |
5 | | - , buildArr |
6 | | - , buildSeries |
7 | | - , set |
8 | | - , get |
9 | | - , lastWithKeys |
10 | | - ) where |
11 | | - |
12 | | -import Prelude |
13 | | - |
14 | | -import Control.Monad.Writer (Writer, execWriter) |
15 | | -import Control.Monad.Writer.Class (tell) |
16 | | - |
17 | | -import Data.Array as Arr |
18 | | -import Data.Foldable as F |
19 | | -import Data.Foreign (Foreign, toForeign) |
20 | | -import Data.Maybe (Maybe(..)) |
21 | | -import Data.Tuple (Tuple(..), uncurry, snd) |
22 | | - |
23 | | -import ECharts.Internal (unsafeSetField, emptyObject) |
24 | | - |
25 | | -newtype DSLMonad (i ∷ # !) a = DSL (Writer (Array (Tuple String Foreign)) a) |
26 | | -unDSL ∷ ∀ i a. DSLMonad i a → Writer (Array (Tuple String Foreign)) a |
27 | | -unDSL (DSL m) = m |
28 | | - |
29 | | -derive newtype instance functorDSL ∷ Functor (DSLMonad i) |
30 | | -derive newtype instance applyDSL ∷ Apply (DSLMonad i) |
31 | | -derive newtype instance applicativeDSL ∷ Applicative (DSLMonad i) |
32 | | -derive newtype instance bindDSL ∷ Bind (DSLMonad i) |
33 | | -derive newtype instance monadDSL ∷ Monad (DSLMonad i) |
34 | | - |
35 | | -type DSL i = DSLMonad i Unit |
36 | | - |
37 | | -set ∷ ∀ i. String → Foreign → DSL i |
38 | | -set k v = DSL $ tell $ Arr.singleton $ Tuple k v |
39 | | - |
40 | | -get ∷ ∀ i. String → DSL i → Maybe Foreign |
41 | | -get k (DSL cs) = |
42 | | - F.foldl (foldFn k) Nothing $ execWriter cs |
43 | | - where |
44 | | - foldFn ∷ String → Maybe Foreign → Tuple String Foreign → Maybe Foreign |
45 | | - foldFn k' Nothing (Tuple kk f) | k' == kk = Just f |
46 | | - foldFn _ a _ = a |
47 | | - |
48 | | -lastWithKeys ∷ ∀ i f. F.Foldable f ⇒ f String → DSL i → Maybe Foreign |
49 | | -lastWithKeys ks (DSL cs) = |
50 | | - F.foldl (foldFn ks) Nothing $ Arr.reverse $ execWriter cs |
51 | | - where |
52 | | - foldFn ∷ f String → Maybe Foreign → Tuple String Foreign → Maybe Foreign |
53 | | - foldFn ks' Nothing (Tuple kk f) | F.elem kk ks' = Just f |
54 | | - foldFn _ a _ = a |
55 | | - |
56 | | -applyOnePair ∷ Tuple String Foreign → Foreign → Foreign |
57 | | -applyOnePair opt obj = uncurry (unsafeSetField obj) opt |
58 | | - |
59 | | -buildObj ∷ ∀ i. DSL i → Foreign |
60 | | -buildObj (DSL cs) = |
61 | | - F.foldr applyOnePair (emptyObject unit) $ execWriter cs |
62 | | - |
63 | | -buildSeries ∷ ∀ i. DSL i → Foreign |
64 | | -buildSeries (DSL cs) = |
65 | | - toForeign $ map (\(Tuple ty f) → unsafeSetField f "type" $ toForeign ty) $ execWriter cs |
66 | | - |
67 | | -buildArr ∷ ∀ i. DSL i → Foreign |
68 | | -buildArr (DSL cs) = |
69 | | - toForeign $ map snd $ execWriter cs |
| 1 | +module ECharts.Monad |
| 2 | + ( DSL |
| 3 | + , DSLMonad(DSL) |
| 4 | + , buildObj |
| 5 | + , buildArr |
| 6 | + , buildSeries |
| 7 | + , set |
| 8 | + , get |
| 9 | + , lastWithKeys |
| 10 | + ) where |
| 11 | + |
| 12 | +import Prelude |
| 13 | + |
| 14 | +import Control.Monad.Eff (kind Effect) |
| 15 | +import Control.Monad.Writer (Writer, execWriter) |
| 16 | +import Control.Monad.Writer.Class (tell) |
| 17 | + |
| 18 | +import Data.Array as Arr |
| 19 | +import Data.Foldable as F |
| 20 | +import Data.Foreign (Foreign, toForeign) |
| 21 | +import Data.Maybe (Maybe(..)) |
| 22 | +import Data.Tuple (Tuple(..), uncurry, snd) |
| 23 | + |
| 24 | +import ECharts.Internal (unsafeSetField, emptyObject) |
| 25 | + |
| 26 | +newtype DSLMonad (i ∷ # Effect) a = DSL (Writer (Array (Tuple String Foreign)) a) |
| 27 | +unDSL ∷ ∀ i a. DSLMonad i a → Writer (Array (Tuple String Foreign)) a |
| 28 | +unDSL (DSL m) = m |
| 29 | + |
| 30 | +derive newtype instance functorDSL ∷ Functor (DSLMonad i) |
| 31 | +derive newtype instance applyDSL ∷ Apply (DSLMonad i) |
| 32 | +derive newtype instance applicativeDSL ∷ Applicative (DSLMonad i) |
| 33 | +derive newtype instance bindDSL ∷ Bind (DSLMonad i) |
| 34 | +derive newtype instance monadDSL ∷ Monad (DSLMonad i) |
| 35 | + |
| 36 | +type DSL i = DSLMonad i Unit |
| 37 | + |
| 38 | +set ∷ ∀ i. String → Foreign → DSL i |
| 39 | +set k v = DSL $ tell $ Arr.singleton $ Tuple k v |
| 40 | + |
| 41 | +get ∷ ∀ i. String → DSL i → Maybe Foreign |
| 42 | +get k (DSL cs) = |
| 43 | + F.foldl (foldFn k) Nothing $ execWriter cs |
| 44 | + where |
| 45 | + foldFn ∷ String → Maybe Foreign → Tuple String Foreign → Maybe Foreign |
| 46 | + foldFn k' Nothing (Tuple kk f) | k' == kk = Just f |
| 47 | + foldFn _ a _ = a |
| 48 | + |
| 49 | +lastWithKeys ∷ ∀ i f. F.Foldable f ⇒ f String → DSL i → Maybe Foreign |
| 50 | +lastWithKeys ks (DSL cs) = |
| 51 | + F.foldl (foldFn ks) Nothing $ Arr.reverse $ execWriter cs |
| 52 | + where |
| 53 | + foldFn ∷ f String → Maybe Foreign → Tuple String Foreign → Maybe Foreign |
| 54 | + foldFn ks' Nothing (Tuple kk f) | F.elem kk ks' = Just f |
| 55 | + foldFn _ a _ = a |
| 56 | + |
| 57 | +applyOnePair ∷ Tuple String Foreign → Foreign → Foreign |
| 58 | +applyOnePair opt obj = uncurry (unsafeSetField obj) opt |
| 59 | + |
| 60 | +buildObj ∷ ∀ i. DSL i → Foreign |
| 61 | +buildObj (DSL cs) = |
| 62 | + F.foldr applyOnePair (emptyObject unit) $ execWriter cs |
| 63 | + |
| 64 | +buildSeries ∷ ∀ i. DSL i → Foreign |
| 65 | +buildSeries (DSL cs) = |
| 66 | + toForeign $ map (\(Tuple ty f) → unsafeSetField f "type" $ toForeign ty) $ execWriter cs |
| 67 | + |
| 68 | +buildArr ∷ ∀ i. DSL i → Foreign |
| 69 | +buildArr (DSL cs) = |
| 70 | + toForeign $ map snd $ execWriter cs |
0 commit comments