4
4
5
5
module Language.Program where
6
6
7
- import Prelude hiding (EQ )
8
- import Data.Map.Strict as Map
9
- import Language.Common as C
10
- import Language.Term as Term
11
- import Language.Schema as S
12
- import Language.Instance as I
13
- import Language.Mapping as M
14
- import Language.Typeside as T
15
- import Language.Transform as Tr
16
- import Language.Query as Q
7
+ import Prelude hiding (EQ )
8
+ import Data.Maybe (fromMaybe )
9
+ import Data.Map.Strict as Map
10
+ import Language.Common as C
11
+ import Language.Instance as I
12
+ import Language.Mapping as M
13
+ import Language.Schema as S
14
+ import Language.Term as Term
15
+ import Language.Query as Q
16
+ import Language.Transform as Tr
17
+ import Language.Typeside as T
17
18
19
+ data Exp
20
+ = ExpTy TypesideExp
21
+ | ExpS SchemaExp
22
+ | ExpI InstanceExp
23
+ | ExpM MappingExp
24
+ | ExpT TransformExp
25
+ | ExpQ QueryExp
18
26
19
- data Exp =
20
- ExpTy (TypesideExp )
21
- | ExpS (SchemaExp )
22
- | ExpI (InstanceExp )
23
- | ExpM (MappingExp )
24
- | ExpT (TransformExp )
25
- | ExpQ (QueryExp )
26
-
27
- data KindCtx ts s i m q t o = KindCtx {
28
- typesides :: Ctx String ts
29
- , schemas :: Ctx String s
30
- , instances :: Ctx String i
31
- , mappings :: Ctx String m
32
- , queries :: Ctx String q
27
+ data KindCtx ts s i m q t o
28
+ = KindCtx
29
+ { typesides :: Ctx String ts
30
+ , schemas :: Ctx String s
31
+ , instances :: Ctx String i
32
+ , mappings :: Ctx String m
33
+ , queries :: Ctx String q
33
34
, transforms :: Ctx String t
34
- , other :: o
35
- }
35
+ , other :: o
36
+ }
36
37
37
38
instance (Show ts , Show s , Show i , Show m , Show q , Show t , Show o ) => Show (KindCtx ts s i m q t o ) where
38
- show (KindCtx ts s i m q t o) =
39
- " typesides\n " ++ showCtx'' ts ++
40
- " \n schemas \ n" ++ showCtx'' s ++
41
- " \n instances \ n" ++ showCtx'' i ++
42
- " \n mappings \ n" ++ showCtx'' m ++
43
- " \n queries \ n" ++ showCtx'' q ++
44
- " \n transforms \ n" ++ showCtx'' t ++
45
- " \n other \n " ++ show o ++ " \n "
39
+ show (KindCtx ts s i m q t o) =
40
+ " typesides\n " ++ showCtx'' ts ++ " \n "
41
+ " schemas \ n" ++ showCtx'' s ++ " \n "
42
+ " instances \ n" ++ showCtx'' i ++ " \n "
43
+ " mappings \ n" ++ showCtx'' m ++ " \n "
44
+ " queries \ n" ++ showCtx'' q ++ " \n "
45
+ " transforms \ n" ++ showCtx'' t ++ " \n "
46
+ " other \n " ++ show o ++ " \n "
46
47
47
- showCtx'' :: (Show a1 , Show a2 ) => Map a1 a2 -> [ Char ]
48
- showCtx'' m = intercalate " \n " $ Prelude. map (\ (k,v) -> show k ++ " = " ++ show v ++ " \n " ) $ Map. toList m
48
+ showCtx'' :: (Show a1 , Show a2 ) => Map a1 a2 -> String
49
+ showCtx'' m = intercalate " \n " $ (\ (k,v) -> show k ++ " = " ++ show v ++ " \n " ) <$> Map. toList m
49
50
50
51
lookup' :: (Show k , Show a , Ord k ) => k -> Map k a -> a
51
- lookup' m v = f $ Map. lookup m v
52
- where
53
- f (Just x) = x
54
- f Nothing = error $ " Can't find " ++ show v ++ " in " ++ show m
52
+ lookup' m v = fromMaybe (error $ " Can't find " ++ show v ++ " in " ++ show m) $ Map. lookup m v
55
53
56
54
-- todo: store line numbers in other field
57
55
type Prog = KindCtx TypesideExp SchemaExp InstanceExp MappingExp QueryExp TransformExp ([(String ,Kind )])
@@ -60,13 +58,13 @@ type Types = KindCtx TypesideExp TypesideExp SchemaExp (SchemaExp,SchemaExp) (Sc
60
58
61
59
newProg :: KindCtx ts s i m q t [a ]
62
60
newProg = KindCtx m m m m m m []
63
- where m = Map. empty
61
+ where m = Map. empty
64
62
65
63
newTypes :: KindCtx ts s i m q t ()
66
64
newTypes = KindCtx m m m m m m ()
67
- where m = Map. empty
65
+ where m = Map. empty
68
66
69
67
70
68
newEnv :: KindCtx ts s i m q t ()
71
69
newEnv = KindCtx m m m m m m ()
72
- where m = Map. empty
70
+ where m = Map. empty
0 commit comments