Clean up code in and around Instance.Presentation. #148

statebox · Aug 21, 2019 · ee41cb2 · ee41cb2
1 parent 5b02e16
commit ee41cb2
Show file tree

Hide file tree

Showing 3 changed files with 37 additions and 43 deletions.
diff --git a/src/Language/CQL.hs b/src/Language/CQL.hs
@@ -42,23 +42,24 @@ module Language.CQL where
 import Control.Concurrent
 import Control.DeepSeq
 import Control.Exception
-import Data.List (nub)
-import qualified Data.Map.Strict as Map
+import Data.List  (nub)
+import qualified Data.Map.Strict  as Map
 import Data.Maybe
 import Data.Typeable
-import Language.CQL.Common as C
+import Language.CQL.Common  as C
 import Language.CQL.Graph
-import Language.CQL.Instance as I
-import Language.CQL.Mapping as M
+import Language.CQL.Instance as I
+import Language.CQL.Instance.Presentation as IP
+import Language.CQL.Mapping as M
 import Language.CQL.Options
-import Language.CQL.Parser.Program (parseProgram)
-import Language.CQL.Program as P
-import Language.CQL.Query as Q
-import Language.CQL.Schema as S
-import Language.CQL.Term as Term
-import Language.CQL.Transform as Tr
-import Language.CQL.Typeside as T
-import Prelude hiding (EQ, exp)
+import Language.CQL.Parser.Program  (parseProgram)
+import Language.CQL.Program  as P
+import Language.CQL.Query  as Q
+import Language.CQL.Schema  as S
+import Language.CQL.Term  as Term
+import Language.CQL.Transform  as Tr
+import Language.CQL.Typeside  as T
+import Prelude  hiding (EQ, exp)
 import System.IO.Unsafe
 
 -- | Times out a computation after @i@ microseconds.
@@ -382,8 +383,8 @@ evalTransform p env (TransformId s) = do
  (InstanceEx i) <- evalInstance p env s
  pure $ TransformEx $ Transform i i (h i) (g i)
  where
- h i = foldr (\(gen,_) m -> Map.insert gen (Gen gen) m) Map.empty $ Map.toList $ I.gens $ pres i
- g i = foldr (\(sk ,_) m -> Map.insert sk (Sk sk) m) Map.empty $ Map.toList $ I.sks $ pres i
+ h i = foldr (\(gen,_) m -> Map.insert gen (Gen gen) m) Map.empty $ Map.toList $ IP.gens $ pres i
+ g i = foldr (\(sk ,_) m -> Map.insert sk (Sk sk) m) Map.empty $ Map.toList $ IP.sks $ pres i
 
 evalTransform p env (TransformComp f g) = do
  (TransformEx (f' :: Transform var ty sym en fk att gen sk x y gen' sk' x' y' )) <- evalTransform p env f

diff --git a/src/Language/CQL/Instance.hs b/src/Language/CQL/Instance.hs
@@ -760,14 +760,6 @@ instance (TyMap Show '[var, ty, sym, en, fk, att, gen, sk, x, y], Eq en, Eq fk,
  , section "algebra" $ show alg
  ]
 
-instance TyMap Show '[var, ty, sym, en, fk, att, gen, sk]
- => Show (Presentation var ty sym en fk att gen sk) where
- show (Presentation ens' _ eqs') =
- unlines
- [ section "generators" $ intercalate "\n" $ sepTup " : " <$> Map.toList ens'
- , section "equations" $ intercalate "\n" $ Set.map show eqs'
- ]
-
 instance (TyMap Show '[var, ty, sym, en, fk, att, gen, sk, x, y], Eq en, Eq fk, Eq att)
  => Show (Algebra var ty sym en fk att gen sk x y) where
  show alg@(Algebra sch _ _ _ _ ty' _ _ teqs') =

diff --git a/src/Language/CQL/Transform.hs b/src/Language/CQL/Transform.hs
@@ -40,22 +40,23 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
 module Language.CQL.Transform where
 
 import Control.DeepSeq
-import Data.Map (Map, mapWithKey)
-import qualified Data.Map.Strict as Map
+import Data.Map  (Map, mapWithKey)
+import qualified Data.Map.Strict  as Map
 import Data.Maybe
-import qualified Data.Set as Set
+import qualified Data.Set  as Set
 import Data.Typeable
 import Data.Void
 import Language.CQL.Common
-import Language.CQL.Instance as I
-import Language.CQL.Mapping as M hiding (toMorphism)
-import Language.CQL.Morphism (Morphism(..), translate, translate')
-import Language.CQL.Morphism as Morphism (typeOf)
+import Language.CQL.Instance as I
+import Language.CQL.Instance.Presentation as IP
+import Language.CQL.Mapping as M hiding (toMorphism)
+import Language.CQL.Morphism (Morphism(..), translate, translate')
+import Language.CQL.Morphism as Morphism (typeOf)
 import Language.CQL.Options
 import Language.CQL.Query
-import Language.CQL.Schema as S
+import Language.CQL.Schema  as S
 import Language.CQL.Term
-import Prelude hiding (EQ)
+import Prelude  hiding (EQ)
 
 
 -- | Map from one 'Instance' to another of the same 'Schema'.
@@ -222,8 +223,8 @@ evalDeltaSigmaUnit
 evalDeltaSigmaUnit m i o = do
  j <- evalSigmaInst m i o
  k <- evalDeltaInst m j o
- pure $ Transform i k (mapWithKey (f j) $ I.gens $ pres i)
- (mapWithKey (g j) $ I.sks $ pres i)
+ pure $ Transform i k (mapWithKey (f j) $ IP.gens $ pres i)
+ (mapWithKey (g j) $ IP.sks $ pres i)
  where
  f j gen en' = Gen (en', nf (algebra j) $ Gen gen)
  g j sk _ = upp $ nf'' (algebra j) $ Sk sk
@@ -237,7 +238,7 @@ evalDeltaSigmaCoUnit
 evalDeltaSigmaCoUnit m i o = do
  j <- evalDeltaInst m i o
  k <- evalSigmaInst m j o
- return $ Transform k i (Map.fromList $ fmap (f j) $ Map.toList $ I.gens $ pres k) $ (Map.fromList $ fmap (g j) $ Map.toList $ I.sks $ pres k)
+ return $ Transform k i (Map.fromList $ fmap (f j) $ Map.toList $ IP.gens $ pres k) $ (Map.fromList $ fmap (g j) $ Map.toList $ IP.sks $ pres k)
  where
  f _ ((en', x), _) = ((en', x), repr (algebra i) x )
  g _ (sk , _) = (sk , repr' (algebra i) sk)
@@ -253,8 +254,8 @@ evalDeltaTrans m h o = do
  j <- evalDeltaInst m (dstT h) o
  pure $ Transform i j (gens' i) (sks' i)
  where
- gens' i = mapWithKey (\(_,x) en' -> Gen (en', nf (algebra $ dstT h) $ translate' (toMorphism h) $ repr (algebra $ srcT h) x)) $ I.gens $ pres i
- sks' i = mapWithKey (\y _ -> upp $ nf'' (algebra $ dstT h) $ translate (toMorphism h) $ repr' (algebra $ srcT h) y) $ I.sks $ pres i
+ gens' i = mapWithKey (\(_,x) en' -> Gen (en', nf (algebra $ dstT h) $ translate' (toMorphism h) $ repr (algebra $ srcT h) x)) $ IP.gens $ pres i
+ sks' i = mapWithKey (\y _ -> upp $ nf'' (algebra $ dstT h) $ translate (toMorphism h) $ repr' (algebra $ srcT h) y) $ IP.sks $ pres i
 
 ---------------------------------------------------------------------------------------------------------
 -- Raw literals
@@ -304,12 +305,12 @@ evalTransformRaw' src' dst' (TransExpRaw' _ _ sec _ _) is = do
  addImportGens x = foldr (Map.union . tGens) x is
  addImportSks y = foldr (Map.union . tSks) y is
 
- gens'' = I.gens $ pres src'
- sks'' = I.sks $ pres src'
- gens' = I.gens $ pres dst'
- sks' = I.sks $ pres dst'
- gens0 =  filter (\(x,_) -> x `member'` gens'') sec
- sks0 =  filter (\(x,_) -> x `member'` sks'' ) sec
+ gens'' = IP.gens $ pres src'
+ sks'' = IP.sks $ pres src'
+ gens' = IP.gens $ pres dst'
+ sks' = IP.sks $ pres dst'
+ gens0 = filter (\(x,_) -> x `member'` gens'') sec
+ sks0 = filter (\(x,_) -> x `member'` sks'' ) sec
 
  evalGens [] = pure Map.empty
  evalGens ((gen, t):ts) = do