-- | Datatypes for law QuickChecks -- User visible combinators. The tests are performed on pretty printing terms -- which are constructable using the public combinators. We need to have a -- datatype for those combinators, otherwise it becomes almost impossible to -- reconstruct failing tests. -- module TestStructures ( CDoc(..), CList(..), CDocList(..), Text(..), buildDoc, liftDoc2, liftDoc3, buildDocList, text', tdToStr, genericCProp ) where import PrettyTestVersion data CDoc = CEmpty -- empty | CText String -- text s | CList CList [CDoc] -- cat,sep,fcat,fsep ds | CBeside Bool CDoc CDoc -- a <> b and a <+> b | CAbove Bool CDoc CDoc -- a $$ b and a $+$ b | CNest Int CDoc -- nest k d deriving (Eq, Ord) data CList = CCat | CSep | CFCat | CFSep deriving (Eq,Ord) newtype CDocList = CDocList { unDocList :: [CDoc] } -- wrapper for String argument of `text' newtype Text = Text { unText :: String } deriving (Eq, Ord, Show) instance Show CDoc where showsPrec k CEmpty = showString "empty" showsPrec k (CText s) = showParen (k >= 10) (showString " text " . shows s) showsPrec k (CList sp ds) = showParen (k >= 10) $ (shows sp . showList ds) showsPrec k (CBeside sep d1 d2) = showParen (k >= 6) $ (showsPrec 6 d1) . showString (if sep then " <+> " else " <> ") . (showsPrec 6 d2) showsPrec k (CAbove noOvlap d1 d2) = showParen (k >= 5) $ (showsPrec 5 d1) . showString (if noOvlap then " $+$ " else " $$ ") . (showsPrec 5 d2) showsPrec k (CNest n d) = showParen (k >= 10) $ showString " nest " . showsPrec 10 n . showString " ". showsPrec 10 d instance Show CList where show cs = case cs of CCat -> "cat" ; CSep -> "sep" ; CFCat -> "fcat" ; CFSep -> "fsep" instance Show CDocList where show = show . unDocList buildDoc :: CDoc -> Doc buildDoc CEmpty = empty buildDoc (CText s) = text s buildDoc (CList sp ds) = (listComb sp) $ map buildDoc ds buildDoc (CBeside sep d1 d2) = (if sep then (<+>) else (<>)) (buildDoc d1) (buildDoc d2) buildDoc (CAbove noOvlap d1 d2) = (if noOvlap then ($+$) else ($$)) (buildDoc d1) (buildDoc d2) buildDoc (CNest k d) = nest k $ buildDoc d listComb :: CList -> ([Doc] -> Doc) listComb cs = case cs of CCat -> cat ; CSep -> sep ; CFCat -> fcat ; CFSep -> fsep liftDoc2 :: (Doc -> Doc -> a) -> (CDoc -> CDoc -> a) liftDoc2 f cd1 cd2 = f (buildDoc cd1) (buildDoc cd2) liftDoc3 :: (Doc -> Doc -> Doc -> a) -> (CDoc -> CDoc -> CDoc -> a) liftDoc3 f cd1 cd2 cd3 = f (buildDoc cd1) (buildDoc cd2) (buildDoc cd3) buildDocList :: CDocList -> [Doc] buildDocList = map buildDoc . unDocList text' :: Text -> Doc text' (Text str) = text str -- convert text details to string tdToStr :: TextDetails -> String tdToStr (Chr c) = [c] tdToStr (Str s) = s tdToStr (PStr s) = s -- synthesize with stop for cdoc -- constructor order genericCProp :: (a -> a -> a) -> (CDoc -> (a, Bool)) -> CDoc -> a genericCProp c q cdoc = case q cdoc of (v,False) -> v (v,True) -> foldl c v subs where rec = genericCProp c q subs = case cdoc of CEmpty -> [] CText _ -> [] CList _ ds -> map rec ds CBeside _ d1 d2 -> [rec d1, rec d2] CAbove b d1 d2 -> [rec d1, rec d2] CNest k d -> [rec d]