Skip to content

Commit

Permalink
Clean up Program.hs. #82
Browse files Browse the repository at this point in the history
  • Loading branch information
epost committed Oct 21, 2018
1 parent 3d70d13 commit ed8f802
Showing 1 changed file with 41 additions and 43 deletions.
84 changes: 41 additions & 43 deletions src/Language/Program.hs
Original file line number Diff line number Diff line change
Expand Up @@ -4,54 +4,52 @@

module Language.Program where

import Prelude hiding (EQ)
import Data.Map.Strict as Map
import Language.Common as C
import Language.Term as Term
import Language.Schema as S
import Language.Instance as I
import Language.Mapping as M
import Language.Typeside as T
import Language.Transform as Tr
import Language.Query as Q
import Prelude hiding (EQ)
import Data.Maybe (fromMaybe)
import Data.Map.Strict as Map
import Language.Common as C
import Language.Instance as I
import Language.Mapping as M
import Language.Schema as S
import Language.Term as Term
import Language.Query as Q
import Language.Transform as Tr
import Language.Typeside as T

data Exp
= ExpTy TypesideExp
| ExpS SchemaExp
| ExpI InstanceExp
| ExpM MappingExp
| ExpT TransformExp
| ExpQ QueryExp

data Exp =
ExpTy (TypesideExp)
| ExpS (SchemaExp)
| ExpI (InstanceExp)
| ExpM (MappingExp)
| ExpT (TransformExp)
| ExpQ (QueryExp)

data KindCtx ts s i m q t o = KindCtx {
typesides :: Ctx String ts
, schemas :: Ctx String s
, instances :: Ctx String i
, mappings :: Ctx String m
, queries :: Ctx String q
data KindCtx ts s i m q t o
= KindCtx
{ typesides :: Ctx String ts
, schemas :: Ctx String s
, instances :: Ctx String i
, mappings :: Ctx String m
, queries :: Ctx String q
, transforms :: Ctx String t
, other :: o
}
, other :: o
}

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
show (KindCtx ts s i m q t o) =
"typesides\n" ++ showCtx'' ts ++
"\nschemas\n" ++ showCtx'' s ++
"\ninstances\n" ++ showCtx'' i ++
"\nmappings\n" ++ showCtx'' m ++
"\nqueries\n" ++ showCtx'' q ++
"\ntransforms\n" ++ showCtx'' t ++
"\nother\n" ++ show o ++ "\n"
show (KindCtx ts s i m q t o) =
"typesides\n" ++ showCtx'' ts ++ "\n"
"schemas\n" ++ showCtx'' s ++ "\n"
"instances\n" ++ showCtx'' i ++ "\n"
"mappings\n" ++ showCtx'' m ++ "\n"
"queries\n" ++ showCtx'' q ++ "\n"
"transforms\n" ++ showCtx'' t ++ "\n"
"other\n" ++ show o ++ "\n"

showCtx'' :: (Show a1, Show a2) => Map a1 a2 -> [Char]
showCtx'' m = intercalate "\n" $ Prelude.map (\(k,v) -> show k ++ " = " ++ show v ++ "\n") $ Map.toList m
showCtx'' :: (Show a1, Show a2) => Map a1 a2 -> String
showCtx'' m = intercalate "\n" $ (\(k,v) -> show k ++ " = " ++ show v ++ "\n") <$> Map.toList m

lookup' :: (Show k, Show a, Ord k) => k -> Map k a -> a
lookup' m v = f $ Map.lookup m v
where
f (Just x) = x
f Nothing = error $ "Can't find " ++ show v ++ " in " ++ show m
lookup' m v = fromMaybe (error $ "Can't find " ++ show v ++ " in " ++ show m) $ Map.lookup m v

--todo: store line numbers in other field
type Prog = KindCtx TypesideExp SchemaExp InstanceExp MappingExp QueryExp TransformExp ([(String,Kind)])
Expand All @@ -60,13 +58,13 @@ type Types = KindCtx TypesideExp TypesideExp SchemaExp (SchemaExp,SchemaExp) (Sc

newProg :: KindCtx ts s i m q t [a]
newProg = KindCtx m m m m m m []
where m = Map.empty
where m = Map.empty

newTypes :: KindCtx ts s i m q t ()
newTypes = KindCtx m m m m m m ()
where m = Map.empty
where m = Map.empty


newEnv :: KindCtx ts s i m q t ()
newEnv = KindCtx m m m m m m ()
where m = Map.empty
where m = Map.empty

0 comments on commit ed8f802

Please sign in to comment.