/
Kancho.purs
69 lines (53 loc) · 2.04 KB
/
Kancho.purs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
module Kancho where
import Prelude
import Data.Foldable (intercalate)
import Data.List (List, (:))
import Foreign (Foreign)
import Prim.RowList as RL
import Type.Prelude (class IsSymbol, Proxy(..), RLProxy(..), SProxy(..), reflectSymbol)
toElmModel :: forall a. HasElmPortVersion a => a -> a
toElmModel = identity
getElmRep :: forall a
. HasElmPortVersion a
=> Proxy a
-> String
getElmRep _ = toElmTypeRep (Proxy :: Proxy a)
class HasElmPortVersion ty where
toElmTypeRep :: Proxy ty -> String
instance hasElmPortVersionInt :: HasElmPortVersion Int where
toElmTypeRep _ = "Int"
instance hasElmPortVersionNumber :: HasElmPortVersion Number where
toElmTypeRep _ = "Float"
instance hasElmPortVersionString :: HasElmPortVersion String where
toElmTypeRep _ = "String"
instance hasElmPortVersionBoolean :: HasElmPortVersion Boolean where
toElmTypeRep _ = "Bool"
instance hasElmPortVersionArray ::
( HasElmPortVersion inner
) => HasElmPortVersion (Array inner) where
toElmTypeRep _ = "List " <> toElmTypeRep (Proxy :: Proxy inner)
instance hasElmPortVersionForeign :: HasElmPortVersion Foreign where
toElmTypeRep _ = "Json.Encode.Value"
instance hasElmPortVersionRecord ::
( RL.RowToList fields fieldList
, HasElmPortVersionFields fieldList
) => HasElmPortVersion (Record fields) where
toElmTypeRep _ =
"{" <> contents <> "}"
where
contents = intercalate "\n , " $ extractFields (RLProxy :: RLProxy fieldList)
class HasElmPortVersionFields (xs :: RL.RowList) where
extractFields :: RLProxy xs -> List String
instance hasElmPortVersionAndFieldsCons ::
( IsSymbol name
, HasElmPortVersion ty
, HasElmPortVersionFields tail
) => HasElmPortVersionFields (RL.Cons name ty tail) where
extractFields _ = field : rest
where
name = reflectSymbol (SProxy :: SProxy name)
tyName = toElmTypeRep (Proxy :: Proxy ty)
field = name <> " : " <> tyName
rest = extractFields (RLProxy :: RLProxy tail)
instance hasElmPortVersionAndFieldsNil :: HasElmPortVersionFields RL.Nil where
extractFields _ = mempty