Fifth wee batch of refactorings. #82

statebox · Oct 20, 2018 · 27a833b · 27a833b
1 parent 3953fd5
commit 27a833b
Show file tree

Hide file tree

Showing 2 changed files with 20 additions and 18 deletions.
diff --git a/src/Language/Instance.hs b/src/Language/Instance.hs
@@ -317,7 +317,8 @@ up15 = up
 
 initialAlgebra :: (Ord var, Ord ty, Ord sym, Show var, Show ty, Show sym, Ord en,
   Show en, Ord fk, Show fk, Ord att, Show att, Ord gen, Show gen, Ord sk, Show sk)
- => Presentation var ty sym en fk att gen sk -> (EQ (()+var) ty sym en fk att gen sk -> Bool)
+ => Presentation var ty sym en fk att gen sk
+ -> (EQ (()+var) ty sym en fk att gen sk -> Bool)
  -> Schema var ty sym en fk att ->
  Algebra var ty sym en fk att gen sk (GTerm en fk gen) (TTerm en fk att gen sk)
 initialAlgebra p dp' sch = simplifyA this
@@ -417,8 +418,8 @@ assembleGens col (e:tl) = Map.insert t (Set.insert e s) m
 close
   :: (Ord var, Show var, Ord gen, Show gen, Ord sk, Show sk, Ord fk, Show fk, Ord en, Show en, Show ty, Ord ty, Show att, Ord att, Show sym, Ord sym, Eq en)
   => Collage var  ty   sym  en fk att  gen sk
-  -> (EQ     var  ty   sym  en fk att  gen sk   -> Bool)
-  -> [ (Term Void Void Void en fk Void gen Void) ]
+  -> (EQ     var  ty   sym  en fk att  gen sk    -> Bool)
+  -> [Term   Void Void Void en fk Void gen Void]
 close col dp' =
   y (close1m dp' col) $ fmap Gen $ Map.keys $ cgens col
   where

diff --git a/src/Language/Mapping.hs b/src/Language/Mapping.hs
@@ -3,17 +3,17 @@
 
 module Language.Mapping where
 import Prelude hiding (EQ)
-import Data.Map.Strict as Map
+import qualified Data.Map.Strict as Map
+import Data.Map.Strict (Map)
 import Language.Term
 import Language.Schema as X
 import Data.Void
 import Language.Common
 import Data.Typeable
-import Data.Set as Set
+import qualified Data.Set as Set
 import Data.Maybe
 
 
-
 data Mapping var ty sym en fk att en' fk' att'
   = Mapping
   { src  :: Schema var ty sym en  fk  att
@@ -46,14 +46,18 @@ deriving instance Show MappingEx
 
 instance (Show var, Show ty, Show sym, Show en, Show fk, Show att, Show en', Show fk', Show att')
   => Show (Mapping var ty sym en fk att en' fk' att') where
-  show (Mapping _ _ ens' fks' atts') = "mapping {\n" ++
-    "entities\n\t"  ++ intercalate "\n\t" ens'' ++
-    "\nforeign_keys\n\t" ++ intercalate "\n\t" fks'' ++
-    "\nattributes\n\t" ++ intercalate "\n\t" atts'' ++ " }\n"
-   where ens'' = Prelude.map (\(s,t) -> show s ++ " -> " ++ show t) $ Map.toList ens'
-         fks'' = Prelude.map (\(k,s) -> show k ++ " -> " ++ show s) $ Map.toList fks'
-         atts'' = Prelude.map (\(k,s)-> show k ++ " -> " ++ show s) $ Map.toList atts'
-
+  show (Mapping _ _ ens' fks' atts') =
+    "mapping {" ++ "\n" ++
+    "entities" ++ "\n" ++
+    "\t" ++ intercalate "\n\t" ens'' ++ "\n" ++
+    "foreign_keys\n" ++
+    "\t" ++ intercalate "\n\t" fks'' ++ "\n" ++
+    "attributes\n" ++
+    "\t" ++ intercalate "\n\t" atts'' ++ "\n" ++
+    "}\n"
+    where ens''  = (\(s,t) -> show s ++ " -> " ++ show t) <$> Map.toList ens'
+          fks''  = (\(k,s) -> show k ++ " -> " ++ show s) <$> Map.toList fks'
+          atts'' = (\(k,s) -> show k ++ " -> " ++ show s) <$> Map.toList atts'
 
 instance (Eq var, Eq ty, Eq sym, Eq en, Eq fk, Eq att, Eq en', Eq fk', Eq att')
   => Eq (Mapping var ty sym en fk att en' fk' att') where
@@ -147,10 +151,7 @@ conv'' ((ty2,ty):tl) = case cast ty :: Maybe ty of
    Nothing -> Left $ "Not in target schema/typeside: " ++ show ty
 
 elem' :: (Typeable t, Typeable a, Eq a) => t -> [a] -> Bool
-elem' _ [] = False
-elem' x (y:ys) = case cast x of
-  Nothing -> elem' x ys
-  Just x' -> x' == y || elem' x ys
+elem' x ys = maybe False (\x' -> foldl (\acc y -> acc || y == x') False ys) (cast x)
 
 member' :: (Typeable t, Typeable a, Eq a) => t -> Map a v -> Bool
 member' k m = elem' k (Map.keys m)