implementation module iTasks.Gin.Printer import StdList, StdString, StdOverloaded, StdInt, StdMisc import Data.Map from Text.PPrint import ::Doc, ::SimpleDoc, display, renderPretty from Text.PPrint import qualified <$>, <+>, <->, , align, empty, space, comma, line, char, text, string from Text.PPrint import qualified parens, braces, brackets, dquotes, tupled from Text.PPrint import qualified punctuate, hsep, vsep, vcat, fillSep, hang, indent, renderPretty, display from iTasks.Gin.Parser import :: GPath (..), :: GPathNode (..), :: GResourceId (..) prettyPrint :: Doc -> String prettyPrint doc = 'Text.PPrint'.display ('Text.PPrint'.renderPretty 0.9 120 doc) instance Printer Doc where def a = 'Text.PPrint'.hang 4 a scope docs = 'Text.PPrint'.vsep docs newscope docs = 'Text.PPrint'.indent 4 (scope docs) align a = 'Text.PPrint'.align a (<->) a b = a 'Text.PPrint'. <-> b (<+>) a b = a 'Text.PPrint'. <+> b (<-/>) a b = a 'Text.PPrint'. b (<-$>) a b = a 'Text.PPrint'. <$> b (<$?>) a b = a 'Text.PPrint'. <$> b empty = 'Text.PPrint'.empty space = 'Text.PPrint'.space comma = 'Text.PPrint'.comma char c = 'Text.PPrint'.char c text s = 'Text.PPrint'.text s string s = 'Text.PPrint'.string s parens doc = 'Text.PPrint'.parens doc brackets doc = 'Text.PPrint'.brackets doc braces doc = 'Text.PPrint'.braces doc dquotes doc = 'Text.PPrint'.dquotes doc tupled docs = 'Text.PPrint'.tupled docs punctuate doc docs = 'Text.PPrint'.punctuate doc docs hsep docs = 'Text.PPrint'.hsep docs fillSep docs = 'Text.PPrint'.fillSep docs position _ = 'Text.PPrint'.empty :: PDoc = Empty | Text String //must not contain newlines | Line PDoc | Cat PDoc PDoc | Position GPath positionPrint :: PDoc -> (String, LineMap) positionPrint doc # (s,_,paths) = pp doc 1 = (s,fromList paths) where pp :: PDoc Int -> (String, Int, [(Int, GPath)]) pp Empty nr = ("", nr, []) pp (Text s) nr = (s , nr, []) pp (Line a) nr # (s, nr`, paths) = pp a (nr + 1) = ("\n" +++ s, nr`, paths) pp (Cat a b) nr # (s1, nr, paths1) = pp a nr # (s2, nr, paths2) = pp b nr = (s1 +++ s2, nr, paths1 ++ paths2) pp (Position path) nr = ("", nr, [(nr,path)]) instance Printer PDoc where def a = Cat a (char ';') scope docs = fold (<-$>) docs newscope docs = braces (scope docs) align a = a (<->) a b = Cat a b (<+>) a b = Cat a (Cat space b) (<-/>) a b = a <+> b (<-$>) a b = Cat a (Line b) (<$?>) a b = a <+> b empty = Empty space = Text " " comma = Text "," char c = Text (toString c) text s = Text s string s = Text s parens doc = enclose "(" doc ")" brackets doc = enclose "[" doc "]" braces doc = enclose "{" doc "}" dquotes doc = enclose "\"" doc "\"" tupled docs = parens (hsep (punctuate comma docs)) punctuate p [] = [] punctuate p [d] = [d] punctuate p [d:ds] = [(d <-> p) : punctuate p ds] hsep docs = fold (<->) docs fillSep docs = fold (<-/>) docs position p = Position p enclose :: !String !PDoc !String -> PDoc enclose l doc r = Cat (Text l) (Cat doc (Text r)) fold :: (a a -> a ) [a] -> a | Printer a fold f [] = empty fold f ds = foldr1 f ds foldr1 :: (a a -> a) [a] -> a | Printer a foldr1 f [x] = x foldr1 f [x:xs] = f x (foldr1 f xs)