Merge pull request #97 from statebox/83/refactor-3

Clean up Program.hs. #82

Author: wisnesky

src/Language/Program.hs

@@ -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)])
@@ -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