From e6ae75b31411975db6bea677d874e2b8d02d4950 Mon Sep 17 00:00:00 2001 From: Erik Post Date: Fri, 9 Aug 2019 22:21:56 +0200 Subject: [PATCH] Simplify prettyprinting. #71 --- src/Language/Common.hs | 13 +++---------- src/Language/Instance.hs | 23 +++++++++++------------ src/Language/Program.hs | 21 +++++++++++++-------- src/Language/Typeside.hs | 7 +++++-- 4 files changed, 32 insertions(+), 32 deletions(-) diff --git a/src/Language/Common.hs b/src/Language/Common.hs index a7230fa..516468e 100644 --- a/src/Language/Common.hs +++ b/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 diff --git a/src/Language/Instance.hs b/src/Language/Instance.hs index 0280b9c..6bd8903 100644 --- a/src/Language/Instance.hs +++ b/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) diff --git a/src/Language/Program.hs b/src/Language/Program.hs index 6dd09c8..e58a59e 100644 --- a/src/Language/Program.hs +++ b/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 = diff --git a/src/Language/Typeside.hs b/src/Language/Typeside.hs index 533148c..4d1054f 100644 --- a/src/Language/Typeside.hs +++ b/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 ()