Simplify prettyprinting. #71

src/Language/Common.hs

@@ -65,9 +65,6 @@ fromListAccum ((k,v):kvs) = Map.insert k op (fromListAccum kvs)
     op = maybe (Set.singleton v) (Set.insert v) (Map.lookup k r)
     r  = fromListAccum kvs
 
-showCtx :: (Show a1, Show a2) => Map a1 a2 -> String
-showCtx m = unwords $ Prelude.map (\(k,v) -> show k ++ " : " ++ show v) $ Map.toList m
-
 fromList'' :: (Show k, Ord k) => [k] -> Err (Set k)
 fromList'' [] = return Set.empty
 fromList'' (k:l) = do
@@ -85,9 +82,6 @@ toMapSafely ((k,v):l) = do
   then Left $ "Duplicate binding: " ++ show k
   else pure $ Map.insert k v l'
 
-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 = fromMaybe (error $ "Can't find " ++ show v ++ " in " ++ show m) $ Map.lookup m v
 
@@ -110,12 +104,11 @@ data Kind = CONSTRAINTS | TYPESIDE | SCHEMA | INSTANCE | MAPPING | TRANSFORM | Q
 
 type ID = Integer
 
-
-showCtx' :: (Show a1, Show a2) => Map a1 a2 -> String
-showCtx' m = intercalate "\n\t" $ (\(k,v) -> show k ++ " : " ++ show v) <$> Map.toList m
+sepTup :: (Show a1, Show a2) => String -> (a1, a2) -> String
+sepTup sep (k,v) = show k ++ sep ++ show v
 
 section :: String -> String -> String
-section heading body =  heading ++ "\n" ++ indentLines body
+section heading body = heading ++ "\n" ++ indentLines body
 
 indentLines :: String -> String
 indentLines = foldMap (\l -> tab <> l <> "\n"). lines

src/Language/Instance.hs

@@ -49,7 +49,7 @@ import           Data.Set              (Set)
 import qualified Data.Set              as Set
 import           Data.Typeable         hiding (typeOf)
 import           Data.Void
-import           Language.Common
+import           Language.Common       (elem', intercalate, fromListAccum, mapl, section, sepTup, toMapSafely, Deps(..), Err, Kind(INSTANCE), MultiTyMap, TyMap, type (+))
 import           Language.Mapping      as Mapping
 import           Language.Options
 import           Language.Prover
@@ -800,32 +800,31 @@ instance (TyMap Show '[var, ty, sym, en, fk, att, gen, sk, x, y], Eq en, Eq fk,
   => Show (Instance var ty sym en fk att gen sk x y) where
   show (Instance _ p _ alg) =
     section "instance" $ unlines
-      [ section "presentation" (show p)
-      , section "algebra" (show alg)
+      [ section "presentation" $ show p
+      , 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" $ showCtx' ens'
+      [ 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') =
-    "entities" ++ "\n" ++
-    (indentLines $ intercalate "\n" prettyEntities) ++ "\n" ++
-    "type-algebra" ++ "\n" ++
-    indentLines prettyTypeEqns ++ "\n" ++
-    "nulls" ++ "\n" ++
-    indentLines w
+    unlines $
+      [ section "entities"     $ unlines prettyEntities
+      , section "type-algebra" $ intercalate "\n" prettyTypeEqns
+      , section "nulls"        $ intercalate "\n" w
+      ]
     where
-      w = intercalate "\n" . mapl w2 . Typeside.tys . Schema.typeside $ sch
+      w = mapl w2 . Typeside.tys . Schema.typeside $ sch
       w2 ty'' = show ty'' ++ " (" ++ (show . Set.size $ ty' ty'') ++ ") = " ++ show (Foldable.toList $ ty' ty'') ++ " "
       prettyEntities = prettyEntityTable alg `mapl` Schema.ens sch
-      prettyTypeEqns = intercalate "\n" (Set.map show teqs')
+      prettyTypeEqns = Set.map show teqs'
 
 prettyEntity
   :: (TyMap Show '[ty, sym, en, fk, att, x, y], Eq en)

src/Language/Program.hs

@@ -40,7 +40,7 @@ module Language.Program where
 
 import           Control.DeepSeq
 import           Data.Map.Strict    as Map
-import           Language.Common    (section, showCtx'', TyMap, Kind(..))
+import           Language.Common    (section, TyMap, Kind(..))
 import           Language.Instance  as I
 import           Language.Mapping   as M
 import           Language.Query     as Q
@@ -108,13 +108,18 @@ newEnv = KindCtx m m m m m m
 
 instance TyMap Show '[ts, s, i, m, q, t, o] => Show (KindCtx ts s i m q t o) where
   show (KindCtx ts s i m q t o) =
-    section "typesides"  (showCtx'' ts) ++
-    section "schemas"    (showCtx'' s)  ++
-    section "instances"  (showCtx'' i)  ++
-    section "mappings"   (showCtx'' m)  ++
-    section "queries"    (showCtx'' q)  ++
-    section "transforms" (showCtx'' t)  ++
-    section "other"      (show o)
+    section "program" $ unlines
+      [ section "typesides"  $ showCtx ts
+      , section "schemas"    $ showCtx s
+      , section "instances"  $ showCtx i
+      , section "mappings"   $ showCtx m
+      , section "queries"    $ showCtx q
+      , section "transforms" $ showCtx t
+      , section "other"      $ show o
+      ]
+    where
+      showCtx :: (Show a1, Show a2) => Map a1 a2 -> String
+      showCtx m = unlines $ (\(k,v) -> show k ++ " = " ++ show v ++ "\n") <$> Map.toList m
 
 allVars :: KindCtx ts s i m q t o -> [(String, Kind)]
 allVars x =

src/Language/Typeside.hs

@@ -74,8 +74,11 @@ instance (Show var, Show ty, Show sym) => Show (Typeside var ty sym) where
       , section "equations" $ unlines eqs''
       ]
    where
-    syms'' = (\(k,(s,t)) -> show k ++ " : " ++ show s ++ " -> " ++ show t) <$> Map.toList syms'
-    eqs''  = (\(k,s)     -> "forall " ++ showCtx k ++ " . " ++ show s)     <$> Set.toList eqs'
+    syms''  = (\(k,(s,t)) -> show k ++ " : " ++ show s ++ " -> " ++ show t) <$> Map.toList syms'
+    eqs''   = (\(k,s)     -> "forall " ++ showCtx k ++ " . " ++ show s)     <$> Set.toList eqs'
+
+    showCtx :: (Show a1, Show a2) => Map a1 a2 -> String
+    showCtx m = unwords $ fmap (sepTup " : ") $ Map.toList m
 
 instance (NFData var, NFData ty, NFData sym) => NFData (Typeside var ty sym) where
   rnf (Typeside tys0 syms0 eqs0 eq0) = deepseq tys0 $ deepseq syms0 $ deepseq eqs0 $ deepseq eq0 ()