-
Notifications
You must be signed in to change notification settings - Fork 2
/
Core.purs
205 lines (175 loc) · 7.3 KB
/
Core.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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
module TsBridge.Core
( class RecordDef
, class RecordDefRL
, class TsBridgeBy
, recordDef
, recordDefRL
, tsBridgeBy
, tsModuleFile
, tsOpaqueType
, tsProgram
, tsTypeAlias
, tsTypeAliasFromValue
, tsTypeAliasesFromValues
, tsValue
, tsValues
) where
import Prelude
import Control.Monad.Error.Class (throwError)
import Control.Monad.Writer (censor, listens, tell)
import DTS (TsDeclaration(..))
import DTS as DTS
import Data.Array as A
import Data.Array as Arr
import Data.Array as Array
import Data.Either (Either)
import Data.Map as Map
import Data.Maybe (Maybe(..))
import Data.Newtype (un)
import Data.Set as Set
import Data.Set.Ordered as OSet
import Data.Symbol (class IsSymbol, reflectSymbol)
import Data.Traversable (for_, sequence)
import Data.Tuple.Nested ((/\))
import Prim.Row as Row
import Prim.RowList (class RowToList, RowList)
import Prim.RowList as RL
import Safe.Coerce (coerce)
import TsBridge.Monad (Scope(..), TsBridgeAccum(..), TsBridgeM, runTsBridgeM)
import TsBridge.Types (AppError(..), mapErr, mkName, mkPursModuleName, toTsName)
import Type.Proxy (Proxy(..))
-- | Type Class that is used by the type generator to recursively traverse
-- | types.
-- | Instances for the specific types will be defined on the user's side with a
-- | typeclass like this:
-- | ```
-- | class TsBridge a where
-- | tsBridge :: a -> StandaloneTsType
-- | ```
-- | Then the internal type class is forwarded to the
-- | one of the user. For this you need to define a token data type and an
-- | instance like this:
-- | ```
-- | data Tok = Tok
-- |
-- | instance TsBridge a => TsBridgeBy Tok a where
-- | tsBridgeBy _ = tsBridge
-- | ```
-- | The token will then be passed to all generic functions of the library.
class TsBridgeBy :: Type -> Type -> Constraint
class TsBridgeBy tok a where
tsBridgeBy :: tok -> Proxy a -> TsBridgeM DTS.TsType
tsModuleFile :: String -> Array (TsBridgeM (Array DTS.TsDeclaration)) -> Either AppError (Array DTS.TsModuleFile)
tsModuleFile n xs =
mapErr (AtModule n)
do
_ <- mkPursModuleName n
(xs' /\ TsBridgeAccum { typeDefs }) <- runTsBridgeM $ join <$> sequence xs
let
names = Arr.mapMaybe declToName xs'
duplicate = Arr.head $ Arr.difference names (Arr.nub names)
for_ duplicate (throwError <<< ErrDuplicateIdentifier)
pure (typeDefs <> [ DTS.TsModuleFile (DTS.TsFilePath (n <> "/index.d.ts")) (DTS.TsModule xs') ])
declToName :: DTS.TsDeclaration -> Maybe DTS.TsName
declToName = case _ of
TsDeclTypeDef name _ _ _ -> Just name
TsDeclValueDef name _ _ -> Just name
TsDeclComments _ -> Nothing
mergeModules :: Array DTS.TsModuleFile -> DTS.TsProgram
mergeModules xs =
xs
<#> (\(DTS.TsModuleFile mp m) -> mp /\ m)
# Map.fromFoldableWith mergeModule
# DTS.TsProgram
mergeModule :: DTS.TsModule -> DTS.TsModule -> DTS.TsModule
mergeModule (DTS.TsModule ds1) (DTS.TsModule ds2) =
DTS.TsModule
(Array.nub (ds1 <> ds2))
tsProgram :: Array (Either AppError (Array DTS.TsModuleFile)) -> Either AppError DTS.TsProgram
tsProgram xs =
xs # sequence <#> join >>> mergeModules
-- | For rare cases where you want to export a type alias. References to this type
-- | alias will be fully resolved in the generated code. So it is more practical
-- | to use a newtype instead, which can be references by name.
tsTypeAlias :: forall tok a. TsBridgeBy tok a => tok -> String -> Proxy a -> TsBridgeM (Array DTS.TsDeclaration)
tsTypeAlias tok aliasName x = ado
x /\ scope <- listens (un TsBridgeAccum >>> _.scope >>> un Scope) t
name <- mkName aliasName
in [ DTS.TsDeclTypeDef (toTsName name) DTS.Public (coerce scope.floating) x ]
where
t = tsBridgeBy tok x
tsTypeAliasFromValue :: forall tok a. TsBridgeBy tok a => tok -> String -> a -> TsBridgeM (Array DTS.TsDeclaration)
tsTypeAliasFromValue tok aliasName _ = tsTypeAlias tok aliasName (Proxy :: _ a)
-- | For rare cases where you want to manually export an opaque type. Once you export a
-- | value that contains a reference to this type, the type will be generated
-- | and exported automatically. Thus in most cases you don't need this.
tsOpaqueType :: forall tok a. TsBridgeBy tok a => tok -> Proxy a -> TsBridgeM (Array DTS.TsDeclaration)
tsOpaqueType tok x = do
_ /\ modules <- listens (un TsBridgeAccum >>> _.typeDefs) $ tsBridgeBy tok x
case A.uncons modules of
Just { head: (DTS.TsModuleFile _ (DTS.TsModule decls)), tail: [] } -> do
tell mempty
pure decls
_ -> pure []
-- | Exports a single PureScript value to TypeScript. `tsValues` may be better choice.
tsValue :: forall tok a. TsBridgeBy tok a => tok -> String -> a -> TsBridgeM (Array DTS.TsDeclaration)
tsValue tok n _ = tsValue' tok n (Proxy :: _ a)
tsValue' :: forall tok a. TsBridgeBy tok a => tok -> String -> Proxy a -> TsBridgeM (Array DTS.TsDeclaration)
tsValue' tok n _ =
censor (\(TsBridgeAccum acc) -> TsBridgeAccum acc { scope = mempty })
$
mapErr (AtValue n)
do
let t = tsBridgeBy tok (Proxy :: _ a)
x /\ scope <- listens (un TsBridgeAccum >>> _.scope >>> un Scope) t
name <- mkName n
when (OSet.length scope.floating /= 0)
( throwError
$ ErrUnquantifiedTypeVariables
$ (Set.fromFoldable :: Array _ -> _)
$ OSet.toUnfoldable scope.floating
)
pure [ DTS.TsDeclValueDef (toTsName name) DTS.Public x ]
tsValues :: forall tok r. RecordDef tok r => tok -> Record r -> TsBridgeM (Array DTS.TsDeclaration)
tsValues = recordDef { handleRow: tsValue' }
tsTypeAliasesFromValues :: forall tok r. RecordDef tok r => tok -> Record r -> TsBridgeM (Array DTS.TsDeclaration)
tsTypeAliasesFromValues = recordDef { handleRow: tsTypeAlias }
--------------------------------------------------------------------------------
-- class RecordDef
--------------------------------------------------------------------------------
class RecordDef tok r where
-- | Useful for declaring multiple PureScript values to be used by TypeScript.
-- | Through record punning the risk of exporting them with wrong names can be eliminated.
-- | ```tsValues Tok { foo, bar, baz }```
recordDef
:: { handleRow :: forall (a :: Type). TsBridgeBy tok a => tok -> String -> Proxy a -> TsBridgeM (Array TsDeclaration) }
-> tok
-> Record r
-> TsBridgeM (Array DTS.TsDeclaration)
instance (RecordDefRL tok r rl, RowToList r rl) => RecordDef tok r where
recordDef ifc tok r = recordDefRL ifc tok r (Proxy :: _ rl)
--------------------------------------------------------------------------------
-- class RecordDefRL
--------------------------------------------------------------------------------
class RecordDefRL :: Type -> Row Type -> RowList Type -> Constraint
class RecordDefRL tok r rl where
recordDefRL
:: { handleRow :: forall (a :: Type). TsBridgeBy tok a => tok -> String -> Proxy a -> TsBridgeM (Array TsDeclaration) }
-> tok
-> Record r
-> Proxy rl
-> TsBridgeM (Array DTS.TsDeclaration)
instance RecordDefRL tok r RL.Nil where
recordDefRL _ _ _ _ = pure []
instance
( RecordDefRL tok r rl
, TsBridgeBy tok a
, Row.Cons sym a rx r
, IsSymbol sym
) =>
RecordDefRL tok r (RL.Cons sym a rl)
where
recordDefRL ifc tok r _ = (<>) <$> head <*> tail
where
tail = recordDefRL ifc tok r (Proxy :: _ rl)
head = ifc.handleRow tok (reflectSymbol (Proxy :: _ sym)) (Proxy :: _ a)