module Michelson.Printer.Util
( RenderDoc(..)
, printDoc
, renderOps
, renderOpsList
, spaces
, wrapInParens
, buildRenderDoc
) where
import qualified Data.Text.Lazy as LT
import Data.Text.Lazy.Builder (Builder)
import Text.PrettyPrint.Leijen.Text
(Doc, SimpleDoc, braces, displayB, displayT, hcat, isEmpty, parens, punctuate, renderOneLine,
semi, space, vcat, (<+>))
class RenderDoc a where
renderDoc :: a -> Doc
isRenderable :: a -> Bool
isRenderable _ = True
printDoc :: Doc -> LT.Text
printDoc = displayT . doRender
renderOps :: (RenderDoc op) => Bool -> NonEmpty op -> Doc
renderOps oneLine = renderOpsList oneLine . toList
spacecat :: NonEmpty Doc -> Doc
spacecat = foldr (<+>) mempty
renderOpsList :: (RenderDoc op) => Bool -> [op] -> Doc
renderOpsList oneLine ops =
braces $ cat' $ punctuate semi (renderDoc <$> filter isRenderable ops)
where
cat' = if oneLine then maybe "" spacecat . nonEmpty else vcat
spaces :: Int -> Doc
spaces x = hcat $ replicate x space
wrapInParens :: NonEmpty Doc -> Doc
wrapInParens ds =
if (length $ filter (not . isEmpty) (toList ds)) > 1
then parens $ foldr (<+>) mempty ds
else foldr (<+>) mempty ds
buildRenderDoc :: RenderDoc a => a -> Builder
buildRenderDoc = displayB . doRender . renderDoc
doRender :: Doc -> SimpleDoc
doRender = renderOneLine