git.iko.soy/project-m36
on master help sign in
fix display of nested constructed atoms with parentheses
commit8c3934a6ff26fbc4a001775df474850ff7bbbc6f authorAgentM <agentm@themactionfaction.com> dateSun 20 Mar 2016, 20:45 (11 years ago) parent287f51b
2 files changed+16−8
compare with master
unifiedsplit
ProjectM36/Base.hs+4−2 ProjectM36/Relation/Show/Term.hs+12−6
ProjectM36/Base.hs+4−2
@@ -70,8 +70,10 @@ instance Eq Atom where
7070 _ == _ = False
7171
7272instance Show Atom where
73− show (Atom atom) = "Atom " ++ show atom
74− show (ConstructedAtom dConsName _ atomList) = unpack dConsName ++ " " ++ L.concat (L.intersperse " " (map show atomList))
73+ showsPrec _ (Atom atom) = showString "Atom " . shows atom
74+ showsPrec v (ConstructedAtom dConsName _ atomList) = showParen (v >= 4) showIt
75+ where showIt = showString (unpack dConsName) . showString " " . compose (map (showsPrec 4) atomList)
76+ compose = foldr (.) id
7577
7678instance Binary Atom where
7779 put atom@(Atom val) = put (atomTypeForAtom atom) >> put val
ProjectM36/Relation/Show/Term.hs+12−6
@@ -104,14 +104,20 @@ relationAsTable rel@(Relation _ tupleSet) = (header, body)
104104 body = L.foldl' tupleFolder [] (asList tupleSet)
105105 tupleFolder acc tuple = acc ++ [map (\attrName -> case atomForAttributeName attrName tuple of
106106 Left _ -> "?"
107− Right atom -> showAtom atom
107+ Right atom -> showAtom 0 atom
108108 ) oAttrNames]
109109
110−showAtom :: Atom -> StringType
111−showAtom (Atom atom) = case cast atom of
112− Just rel -> renderTable $ relationAsTable rel
113− Nothing -> toText atom
114−showAtom (ConstructedAtom dConsName _ atoms) = dConsName `T.append` " " `T.append` T.concat (L.intersperse " " (map showAtom atoms))
110+showParens :: Bool -> StringType -> StringType
111+showParens predicate f = if predicate then
112+ "(" `T.append` f `T.append` ")"
113+ else
114+ f
115+
116+showAtom :: Int -> Atom -> StringType
117+showAtom _ (Atom atom) = case cast atom of
118+ Just rel -> renderTable $ relationAsTable rel
119+ Nothing -> toText atom
120+showAtom level (ConstructedAtom dConsName _ atoms) = showParens (level >= 1 && length atoms >= 1) $ T.concat (L.intersperse " " (dConsName : (map (showAtom 1) atoms)))
115121
116122renderTable :: Table -> StringType
117123renderTable table = renderHeader table (fst cellLocs) `T.append` renderBody (snd table) cellLocs