git.iko.soy/rowtype-yoga/psfp
on e418926 help sign in
rowtype-yoga/psfp/components/src/Yoga/JSS.purs
112 lines 3.6 kB history raw
1module JSS where
3import Prelude
4import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
5import Foreign (unsafeToForeign)
6import Foreign.Object (Object)
7import Foreign.Object as Object
8import Prim.RowList (class RowToList, Nil, kind RowList)
9import Record as Record
10import Record.Builder (Builder)
11import Record.Builder as Builder
12import Simple.JSON (class WriteForeign, write, writeImpl)
13import Type.Prelude (RLProxy, Proxy(..))
14import Type.Row as R
15import Type.Row.Homogeneous (class Homogeneous)
16import Type.RowList as RL
17import Untagged.Coercible (coerce)
18import Untagged.Union (type (|+|))
20newtype JSSClasses theme props r
21 = JSSClasses ({ | theme } -> { | r })
23jssClasses ∷
24 ∀ theme props r.
25 (Homogeneous r (JSSElem props)) =>
26 ({ | theme } -> { | r }) -> JSSClasses theme props r
27jssClasses = JSSClasses
29data JSSElem props
30 = PrimitiveJss (String |+| Int |+| Number)
31 | ArrayJss (Array (JSSElem props))
32 | PropsJss (props -> JSSElem props)
33 | NestedJss (Object (JSSElem props))
35instance semigroupJssElem ∷ Semigroup (JSSElem props) where
36 append = case _, _ of
37 NestedJss n1, NestedJss n2 -> NestedJss (n1 <> n2)
38 _, second -> second
40instance wfJSSElem ∷ WriteForeign (JSSElem props) where
41 writeImpl = case _ of
42 PrimitiveJss p -> unsafeToForeign p
43 ArrayJss proper -> write (map writeImpl proper)
44 PropsJss proper -> unsafeToForeign (map writeImpl proper)
45 NestedJss proper -> writeImpl (map writeImpl proper)
47class JSSAble p a | a -> p where
48 jss ∷ a -> JSSElem p
50instance jssAbleJssElem ∷ JSSAble p (JSSElem p) where
51 jss = identity
53instance jssAbleString ∷ JSSAble p String where
54 jss = coerce >>> PrimitiveJss
56instance jssAbleInt ∷ JSSAble p Int where
57 jss = coerce >>> PrimitiveJss
59instance jssAbleNumber ∷ JSSAble p Number where
60 jss = coerce >>> PrimitiveJss
62instance jssAbleArray ∷ JSSAble p a => JSSAble p (Array a) where
63 jss arr = ArrayJss (jss <$> arr)
65instance jssAbleWithProps ∷ JSSAble p jss => JSSAble p (p -> jss) where
66 jss = propsJss
68instance jssAbleNested ∷ JSSAble p jss => JSSAble p (Object jss) where
69 jss = map jss >>> NestedJss
71instance jssAbleRecord ∷
72 ( JSSAbleFields props rowRL row () to
73 , RowToList row rowRL
74 , Homogeneous to (JSSElem props)
75 ) =>
76 JSSAble props (Record row) where
77 jss rec = NestedJss <<< Object.fromHomogeneous $ built
78 where
79 built ∷ Record to
80 built = Builder.build builder {}
81 rlp = RL.RLProxy ∷ RL.RLProxy rowRL
82 propsy = Proxy ∷ Proxy props
83 builder ∷ Builder.Builder (Record ()) (Record to)
84 builder = jssifyFields propsy rlp rec
86propsJss ∷ ∀ p a. JSSAble p a => (p -> a) -> JSSElem p
87propsJss fn = PropsJss (map jss fn)
89class JSSAbleFields props (xs ∷ RowList) (row ∷ #Type) (from ∷ #Type) (to ∷ #Type) | xs -> props row from to where
90 jssifyFields ∷ Proxy props -> RLProxy xs -> Record row -> Builder (Record from) (Record to)
92instance jssAbleFieldsNil ∷ JSSAbleFields props Nil row () () where
93 jssifyFields _ _ _ = identity
95instance jssAbleFieldsCons ∷
96 ( IsSymbol name
97 , JSSAble props a
98 , R.Lacks name from'
99 , R.Cons name a trash row
100 , R.Cons name (JSSElem props) from' to
101 , JSSAbleFields props tail row from from'
102 ) =>
103 JSSAbleFields props (RL.Cons name a tail) row from to where
104 jssifyFields _ _ r = first <<< rest
105 where
106 first = Builder.insert nameP (jss val)
107 val = Record.get nameP r
108 rest = jssifyFields propsP tailP r
109 nameP = SProxy ∷ SProxy name
110 tailP = RL.RLProxy ∷ RL.RLProxy tail
111 propsP = Proxy ∷ Proxy props
112 name = reflectSymbol nameP