git.iko.soy/elk
on 662fd76 help sign in
elk/compiler/SourceSyntax/Declaration.hs
86 lines 2.8 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module SourceSyntax.Declaration where
4import Data.Binary
5import qualified SourceSyntax.Expression as Expr
6import SourceSyntax.Type
7import SourceSyntax.PrettyPrint
8import Text.PrettyPrint as P
10data Declaration tipe var
11 = Definition (Expr.Def tipe var)
12 | Datatype String [String] [(String,[Type])] [Derivation]
13 | TypeAlias String [String] Type [Derivation]
14 | Port String Type (Maybe (Expr.LExpr tipe var))
15 | Fixity Assoc Int String
16 deriving (Eq, Show)
18data Assoc = L | N | R
19 deriving (Eq)
21data Derivation = Json | JS | Binary | New
22 deriving (Eq, Show)
24instance Binary Derivation where
25 get = do n <- getWord8
26 return $ case n of
27 0 -> Json
28 1 -> JS
29 2 -> Binary
30 3 -> New
31 _ -> error "Unable to decode Derivation. You may have corrupted binary files,\n\
32 \so please report an issue at <https://github.com/evancz/Elm/issues>"
34 put derivation =
35 putWord8 $ case derivation of
36 Json -> 0
37 JS -> 1
38 Binary -> 2
39 New -> 3
41instance Show Assoc where
42 show assoc =
43 case assoc of
44 L -> "left"
45 N -> "non"
46 R -> "right"
48instance Pretty (Declaration t v) where
49 pretty decl =
50 case decl of
51 Definition def -> pretty def
53 Datatype tipe tvars ctors deriveables ->
54 P.hang (P.text "data" <+> P.text tipe <+> P.hsep (map P.text tvars)) 4
55 (P.sep $ zipWith join ("=" : repeat "|") ctors) <+> prettyDeriving deriveables
56 where
57 join c ctor = P.text c <+> prettyCtor ctor
58 prettyCtor (name, tipes) =
59 P.hang (P.text name) 2 (P.sep (map prettyParens tipes))
61 TypeAlias name tvars tipe deriveables ->
62 alias <+> prettyDeriving deriveables
63 where
64 name' = P.text name <+> P.hsep (map P.text tvars)
65 alias = P.hang (P.text "type" <+> name' <+> P.equals) 4 (pretty tipe)
67 Port name tipe maybeExpr ->
68 let port = P.text "port" <+> P.text name in
69 P.vcat [ port <+> P.colon <+> pretty tipe
70 , maybe P.empty (\expr -> port <+> P.equals <+> pretty expr) maybeExpr
71 ]
73 Fixity assoc prec op -> P.text "infix" <> assoc' <+> P.int prec <+> P.text op
74 where
75 assoc' = case assoc of
76 L -> P.text "l"
77 N -> P.empty
78 R -> P.text "r"
80prettyDeriving :: [Derivation] -> Doc
81prettyDeriving deriveables =
82 case deriveables of
83 [] -> P.empty
84 [d] -> P.text "deriving" <+> P.text (show d)
85 ds -> P.text "deriving" <+>
86 P.parens (P.hsep $ P.punctuate P.comma $ map (P.text . show) ds)