git.iko.soy/elm-ps-bridge
on master help sign in
added lists
c9ac6aciko
elm-ps-bridge.cabal+1
compare with master
unifiedsplit
@@ -57,6 +57,7 @@ executable elm-ps-bridge
57 TypeOperators
57 TypeOperators
58 UndecidableInstances
58 UndecidableInstances
59 ViewPatterns
59 ViewPatterns
60+ ghc-options: -Weverything -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-safe -Wno-prepositive-qualified-module -Wno-missing-import-lists -Wno-all-missed-specialisations -Wno-missing-local-signatures -Wno-partial-fields -Wno-unsafe -Wno-monomorphism-restriction -Wno-missed-specialisations -Wno-partial-type-signatures -Wno-unticked-promoted-constructors -Wno-incomplete-uni-patterns -Wno-missing-kind-signatures -fexpose-all-unfoldings -fspecialise-aggressively -O0 -threaded -rtsopts -with-rtsopts=-N
60 build-depends:
61 build-depends:
61 aeson
62 aeson
62 , base
63 , base
package.yaml+11
@@ -61,3 +61,14 @@ default-extensions:
61 - TypeOperators
61 - TypeOperators
62 - UndecidableInstances
62 - UndecidableInstances
63 - ViewPatterns
63 - ViewPatterns
64+
65+ghc-options:
66+ -Weverything -Wno-implicit-prelude -Wno-missing-safe-haskell-mode
67+ -Wno-safe -Wno-prepositive-qualified-module
68+ -Wno-missing-import-lists -Wno-all-missed-specialisations
69+ -Wno-missing-local-signatures -Wno-partial-fields -Wno-unsafe
70+ -Wno-monomorphism-restriction -Wno-missed-specialisations
71+ -Wno-partial-type-signatures -Wno-unticked-promoted-constructors
72+ -Wno-incomplete-uni-patterns -Wno-missing-kind-signatures
73+ -fexpose-all-unfoldings -fspecialise-aggressively -O0 -threaded
74+ -rtsopts -with-rtsopts=-N
src/Main.hs+47−6
@@ -2,10 +2,8 @@ module Main (main) where
2
2
3import Control.Monad.Writer.Strict
3import Control.Monad.Writer.Strict
4import Data.Aeson hiding (Options)
4import Data.Aeson hiding (Options)
5−import Data.Aeson.Types (Parser)
6import Data.HashMap.Strict qualified as HM
5import Data.HashMap.Strict qualified as HM
7import Data.Map.Lazy qualified as M
6import Data.Map.Lazy qualified as M
8−import Data.Text qualified as T
9import Data.Vector (Vector)
7import Data.Vector (Vector)
10import Data.Vector qualified as V
8import Data.Vector qualified as V
11import Data.Yaml as Yaml
9import Data.Yaml as Yaml
@@ -70,10 +68,25 @@ elm datattypes =
70 in makeElmModuleFromETypeDef "Bridge" types
68 in makeElmModuleFromETypeDef "Bridge" types
71
69
72elmType :: Text -> Datatype -> Writer [ETypeDef] EType
70elmType :: Text -> Datatype -> Writer [ETypeDef] EType
73−elmType name BoolType = pure $ ETyCon $ ETCon "Bool"
71+elmType _ BoolType = pure $ ETyCon $ ETCon "Bool"
74−elmType name IntType = pure $ ETyCon $ ETCon "Int"
72+elmType _ IntType = pure $ ETyCon $ ETCon "Int"
75−elmType name FloatType = pure $ ETyCon $ ETCon "Float"
73+elmType _ FloatType = pure $ ETyCon $ ETCon "Float"
76−elmType name StringType = pure $ ETyCon $ ETCon "String"
74+elmType _ StringType = pure $ ETyCon $ ETCon "String"
75+elmType name (List inner) = do
76+ -- fields' <- traverse (\(k, v) -> (toString k,) <$> elmType (name <> "_" <> k) v) $ M.toList fields
77+ inner' <- elmType name inner
78+ tell
79+ [ ETypePrimAlias
80+ EPrimAlias
81+ { epa_name =
82+ ETypeName
83+ { et_name = toString name <> "_List",
84+ et_args = []
85+ },
86+ epa_type = ETyApp (ETyCon (ETCon "List")) inner'
87+ }
88+ ]
89+ pure $ ETyCon $ ETCon $ toString name
77elmType name (ProductType fields) = do
90elmType name (ProductType fields) = do
78 fields' <- traverse (\(k, v) -> (toString k,) <$> elmType (name <> "_" <> k) v) $ M.toList fields
91 fields' <- traverse (\(k, v) -> (toString k,) <$> elmType (name <> "_" <> k) v) $ M.toList fields
79 tell
92 tell
@@ -125,6 +138,34 @@ psType _ BoolType = pure psBool
125psType _ IntType = pure psInt
138psType _ IntType = pure psInt
126psType _ FloatType = pure psNumber
139psType _ FloatType = pure psNumber
127psType _ StringType = pure psString
140psType _ StringType = pure psString
141+psType name (List inner) = do
142+ inner' <- psType name inner
143+ let ti =
144+ TypeInfo
145+ { _typePackage = "bridge",
146+ _typeModule = "Bridge",
147+ _typeName = name <> "_List",
148+ _typeParameters = []
149+ }
150+ tell
151+ [ PS.SumType
152+ ti
153+ [ DataConstructor
154+ { _sigConstructor = name <> "_List",
155+ _sigValues =
156+ Left
157+ [ TypeInfo
158+ { _typePackage = "builtins",
159+ _typeModule = "Prim",
160+ _typeName = "Array",
161+ _typeParameters = [inner']
162+ }
163+ ]
164+ }
165+ ]
166+ allInstances
167+ ]
168+ pure ti
128psType name (SumDatatype (SumType sums)) = do
169psType name (SumDatatype (SumType sums)) = do
129 sums' <- traverse (\(k, v) -> (k,) <$> traverse (psType (name <> "_" <> k)) v) $ M.toList sums
170 sums' <- traverse (\(k, v) -> (k,) <$> traverse (psType (name <> "_" <> k)) v) $ M.toList sums
130 let ti =
171 let ti =