From 981b555dcfdedb9a7a62ce47cb656e8e37f6a8b7 Mon Sep 17 00:00:00 2001 From: Erik Post Date: Fri, 9 Aug 2019 18:34:47 +0200 Subject: [PATCH] More output structure indentation. #71 --- src/Language/Common.hs | 2 +- src/Language/Instance.hs | 24 +++++++++++++----------- src/Language/Schema.hs | 20 +++++++++++--------- src/Language/Typeside.hs | 15 +++++++++------ 4 files changed, 34 insertions(+), 27 deletions(-) diff --git a/src/Language/Common.hs b/src/Language/Common.hs index 0616c57..6a07a05 100644 --- a/src/Language/Common.hs +++ b/src/Language/Common.hs @@ -115,7 +115,7 @@ showCtx' :: (Show a1, Show a2) => Map a1 a2 -> String showCtx' m = intercalate "\n\t" $ (\(k,v) -> show k ++ " : " ++ show v) <$> Map.toList m section :: String -> String -> String -section heading body = heading ++ "\n" ++ indentLines body ++ "\n" +section heading body = heading ++ "\n" ++ indentLines body indentLines :: String -> String indentLines = foldMap (\l -> "\t" <> l <> "\n"). lines diff --git a/src/Language/Instance.hs b/src/Language/Instance.hs index 11f4559..0280b9c 100644 --- a/src/Language/Instance.hs +++ b/src/Language/Instance.hs @@ -799,9 +799,18 @@ instance (Show InstanceEx) where instance (TyMap Show '[var, ty, sym, en, fk, att, gen, sk, x, y], Eq en, Eq fk, Eq att) => Show (Instance var ty sym en fk att gen sk x y) where show (Instance _ p _ alg) = - "instance\n" ++ - (indentLines $ "presentation" ++ "\n" ++ show p) ++ "\n" ++ - (indentLines $ "algebra" ++ "\n" ++ show alg) ++ "\n" + section "instance" $ unlines + [ 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 "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 @@ -870,11 +879,4 @@ prettyEntityTable alg@(Algebra sch en' _ _ _ _ _ _ _) es = -- prettyAtt :: x -> (att, w) -> String prettyAtt x (att,_) = prettyTerm $ aAtt alg att x - prettyTerm = show - -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') = - indentLines $ - "generators\n\t" ++ showCtx' ens' ++ "\n" ++ - "equations\n\t" ++ intercalate "\n\t" (Set.map show eqs') ++ "\n" + prettyTerm = show \ No newline at end of file diff --git a/src/Language/Schema.hs b/src/Language/Schema.hs index b30dde7..096160d 100644 --- a/src/Language/Schema.hs +++ b/src/Language/Schema.hs @@ -78,16 +78,18 @@ instance TyMap Eq '[var, ty, sym, en, fk, att] instance TyMap Show '[var, ty, sym, en, fk, att] => Show (Schema var ty sym en fk att) where - show (Schema _ ens' fks' atts' path_eqs' obs_eqs' _) = "schema {\n" ++ - "entities\n\t" ++ intercalate "\n\t" (Prelude.map show $ Set.toList ens') ++ - "\nforeign_keys\n\t" ++ intercalate "\n\t" fks'' ++ - "\natts\n\t" ++ intercalate "\n\t" atts'' ++ - "\npath_equations\n\t" ++ intercalate "\n\t" (eqs'' path_eqs') ++ - "\nobservation_equations\n\t " ++ intercalate "\n\t" (eqs'' obs_eqs') ++ " }" + show (Schema _ ens' fks' atts' path_eqs' obs_eqs' _) = + section "schema" $ unlines + [ section "entities" $ unlines $ show <$> Set.toList ens' + , section "foreign_keys" $ unlines $ fks'' + , section "atts" $ unlines $ atts'' + , section "path_equations" $ unlines $ eqs'' path_eqs' + , section "observation_equations " $ unlines $ eqs'' obs_eqs' + ] where - fks'' = Prelude.map (\(k,(s,t)) -> show k ++ " : " ++ show s ++ " -> " ++ show t) $ Map.toList fks' - atts'' = Prelude.map (\(k,(s,t)) -> show k ++ " : " ++ show s ++ " -> " ++ show t) $ Map.toList atts' - eqs'' x = Prelude.map (\(en,EQ (l,r)) -> "forall x : " ++ show en ++ " . " ++ show (mapVar "x" l) ++ " = " ++ show (mapVar "x" r)) $ Set.toList x + fks'' = (\(k,(s,t)) -> show k ++ " : " ++ show s ++ " -> " ++ show t) <$> Map.toList fks' + atts'' = (\(k,(s,t)) -> show k ++ " : " ++ show s ++ " -> " ++ show t) <$> Map.toList atts' + eqs'' x = (\(en,EQ (l,r)) -> "forall x : " ++ show en ++ " . " ++ show (mapVar "x" l) ++ " = " ++ show (mapVar "x" r)) <$> Set.toList x -- | Checks that the underlying theory is well-sorted. -- I.e. rule out "1" = one kind of errors. diff --git a/src/Language/Typeside.hs b/src/Language/Typeside.hs index d965c14..533148c 100644 --- a/src/Language/Typeside.hs +++ b/src/Language/Typeside.hs @@ -67,12 +67,15 @@ instance (Eq var, Eq ty, Eq sym) => Eq (Typeside var ty sym) where = (tys' == tys'') && (syms' == syms'') && (eqs' == eqs'') instance (Show var, Show ty, Show sym) => Show (Typeside var ty sym) where - show (Typeside tys' syms' eqs' _) = "typeside {\n" ++ - "types\n\t" ++ intercalate "\n\t" (Prelude.map show $ Set.toList tys') ++ - "\nfunctions\n\t" ++ intercalate "\n\t" syms'' ++ - "\nequations\n\t" ++ intercalate "\n\t" eqs'' ++ " }" - where syms'' = Prelude.map (\(k,(s,t)) -> show k ++ " : " ++ show s ++ " -> " ++ show t) $ Map.toList syms' - eqs'' = Prelude.map (\(k,s) -> "forall " ++ showCtx k ++ " . " ++ show s) $ Set.toList eqs' + show (Typeside tys' syms' eqs' _) = + section "typeside" $ unlines + [ section "types" $ unlines . fmap show $ Set.toList tys' + , section "functions" $ unlines syms'' + , 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' 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 ()