@@ -6,13 +6,14 @@ module Elm.Compiler.Type
66
77import Control.Applicative ((<$>), (<*>))
88import Control.Arrow (second)
9−import Data.Aeson ((.:), (.:?), (.=))
9+import Data.Aeson ((.:), (.=))
1010import qualified Data.Aeson as Json
1111import qualified Data.ByteString.Lazy.Char8 as BS
12+import qualified Data.List as List
1213import qualified Data.Text as Text
1314
14−import qualified AST.Type as Type
15−import qualified AST.Variable as Var
15+import qualified AST.Helpers as Help
16+import Elm.Utils ((|>))
1617
1718
1819data Type
@@ -25,14 +26,74 @@ data Type
2526
2627-- TO STRING
2728
29+data Context = None | ADT | Function
30+
31+
2832toString :: Type -> String
2933toString tipe =
30− case tipe of
31− Lambda t t' -> undefined
32− Var x -> undefined
33− Type name -> undefined
34− App t ts -> undefined
35− Record fields maybeExtension -> undefined
34+ toStringHelp None tipe
35+
36+
37+toStringHelp :: Context -> Type -> String
38+toStringHelp context tipe =
39+ case tipe of
40+ Lambda t1 t2 ->
41+ let string = toStringHelp Function t1 ++ " -> " ++ toString t2
42+ in
43+ case context of
44+ None -> string
45+ _ -> parens string
46+
47+ Var name -> name
48+
49+ Type name -> name
50+
51+ App (Type "List") [t] ->
52+ sandwich "[" "]" (toString t)
53+
54+ App (Type name) args
55+ | Help.isTuple name ->
56+ map toString args
57+ |> List.intercalate ", "
58+ |> parens
59+
60+ | otherwise ->
61+ let string = name ++ spacePrefix (map (toStringHelp ADT) args)
62+ in
63+ case (context, args) of
64+ (ADT, _ : _) -> parens string
65+ _ -> string
66+
67+ Record fields maybeExtension ->
68+ let viewField (key, value) =
69+ key ++ " : " ++ toString value
70+
71+ viewExtension maybeType =
72+ case maybeType of
73+ Nothing -> ""
74+ Just t -> toString t ++ " | "
75+ in
76+ sandwich "{ " " }" $
77+ concat
78+ [ viewExtension maybeExtension
79+ , map viewField fields
80+ |> List.intercalate ", "
81+ ]
82+
83+
84+parens :: String -> String
85+parens string =
86+ sandwich "(" ")" string
87+
88+
89+spacePrefix :: [String] -> String
90+spacePrefix strings =
91+ concatMap (" " ++) strings
92+
93+
94+sandwich :: String -> String -> String -> String
95+sandwich start stop string =
96+ start ++ string ++ stop
3697
3798
3899-- JSON for TYPE