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 e46543b
Showing 1 changed file with 46 additions and 46 deletions.
92 changes: 46 additions & 46 deletions src/Language/Program.hs
Original file line number Diff line number Diff line change
@@ -1,57 +1,57 @@

{-# LANGUAGE ExplicitForAll, StandaloneDeriving, DuplicateRecordFields, ScopedTypeVariables, InstanceSigs, KindSignatures, GADTs, FlexibleContexts, RankNTypes, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, AllowAmbiguousTypes, TypeOperators
,LiberalTypeSynonyms, ImpredicativeTypes, UndecidableInstances, FunctionalDependencies #-}
{-# LANGUAGE ExplicitForAll, StandaloneDeriving, DuplicateRecordFields, ScopedTypeVariables, InstanceSigs
, KindSignatures, GADTs, FlexibleContexts, RankNTypes, TypeSynonymInstances, FlexibleInstances
, MultiParamTypeClasses, AllowAmbiguousTypes, TypeOperators, LiberalTypeSynonyms, ImpredicativeTypes
, UndecidableInstances, FunctionalDependencies
#-}

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 +60,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 e46543b

Please sign in to comment.