on master help sign in
Create module names in the AST.Module.Name module
6f31225Evan Czaplicki
src/AST/Module/Name.hs+39−35
@@ -1,32 +1,32 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE OverloadedStrings #-}
3module AST.Module.Name
3module AST.Module.Name
4− ( Raw
5− , Canonical(..)
4+ ( Canonical(..)
6− , inVirtualDom, inCore, inHtml, inBrowser
5+ , basics, maybe, list, array
6+ , jsonEncode, cmd, sub
7− , toString, toText, canonicalToText
7+ , canonicalToText
8 , isKernel, getKernel, canonicalIsKernel
8 , isKernel, getKernel, canonicalIsKernel
9 )
9 )
10 where
10 where
11
11
12+
13+import Prelude hiding (maybe)
12import Data.Binary
14import Data.Binary
13import qualified Data.Text as Text
15import qualified Data.Text as Text
14import Data.Text (Text)
16import Data.Text (Text)
15
17
16−import qualified Elm.Package as Package
18+import qualified Elm.Name as N
19+import qualified Elm.Package as Pkg
17
20
18
21
19
22
20-- NAMES
23-- NAMES
21
24
22
25
23−type Raw = Text -- must be non-empty
24−
25−
26data Canonical =
26data Canonical =
27 Canonical
27 Canonical
28− { _package :: !Package.Name
28+ { _package :: !Pkg.Name
29− , _module :: !Raw
29+ , _module :: !N.Name
30 }
30 }
31 deriving (Eq, Ord)
31 deriving (Eq, Ord)
32
32
@@ -35,56 +35,60 @@ data Canonical =
35-- HELPERS
35-- HELPERS
36
36
37
37
38−inVirtualDom :: Raw -> Canonical
38+basics :: Canonical
39−inVirtualDom raw =
39+basics =
40− Canonical Package.virtualDom raw
40+ Canonical Pkg.core "Basics"
41
41
42
42
43−inCore :: Raw -> Canonical
43+maybe :: Canonical
44−inCore raw =
44+maybe =
45− Canonical Package.core raw
45+ Canonical Pkg.core "Maybe"
46
46
47
47
48−inHtml :: Raw -> Canonical
48+list :: Canonical
49−inHtml raw =
49+list =
50− Canonical Package.html raw
50+ Canonical Pkg.core "List"
51
51
52
52
53−inBrowser :: Raw -> Canonical
53+array :: Canonical
54−inBrowser raw =
54+array =
55− Canonical Package.browser raw
55+ Canonical Pkg.core "Array"
56
56
57
57
58+jsonEncode :: Canonical
59+jsonEncode =
60+ Canonical Pkg.core "Json.Encode"
58
61
59−-- CONVERSIONS
60
62
63+cmd :: Canonical
64+cmd =
65+ Canonical Pkg.core "Platform.Cmd"
61
66
62−toString :: Raw -> String
63−toString =
64− Text.unpack
65
67
68+sub :: Canonical
69+sub =
70+ Canonical Pkg.core "Platform.Sub"
66
71
67−{-# INLINE toText #-}
72+
68−toText :: Raw -> Text
73+
69−toText name =
74+-- CONVERSIONS
70− name
71
75
72
76
73canonicalToText :: Canonical -> Text
77canonicalToText :: Canonical -> Text
74canonicalToText (Canonical _ name) =
78canonicalToText (Canonical _ name) =
75− toText name
79+ name
76
80
77
81
78
82
79-- IS KERNEL
83-- IS KERNEL
80
84
81
85
82−isKernel :: Raw -> Bool
86+isKernel :: N.Name -> Bool
83isKernel name =
87isKernel name =
84 Text.isPrefixOf "Elm.Kernel." name
88 Text.isPrefixOf "Elm.Kernel." name
85
89
86
90
87−getKernel :: Raw -> Text
91+getKernel :: N.Name -> Text
88getKernel name =
92getKernel name =
89 Text.drop 11 name
93 Text.drop 11 name
90
94
@@ -99,8 +103,8 @@ canonicalIsKernel (Canonical _ name) =
99
103
100
104
101instance Binary Canonical where
105instance Binary Canonical where
102− put (Canonical home name) =
106+ put (Canonical a b) =
103− put home >> put name
107+ put a >> put b
104
108
105 get =
109 get =
106 Canonical <$> get <*> get
110 Canonical <$> get <*> get
src/AST/Type.hs+6−6
@@ -68,17 +68,17 @@ data Super
68
68
69
69
70cmd :: ModuleName.Canonical -> Name -> Canonical
70cmd :: ModuleName.Canonical -> Name -> Canonical
71−cmd moduleName tipe =
71+cmd home tipe =
72 Lambda
72 Lambda
73− (Type moduleName tipe [Var "msg"])
73+ (Type home tipe [Var "msg"])
74− (Type (ModuleName.inCore "Platform.Cmd") "Cmd" [Var "msg"])
74+ (Type ModuleName.cmd "Cmd" [Var "msg"])
75
75
76
76
77sub :: ModuleName.Canonical -> Name -> Canonical
77sub :: ModuleName.Canonical -> Name -> Canonical
78−sub moduleName tipe =
78+sub home tipe =
79 Lambda
79 Lambda
80− (Type moduleName tipe [Var "msg"])
80+ (Type home tipe [Var "msg"])
81− (Type (ModuleName.inCore "Platform.Sub") "Sub" [Var "msg"])
81+ (Type ModuleName.sub "Sub" [Var "msg"])
82
82
83
83
84
84