Replace uppEQ by (fmap upp). #148

statebox · Jan 21, 2020 · fc49f42 · fc49f42
1 parent f5b8472
commit fc49f42
Show file tree

Hide file tree

Showing 2 changed files with 6 additions and 10 deletions.
diff --git a/src/Language/CQL/Schema.hs b/src/Language/CQL/Schema.hs
@@ -112,9 +112,9 @@ toCollage (Schema ts ens' fks' atts' path_eqs' obs_eqs' _) =
   where
     tscol = tsToCol ts
 
-    eqs1 = Set.map (unitCtx *** uppEQ) path_eqs'
-    eqs2 = Set.map (unitCtx *** uppEQ) obs_eqs'
-    eqs3 = Set.map (up1Ctx  *** uppEQ) (ceqs tscol)
+    eqs1 = Set.map (unitCtx *** fmap upp) path_eqs'
+    eqs2 = Set.map (unitCtx *** fmap upp) obs_eqs'
+    eqs3 = Set.map (up1Ctx  *** fmap upp) (ceqs tscol)
 
     unitCtx en = Map.singleton (Left ()) (Right en)
 

diff --git a/src/Language/CQL/Term.hs b/src/Language/CQL/Term.hs
@@ -367,13 +367,6 @@ instance Up x (x + y) where
 instance Up y (x + y) where
   upgr = Right
 
-uppEQ
-  :: ( Up var var', Up ty  ty' , Up sym sym', Up en en'
-     , Up fk  fk' , Up att att', Up gen gen', Up sk sk' )
-  => EQ var  ty  sym  en  fk  att  gen  sk
-  -> EQ var' ty' sym' en' fk' att' gen' sk'
-uppEQ (EQ (l,r)) = EQ (upp l, upp r)
-
 --------------------------------------------------------------------------------------------------------------------
 -- Theories
 
@@ -388,6 +381,9 @@ type EQ var ty sym en fk att gen sk = EQF (Term var ty sym en fk att gen sk)
 
 newtype EQF a = EQ (a, a)
 
+instance Functor EQF where
+  fmap f (EQ (l, r)) = EQ (f l, f r)
+
 instance (Show a) => Show (EQF a) where
   show (EQ (lhs, rhs)) = show lhs ++ " = " ++ show rhs