git.iko.soy/elk
on master help sign in
style: modernize for Haskell style guide
41dfc6cEvan Czaplicki
src/AST/Variable.hs+34−3
compare with master
unifiedsplit
@@ -7,27 +7,37 @@ import Text.PrettyPrint as P
7import qualified AST.Helpers as Help
7import qualified AST.Helpers as Help
8import AST.PrettyPrint
8import AST.PrettyPrint
9
9
10+
11+-- VARIABLES
12+
10newtype Raw = Raw String
13newtype Raw = Raw String
11 deriving (Eq,Ord,Show)
14 deriving (Eq,Ord,Show)
12
15
16+
13data Home
17data Home
14 = BuiltIn
18 = BuiltIn
15 | Module [String]
19 | Module [String]
16 | Local
20 | Local
17 deriving (Eq,Ord,Show)
21 deriving (Eq,Ord,Show)
18
22
23+
19data Canonical = Canonical
24data Canonical = Canonical
20 { home :: !Home
25 { home :: !Home
21 , name :: !String
26 , name :: !String
27+ }
22− } deriving (Eq,Ord,Show)
28+ deriving (Eq,Ord,Show)
29+
23
30
24local :: String -> Canonical
31local :: String -> Canonical
25local x = Canonical Local x
32local x = Canonical Local x
26
33
34+
27builtin :: String -> Canonical
35builtin :: String -> Canonical
28builtin x = Canonical BuiltIn x
36builtin x = Canonical BuiltIn x
29
37
30−-- To help with pattern matching on some common canonical variables:
38+
39+-- VARIABLE RECOGNIZERS
40+
31is :: [String] -> String -> Canonical -> Bool
41is :: [String] -> String -> Canonical -> Bool
32is home name var =
42is home name var =
33 var == Canonical (Module home) name
43 var == Canonical (Module home) name
@@ -83,12 +93,16 @@ isText =
83 is ["Text"] "Text"
93 is ["Text"] "Text"
84
94
85
95
96+-- VARIABLE TO STRING
97+
86class ToString a where
98class ToString a where
87 toString :: a -> String
99 toString :: a -> String
88
100
101+
89instance ToString Raw where
102instance ToString Raw where
90 toString (Raw x) = x
103 toString (Raw x) = x
91
104
105+
92instance ToString Canonical where
106instance ToString Canonical where
93 toString (Canonical home name) =
107 toString (Canonical home name) =
94 case home of
108 case home of
@@ -96,14 +110,20 @@ instance ToString Canonical where
96 Module path -> List.intercalate "." (path ++ [name])
110 Module path -> List.intercalate "." (path ++ [name])
97 Local -> name
111 Local -> name
98
112
113+
114+-- LISTINGS
115+
99-- | A listing of values. Something like (a,b,c) or (..) or (a,b,..)
116-- | A listing of values. Something like (a,b,c) or (..) or (a,b,..)
100data Listing a = Listing
117data Listing a = Listing
101 { _explicits :: [a]
118 { _explicits :: [a]
102 , _open :: Bool
119 , _open :: Bool
103 } deriving (Eq,Ord,Show)
120 } deriving (Eq,Ord,Show)
104
121
122+
105openListing :: Listing a
123openListing :: Listing a
106−openListing = Listing [] True
124+openListing =
125+ Listing [] True
126+
107
127
108-- | A value that can be imported or exported
128-- | A value that can be imported or exported
109data Value
129data Value
@@ -112,18 +132,24 @@ data Value
112 | ADT !String !(Listing String)
132 | ADT !String !(Listing String)
113 deriving (Eq,Ord,Show)
133 deriving (Eq,Ord,Show)
114
134
135+
136+-- PRETTY VARIABLES
137+
115instance Pretty Raw where
138instance Pretty Raw where
116 pretty (Raw var) = variable var
139 pretty (Raw var) = variable var
117
140
141+
118instance Pretty Canonical where
142instance Pretty Canonical where
119 pretty var = P.text (toString var)
143 pretty var = P.text (toString var)
120
144
145+
121instance Pretty a => Pretty (Listing a) where
146instance Pretty a => Pretty (Listing a) where
122 pretty (Listing explicits open) =
147 pretty (Listing explicits open) =
123 P.parens (commaCat (map pretty explicits ++ dots))
148 P.parens (commaCat (map pretty explicits ++ dots))
124 where
149 where
125 dots = [if open then P.text ".." else P.empty]
150 dots = [if open then P.text ".." else P.empty]
126
151
152+
127instance Pretty Value where
153instance Pretty Value where
128 pretty portable =
154 pretty portable =
129 case portable of
155 case portable of
@@ -132,6 +158,9 @@ instance Pretty Value where
132 ADT name ctors ->
158 ADT name ctors ->
133 P.text name <> pretty (ctors { _explicits = map P.text (_explicits ctors) })
159 P.text name <> pretty (ctors { _explicits = map P.text (_explicits ctors) })
134
160
161+
162+-- BINARY SERIALIZATION
163+
135instance Binary Canonical where
164instance Binary Canonical where
136 put (Canonical home name) =
165 put (Canonical home name) =
137 case home of
166 case home of
@@ -146,6 +175,7 @@ instance Binary Canonical where
146 2 -> Canonical Local <$> get
175 2 -> Canonical Local <$> get
147 _ -> error "Unexpected tag when deserializing canonical variable"
176 _ -> error "Unexpected tag when deserializing canonical variable"
148
177
178+
149instance Binary Value where
179instance Binary Value where
150 put portable =
180 put portable =
151 case portable of
181 case portable of
@@ -160,6 +190,7 @@ instance Binary Value where
160 2 -> ADT <$> get <*> get
190 2 -> ADT <$> get <*> get
161 _ -> error "Error reading valid import/export information from serialized string"
191 _ -> error "Error reading valid import/export information from serialized string"
162
192
193+
163instance (Binary a) => Binary (Listing a) where
194instance (Binary a) => Binary (Listing a) where
164 put (Listing explicits open) =
195 put (Listing explicits open) =
165 put explicits >> put open
196 put explicits >> put open