git.iko.soy/elk
on 22bb2ee help sign in
elk/src/Elm/Interface.hs
89 lines 1.6 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Elm.Interface
3 ( Interfaces
4 , Interface(..)
5 , Binop(..)
6 , fromModule
7 )
8 where
11import Control.Monad (liftM4)
12import Data.Binary
13import Data.Map ((!))
14import qualified Data.Map as Map
16import qualified AST.Canonical as Can
17import qualified AST.Module.Name as ModuleName
18import qualified AST.Utils.Binop as Binop
19import qualified Elm.Name as N
23-- INTERFACES
26type Interfaces =
27 Map.Map ModuleName.Canonical Interface
31-- INTERFACE
34data Interface =
35 Interface
36 { _types :: Map.Map N.Name Can.Annotation
37 , _unions :: Map.Map N.Name Can.Union
38 , _aliases :: Map.Map N.Name Can.Alias
39 , _binops :: Map.Map N.Name Binop
40 }
43data Binop =
44 Binop
45 { _op_name :: N.Name
46 , _op_annotation :: Can.Annotation
47 , _op_associativity :: Binop.Associativity
48 , _op_precedence :: Binop.Precedence
49 }
53-- FROM MODULE
56fromModule :: Map.Map N.Name Can.Annotation -> Can.Module -> Interface
57fromModule types (Can.Module _ _ _ _ unions aliases binops _) =
58 Interface
59 { _types = types
60 , _unions = unions
61 , _aliases = aliases
62 , _binops = Map.map (toOp types) binops
63 }
66toOp :: Map.Map N.Name Can.Annotation -> Can.Binop -> Binop
67toOp types (Can.Binop_ associativity precedence name) =
68 Binop name (types ! name) associativity precedence
72-- BINARY
75instance Binary Interface where
76 get =
77 liftM4 Interface get get get get
79 put (Interface a b c d) =
80 put a >> put b >> put c >> put d
83instance Binary Binop where
84 get =
85 liftM4 Binop get get get get
87 put (Binop a b c d) =
88 put a >> put b >> put c >> put d