packages feed

final-pretty-printer (empty) → 0.1.0.0

raw patch · 12 files changed

+1394/−0 lines, 12 filesdep +ansi-terminaldep +basedep +containerssetup-changed

Dependencies added: ansi-terminal, base, containers, exceptions, mtl, temporary, text

Files

+ LICENSE view
@@ -0,0 +1,8 @@+The MIT License (MIT)+Copyright (c) 2016 David Christiansen and David Darais++Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Text/PrettyPrint/Final.hs view
@@ -0,0 +1,388 @@+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}++{-|+Module      : Text.PrettyPrint.Final+Description : The core of the Final Pretty Printer+Copyright   : (c) David Darais, David Christiansen, and Weixi Ma 2016-2017+License     : MIT+Maintainer  : david.darais@gmail.com+Stability   : experimental+Portability : Portable++This module is the core of the Final Pretty Printer.+-}+module Text.PrettyPrint.Final+  ( -- * Pretty monads and measurement+    MonadPretty+  , Measure(..)+    -- * Atomic documents+  , text+  , char+  , space+    -- * Semantic annotations+  , annotate+    -- * Grouping, alignment, and newlines+  , newline+  , hardLine+  , ifFlat+  , grouped+  , align+  , nest+  , expr+    -- * Measuring space+  , measureText+  , spaceWidth+  , emWidth+    -- * Separators+  , hsep+  , vsep+  , hvsep+  , hsepTight+  , hvsepTight+    -- * Helpers for common tasks+  , collection+    -- * Auxiliary datatypes+  , PState(..)+  , Line+  , PEnv(..)+  , localMaxWidth+  , Failure(..)+  , Layout(..)+  , Chunk(..)+  , Atom(..)+  , POut(..)+  ) where++import Control.Monad+import Control.Applicative+import Control.Monad.Identity+import Control.Monad.Reader+import Control.Monad.Writer+import Control.Monad.State+import Control.Monad.RWS+import Data.List+import Data.Text (Text)+import qualified Data.Text as T++-- | Strings or horizontal space to be displayed+data Chunk w =+    CText Text -- ^ An atomic string. Should not contain formatting+               -- spaces or newlines (semantic/object-level spaces OK,+               -- but not newlines)+  | CSpace w   -- ^ An amount of horizontal space to insert.+  deriving (Eq, Ord)++-- | Atomic pieces of output from the pretty printer+data Atom w =+    AChunk (Chunk w) -- ^ Inclusion of chunks+  | ANewline         -- ^ Newlines to be displayed+  deriving (Eq, Ord)++-- | A current line under consideration for insertion of breaks+type Line w fmt = [(Chunk w, fmt)]++-- | Pretty printer output represents a single annotated string.+data POut w ann =+    PNull -- ^ The empty output+  | PAtom (Atom w) -- ^ Atomic output+  | PAnn ann (POut w ann) -- ^ An annotated region of output+  | PSeq (POut w ann) (POut w ann) -- ^ The concatenation of two outputs+  deriving (Eq, Ord, Functor)++instance Monoid (POut w ann) where+  mempty = PNull+  mappend = PSeq++-- | Monad @m@ can measure lines formatted by @fmt@, getting width @w@.+--+-- For example, monospaced pretty printing can be measured in 'Identity', using+-- an 'Int' character count. For proportional fonts, @w@ will typically be something+-- like 'Double', and @m@ will be 'IO' to support observing the behavior of a font+-- rendering library.+class Measure w fmt m | m -> w, m -> fmt where+  -- | Measure a particular line+  measure :: Line w fmt -> m w++instance Measure Int () Identity where+  measure = pure . sum . fmap (chunkLength . fst)+    where+      chunkLength (CText t) = T.length t+      chunkLength (CSpace w) = w++-- | Pretty printing can be done in any pretty monad.+--+-- Pretty monads have an additional law: failure (from 'Alternative')+-- must undo the writer and state effects. So @RWST@ applied to+-- @Maybe@ is fine, but @MaybeT@ of @RWS@ is not.+class+  ( Ord w, Num w+  , Monoid fmt+  , Measure w fmt m+  , Monad m+  , MonadReader (PEnv w ann fmt) m+  , MonadWriter (POut w ann) m+  , MonadState (PState w fmt) m+  , Alternative m+  , Functor m -- for older GHCs+  ) => MonadPretty w ann fmt m+       | m -> w, m -> ann, m -> fmt+  where++-- | Is the pretty printer attempting to put things on one long line?+data Layout = Flat | Break+  deriving (Eq, Ord)++-- | Is there a failure handler to allow backtracking from the current line?+data Failure = CanFail | CantFail+  deriving (Eq, Ord)++-- | The dynamic context of a pretty printing computation+data PEnv w ann fmt = PEnv+  { maxWidth :: w+    -- ^ The maximum page width to use+  , maxRibbon :: w+    -- ^ The maximum amount of non-indentation space to use on one line+  , nesting :: w+    -- ^ The current indentation level+  , layout :: Layout+    -- ^ Whether lines are presently being broken or not+  , failure :: Failure+    -- ^ Whether there is a failure handler waiting to backgrack from laying out a line+  , formatting :: fmt+    -- ^ A stack of formatting codes to be combined with the monoid op+  , formatAnn :: ann -> fmt+    -- ^ A means of formatting annotations during rendering. This+    -- provides an opportunity for annotations to affect aspects of+    -- the output, like font selection, that can have an impact on the+    -- width.  If this does not agree with the formatting chosen in+    -- the final display, then odd things might happen, so the same+    -- information should be used here if possible.+  }++askMaxWidth :: (Functor m, MonadReader (PEnv w ann fmt) m) => m w+askMaxWidth = maxWidth <$> ask++-- | Locally change the maximum horizontal space+localMaxWidth :: (MonadReader (PEnv w ann fmt) m) => (w -> w) -> m a -> m a+localMaxWidth f = local $ \ r -> r { maxWidth = f (maxWidth r) }++askMaxRibbon :: (Functor m, MonadReader (PEnv w ann fmt) m) => m w+askMaxRibbon = maxRibbon <$> ask++askNesting :: (Functor m, MonadReader (PEnv w ann fmt) m) => m w+askNesting = nesting <$> ask++localNesting :: (MonadReader (PEnv w ann fmt) m) => (w -> w) -> m a -> m a+localNesting f = local $ \ r -> r { nesting = f (nesting r) }++askFormat :: (Functor m, MonadReader (PEnv w ann fmt) m, Monoid fmt) => m fmt+askFormat = formatting <$> ask++localFormat :: (Monoid fmt, MonadReader (PEnv w ann fmt) m) => (fmt -> fmt) -> m a -> m a+localFormat f = local $ \ r -> r { formatting = f (formatting r) }++pushFormat :: (Monoid fmt, MonadReader (PEnv w ann fmt) m) => fmt -> m a -> m a+pushFormat format = localFormat (flip mappend format )++askFormatAnn :: (Functor m, MonadReader (PEnv w ann fmt) m, Monoid fmt) => m (ann -> fmt)+askFormatAnn = formatAnn <$> ask++localFormatAnn :: (MonadReader (PEnv w ann fmt) m) => ((ann -> fmt) -> (ann -> fmt)) -> m a -> m a+localFormatAnn f = local $ \ r -> r { formatAnn = f (formatAnn r) }++askLayout :: (Functor m, MonadReader (PEnv w ann fmt) m) => m Layout+askLayout = layout <$> ask++localLayout :: (MonadReader (PEnv w ann fmt) m) => (Layout -> Layout) -> m a -> m a+localLayout f = local $ \ r -> r { layout = f (layout r) }++askFailure :: (Functor m, MonadReader (PEnv w ann fmt) m) => m Failure+askFailure = failure <$> ask++localFailure :: (MonadReader (PEnv w ann fmt) m) => (Failure -> Failure) -> m a -> m a+localFailure f = local $ \ r -> r { failure = f (failure r) }++-- | The current state of the pretty printer consists of the line under consideration.+data PState w fmt = PState+  { curLine :: Line w fmt+  }+  deriving (Eq, Ord)++getCurLine :: (Functor m, MonadState (PState w fmt) m) => m (Line w fmt)+getCurLine = curLine <$> get++putCurLine :: (MonadState (PState w fmt) m) => Line w fmt -> m ()+putCurLine t = modify $ \ s -> s { curLine = t }++measureCurLine :: (Functor m, Measure w fmt m, Monad m, MonadState (PState w fmt) m) => m w+measureCurLine = measure =<< getCurLine++modifyLine :: (MonadState (PState w fmt) m) => (Line w fmt -> Line w fmt) -> m ()+modifyLine f = modify $ \ s -> s { curLine = f (curLine s) }++-- not exported+-- this is the core algorithm.+chunk :: (MonadPretty w ann fmt m) => Chunk w -> m ()+chunk c = do+  tell $ PAtom $ AChunk c+  format <- askFormat+  modifyLine $ flip mappend [(c, format)]+  f <- askFailure+  when (f == CanFail) $ do+    wmax <- askMaxWidth+    rmax <- askMaxRibbon+    w <- measureCurLine+    n <- askNesting+    when (n + w > wmax) empty+    when (w     > rmax) empty++-- grouped interacts with chunk, and can either be distributive (Hughes PP) or+-- left-zero (Wadler PP) by instantiating m with [] or Maybe, (or ID for no+-- grouping) (probability monad????)++-- | Group a collection of pretty-printer actions, undoing their newlines if possible.+-- If m is [], grouping has a distributive Hughes-style semantics, and if m is Maybe,+-- then grouping has a Wadler-style left-zero semantics. The identity monad gives no+-- grouping.+grouped :: (MonadPretty w ann fmt m) => m a -> m a+grouped aM = ifFlat aM $ (makeFlat . allowFail) aM <|> aM++-- | Include a Text string in the document.+text :: (MonadPretty w ann fmt m) => Text -> m ()+text t = chunk $ CText t++-- | Include a single character in the document.+char :: (MonadPretty w ann fmt m) => Char -> m ()+char c = chunk $ CText $ T.pack [c]++-- | Include a space of a given width in the document.+space :: (MonadPretty w ann fmt m) => w -> m ()+space w = chunk $ CSpace w++-- | A line break that ignores nesting+hardLine :: (MonadPretty w ann fmt m) => m ()+hardLine = do+  tell $ PAtom ANewline+  putCurLine []++-- | A lie break that respects nesting+newline :: (MonadPretty w ann fmt m) => m ()+newline = do+  n <- askNesting+  hardLine+  space n++-- | Increase the nesting level to render some argument, which will result in the+-- document being indented following newlines.+nest :: (MonadPretty w ann fmt m) => w -> m a -> m a+nest = localNesting . (+)++-- | Conditionally render documents based on whether grouping is undoing newlines.+ifFlat :: (MonadPretty w ann fmt m) => m a -> m a -> m a+ifFlat flatAction breakAction = do+  l <- askLayout+  case l of+    Flat -> flatAction+    Break -> breakAction++-- | Unconditionally undo newlines in a document.+makeFlat :: (MonadPretty w ann fmt m) => m a -> m a+makeFlat = localLayout $ const Flat++allowFail :: (MonadPretty w ann fmt m) => m a -> m a+allowFail = localFailure $ const CanFail++-- | Vertically align documents.+align :: (MonadPretty w ann fmt m) => m a -> m a+align aM = do+  n <- askNesting+  w :: w <- measureCurLine+  nest (w - n) aM++-- | Add a semantic annotation to a document. These annotations are converted into+-- the output stream's notion of decoration by the renderer.+annotate :: (MonadPretty w ann fmt m) => ann -> m a -> m a+annotate ann aM = do+  newFormat <- askFormatAnn <*> pure ann+  pushFormat newFormat . censor (PAnn ann) $ aM++-- higher level stuff++-- | Separate a collection of documents with a space character.+hsep :: (MonadPretty w ann fmt m) => [m ()] -> m ()+hsep = sequence_ . intersperse (text " ")++-- | Separate a collection of documents with newlines.+vsep :: (MonadPretty w ann fmt m) => [m ()] -> m ()+vsep = sequence_ . intersperse newline++-- | Measure a string in the current pretty printing context.+--+-- Make sure to measure the text in the same dynamic context where its+-- width is to be used, to make sure the right formatting options are+-- applied.+measureText :: (MonadPretty w ann fmt m) => Text -> m w+measureText txt = do+  format <- askFormat+  measure [(CText txt, format)]++-- | Measure the width of a space in the current font+spaceWidth :: (MonadPretty w ann fmt m) => m w+spaceWidth = measureText " "++-- | Measure the width of a capital M in the current font+emWidth :: (MonadPretty w ann fmt m) => m w+emWidth = measureText "M"++-- | Separate a collection of documents with a space (if there's room)+-- or a newline if not.+hvsep :: (MonadPretty w ann fmt m) => [m ()] -> m ()+hvsep docs = do+  i <- spaceWidth+  grouped $ sequence_ $ intersperse (ifFlat (space i) newline) $ docs++-- | Separate a collection of documents with no space if they can be+-- on the same line, or with the width of a space character in+-- when they cannot.+hsepTight :: (MonadPretty w ann fmt m) => [m ()] -> m ()+hsepTight docs = do+  i <- spaceWidth+  sequence_ $ intersperse (ifFlat (return ()) (space i)) $ docs++-- | Separate a collection of documents with no space if they can be+-- on the same line, or with newlines if they cannot.+hvsepTight :: (MonadPretty w ann fmt m) => [m ()] -> m ()+hvsepTight = grouped . sequence_ . intersperse (ifFlat (return ()) newline)++-- | Print a collection in comma-initial form.+--+-- For sub-documents @d1@, @d2@, @d3@, flat mode is:+--+-- > [d1, d2, d3]+--+-- and multi-line mode is:+--+-- > [ d1+-- > , d2+-- > , d3+-- > ]+collection :: (MonadPretty w ann fmt m) => m () -> m () -> m () -> [m ()] -> m ()+collection open close _   []     = open >> close+collection open close sep (x:xs) = grouped $ hvsepTight $ concat+  [ pure $ hsepTight [open, align x]+  , flip map xs $ \ x' -> hsep [sep, align x']+  , pure close+  ]++-- | Align and group a subdocument, similar to Wadler's @group@ combinator.+expr :: MonadPretty w ann fmt m => m a -> m a+expr = align . grouped
+ Text/PrettyPrint/Final/Demos/ListDemo.hs view
@@ -0,0 +1,124 @@+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}++-- | A demo of annotations+module Text.PrettyPrint.Final.Demos.ListDemo () where++import Control.Monad+import Control.Applicative+import Control.Monad.Identity+import Control.Monad.Reader+import Control.Monad.Writer+import Control.Monad.State+import Control.Monad.RWS+import Data.List+import Data.String (IsString(..))+import Data.Text (Text)+import qualified Data.Text as T++import System.Console.ANSI++import Text.PrettyPrint.Final+import Text.PrettyPrint.Final.Rendering.Console++-- Constructor names or built-in syntax+data HsAnn = Ctor | Stx+  deriving (Eq, Ord, Show)++env0 :: Monoid fmt => PEnv Int a fmt+env0 = PEnv+  { maxWidth = 80+  , maxRibbon = 60+  , layout = Break+  , failure = CantFail+  , nesting = 0+  , formatting = mempty+  , formatAnn = const mempty+  }++state0 :: PState Int ()+state0 = PState+  { curLine = []+  }++-- For plain text pretty printing+newtype DocM a = DocM { unDocM :: RWST (PEnv Int HsAnn ()) (POut Int HsAnn) (PState Int ()) Maybe a }+  deriving+    ( Functor, Applicative, Monad+    , MonadReader (PEnv Int HsAnn ()), MonadWriter (POut Int HsAnn), MonadState (PState Int ()), Alternative+    )++instance MonadPretty Int HsAnn () DocM++instance IsString (DocM ()) where+  fromString = text . fromString++runDocM :: PEnv Int HsAnn () -> PState Int () -> DocM a -> Maybe (PState Int (), POut Int HsAnn, a)+runDocM e s d = (\(a,s',o) -> (s',o,a)) <$> runRWST (unDocM d) e s++execDoc :: Doc -> POut Int HsAnn+execDoc d =+  let rM = runDocM env0 state0 d+  in case rM of+    Nothing -> PAtom $ AChunk $ CText "<internal pretty printing error>"+    Just (_, o, ()) -> o++type Doc = DocM ()++instance Monoid Doc where+  mempty = return ()+  mappend = (>>)++class Pretty a where+  pretty :: a -> Doc+instance Pretty Doc where+  pretty = id++instance Measure Int () DocM where+  measure = return . runIdentity . measure++instance Pretty Text where+  pretty = annotate Ctor . text . T.pack . show++instance (Pretty a) => Pretty [a] where+  pretty = collection (annotate Stx "[") (annotate Stx "]") (annotate Stx ",") . map pretty++toSGR :: HsAnn -> [SGR]+toSGR Ctor = [SetConsoleIntensity BoldIntensity, SetColor Foreground Vivid Red]+toSGR Stx  = [SetConsoleIntensity BoldIntensity, SetColor Foreground Vivid Black]++updateColor :: forall ann . StateT [HsAnn] IO ()+updateColor =+  lift . setSGR =<< mconcat . map toSGR . reverse <$> get++openTag :: HsAnn -> StateT [HsAnn] IO ()+openTag ann = modify (ann:) >> updateColor++closeTag :: HsAnn -> StateT [HsAnn] IO ()+closeTag _  = modify tail   >> updateColor++renderAnnotation :: HsAnn -> StateT [HsAnn] IO () -> StateT [HsAnn] IO ()+renderAnnotation a o = openTag a >> o >> closeTag a++dumpList :: Doc -> IO ()+dumpList = dumpDoc toSGR renderAnnotation . execDoc++---------------+-- Test docs --+---------------++shortList :: [[Text]]+shortList = [["a", "b", "c"], [], ["longer"]]++longList :: [[Text]]+longList = [map (T.pack . show) [1..10], [], map (T.pack . flip replicate 'a') [1..10]]++-- To try, eval dumpDoc (pretty shortList) or dumpDoc (pretty longList) in console GHCI
+ Text/PrettyPrint/Final/Demos/STLCDemo.hs view
@@ -0,0 +1,238 @@+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}++-- | A demonstration of the precedence and environment extensions+module Text.PrettyPrint.Final.Demos.STLCDemo () where++import Control.Monad+import Control.Applicative+import Control.Monad.Identity+import Control.Monad.Reader+import Control.Monad.Writer+import Control.Monad.State+import Control.Monad.RWS+import Data.List+import Data.String (IsString(..))+import Data.Text (Text)+import qualified Data.Text as T+import Data.Map (Map)+import qualified Data.Map as Map++import Text.PrettyPrint.Final hiding (collection)+import Text.PrettyPrint.Final.Extensions.Environment+import Text.PrettyPrint.Final.Extensions.Precedence+import Text.PrettyPrint.Final.Rendering.HTML++data Ann = Class Text | Tooltip Text+  deriving (Eq, Ord, Show)++-- The Language++data Ty = Int | Arr Ty Ty++data Op = Plus | Minus | Times | Div++data Exp = +    Lit Int+  | Bin Op Exp Exp+  | Ifz Exp Exp Exp+  | Var Text+  | Lam Text Ty Exp+  | App Exp Exp+  | Raw Doc++infixl 5 /+/+infixl 5 /-/++infixl 6 /*/+infixl 6 ///++infixl 9 /@/++(/+/) :: Exp -> Exp -> Exp+(/+/) = Bin Plus++(/-/) :: Exp -> Exp -> Exp+(/-/) = Bin Minus++(/*/) :: Exp -> Exp -> Exp+(/*/) = Bin Times++(///) :: Exp -> Exp -> Exp+(///) = Bin Div++(/@/) :: Exp -> Exp -> Exp+(/@/) = App++-- The Pretty Printer++-- class shortcuts++lit :: Ann+lit = Class "lit"++var :: Ann+var = Class "var"++pun :: Ann+pun = Class "pun"++bdr :: Ann+bdr = Class "bdr"++kwd :: Ann+kwd = Class "kwd"++opr :: Ann+opr = Class "opr"++type TEnv = Map Text Text++tEnv0 :: TEnv+tEnv0 = Map.empty++newtype DocM a = DocM { unDocM :: EnvT TEnv (PrecT Ann (RWST (PEnv Int Ann ()) (POut Int Ann) (PState Int ()) Maybe)) a }+  deriving+    ( Functor, Applicative, Monad, Alternative+    , MonadReader (PEnv Int Ann ()), MonadWriter (POut Int Ann), MonadState (PState Int ())+    , MonadReaderPrec Ann, MonadReaderEnv TEnv+    )+instance MonadPretty Int Ann () DocM+instance MonadPrettyPrec Int Ann () DocM+instance MonadPrettyEnv TEnv Int Ann () DocM++instance Measure Int () DocM where+  measure = return . runIdentity . measure++runDocM :: PEnv Int Ann () -> PrecEnv Ann -> TEnv -> PState Int () -> DocM a -> Maybe (PState Int (), POut Int Ann, a)+runDocM e pe te s d = (\(a,s',o) -> (s',o,a)) <$> runRWST (runPrecT pe (runEnvT te $ unDocM d)) e s++askTEnv :: DocM TEnv+askTEnv = askEnv++localTEnv :: (TEnv -> TEnv) -> DocM a -> DocM a+localTEnv f = localEnv f++-- Doc++env0 :: (Num w) => PEnv w ann ()+env0 = PEnv+  { maxWidth = 80+  , maxRibbon = 60+  , layout = Break+  , failure = CantFail+  , nesting = 0+  , formatting = mempty+  , formatAnn = const mempty+  }++state0 :: PState Int ()+state0 = PState+  { curLine = []+  }+++type Doc = DocM ()++execDoc :: Doc -> POut Int Ann+execDoc d =+  let rM = runDocM env0 precEnv0 tEnv0 state0 d+  in case rM of+    Nothing -> PAtom $ AChunk $ CText "<internal pretty printing error>"+    Just (_, o, ()) -> o++instance IsString Doc where+  fromString = text . fromString++instance Monoid Doc where+  mempty = return ()+  mappend = (>>)++renderAnnotation :: Ann -> Text -> Text+renderAnnotation (Class c) t = mconcat [ "<span class='" , c , "'>" , t , "</span>" ]+renderAnnotation (Tooltip p) t = mconcat [ "<span title='" , p , "'>" , t , "</span>" ]++instance Show Doc where+  show = T.unpack . (render renderAnnotation) . execDoc++-- Pretty Class for this Doc++class Pretty a where+  pretty :: a -> Doc++instance Pretty Doc where+  pretty = id++instance Pretty Text where+  pretty = text . T.pack . show++-- printing expressions++ftTy :: Ty -> Text+ftTy Int = "Int"+ftTy (Arr t1 t2) = ftTy t1 `T.append` " -> " `T.append` ftTy t2++ppOp :: Op -> Doc -> Doc -> Doc+ppOp Plus x1 x2 = infl 20 (annotate opr "+") (grouped x1) (grouped x2)+ppOp Minus x1 x2 = infl 20 (annotate opr "-") (grouped x1) (grouped x2)+ppOp Times x1 x2 = infl 30 (annotate opr "*") (grouped x1) (grouped x2)+ppOp Div x1 x2 = infl 30 (annotate opr "/") (grouped x1) (grouped x2)++ppExp :: Exp -> Doc+ppExp (Lit i) = annotate lit $ text $ T.pack $ show i+ppExp (Bin o e1 e2) = ppOp o (ppExp e1) (ppExp e2)+ppExp (Ifz e1 e2 e3) = grouped $ atLevel 10 $ hvsep +  [ grouped $ nest 2 $ hvsep [ annotate kwd "ifz" , botLevel $ ppExp e1 ]+  , grouped $ nest 2 $ hvsep [ annotate kwd "then" , botLevel $ ppExp e2 ]+  , grouped $ nest 2 $ hvsep [ annotate kwd "else" , ppExp e3 ]+  ]+ppExp (Var x) = do+  tEnv <- askTEnv+  let tt = tEnv Map.! x+  annotate (Tooltip tt) $ annotate var $ text x+ppExp (Lam x ty e) = localTEnv (Map.insert x $ ftTy ty) $ grouped $ atLevel 10 $ nest 2 $ hvsep+  [ hsep [ annotate kwd "lam" , annotate (Tooltip $ ftTy ty) $ annotate bdr $ text x , annotate pun "." ]+  , ppExp e+  ]+ppExp (App e1 e2) = app (ppExp e1) [ppExp e2]+ppExp (Raw d) = d++precDebug :: Doc+precDebug = do+  lvl <- askLevel+  bmp <- askBumped+  text $ "p:" `T.append` T.pack (show lvl) `T.append` (if bmp then "B" else "")++instance Pretty Exp where+  pretty = ppExp++e1 :: Exp+e1 = Lam "x" Int $ Var "x"++-- ifz ((1 - 2) + (3 - 4)) * (5 / 7) +-- then lam x . x +-- else (lam y . y) (ifz 1 then 2 else 3)+e2 :: Exp+e2 = Ifz ((Lit 1 /-/ Lit 2 /+/ (Lit 3 /-/ Lit 4)) /*/ (Lit 5 /// Lit 7) /+/ Lit 8)+         (Lam "x" Int $ Var "x")+         ((Lam "y" Int $ Var "y") /@/ (Ifz (Lit 1) (Lit 2) (Lit 3)))++-- run this file to output an html file "stlc_demo.html", which links against+-- "stlc_demo.css"+main :: IO ()+main = do+  let output = show $ localMaxWidth (const 15) $ pretty e2+  putStrLn output+  writeFile "stlc_demo.html" $ concat+    [ "<html><head><link rel='stylesheet' type='text/css' href='stlc_demo.css'></head><body><p>"+    , output+    , "</p></body></html>"+    ]
+ Text/PrettyPrint/Final/Extensions/Environment.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE UndecidableInstances #-}++{-|+Module      : Text.PrettyPrint.Final.Extensions.Environment+Description : Lexical scope tracking for final pretty printers+Copyright   : (c) David Darais, David Christiansen, and Weixi Ma 2016-2017+License     : MIT+Maintainer  : david.darais@gmail.com+Stability   : experimental+Portability : Portable++'EnvT' extends a pretty printer to track a lexical environment.+-}++module Text.PrettyPrint.Final.Extensions.Environment+  ( MonadPrettyEnv(..)+  , MonadReaderEnv(..)+  -- * The transformer+  , EnvT(..)+  , runEnvT+  , mapEnvT+  ) where++import Control.Applicative+import Control.Monad.Reader+import Control.Monad.State+import Control.Monad.Writer+++import Text.PrettyPrint.Final as Final+import Text.PrettyPrint.Final.Extensions.Precedence++-- | A reader of environments+class MonadReaderEnv env m | m -> env where+  -- | See 'ask'+  askEnv :: m env+  -- | See 'local'+  localEnv :: (env -> env) -> m a -> m a++-- | Pretty monads that can read environments. Use this to implement+-- lexical scope in your pretty printer, because the dynamic extent of+-- pretty monad computations typically corresponds to the scope of a+-- binder.+class ( MonadPretty w ann fmt m+      , MonadReaderEnv env m+      ) => MonadPrettyEnv env w ann fmt m+      | m -> w, m -> ann, m -> fmt, m -> env where++-- | A transformer that adds a reader effect, distinguished by the newtype tag.+newtype EnvT env m a = EnvT { unEnvT :: ReaderT env m a }+  deriving+    ( Functor, Monad, Applicative, Alternative, MonadTrans+    , MonadState s, MonadWriter o+    )++-- | Run a pretty printer in an initial environment+runEnvT :: env -> EnvT env m a -> m a+runEnvT e xM = runReaderT (unEnvT xM) e++-- | Transform the result of a pretty printer+mapEnvT :: (m a -> n b) -> EnvT env m a -> EnvT env n b+mapEnvT f = EnvT . mapReaderT f . unEnvT++instance MonadReader r m => MonadReader r (EnvT env m) where+  ask = EnvT $ lift ask+  local f = mapEnvT (local f)++instance (Monad m, Measure w fmt m) => Measure w fmt (EnvT env m) where+  measure = lift . measure++instance MonadPretty w ann fmt m => MonadPretty w ann fmt (EnvT env m) where++instance Monad m => MonadReaderEnv env (EnvT env m) where+  askEnv = EnvT ask+  localEnv f = EnvT . local f . unEnvT++instance (Monad m, MonadReaderPrec ann m) => MonadReaderPrec ann (EnvT env m) where+  askPrecEnv = lift askPrecEnv+  localPrecEnv f (EnvT (ReaderT x)) = EnvT (ReaderT (\env -> localPrecEnv f (x env)))
+ Text/PrettyPrint/Final/Extensions/Precedence.hs view
@@ -0,0 +1,213 @@+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE UndecidableInstances #-}++{-|+Module      : Text.PrettyPrint.Final.Extensions.Precedence+Description : A pretty printer extension for tracking precedence and associativity+Copyright   : (c) David Darais, David Christiansen, and Weixi Ma 2016-2017+License     : MIT+Maintainer  : david.darais@gmail.com+Stability   : experimental+Portability : Portable++A transformer of pretty monads that provides effects for inserting+parentheses minimally and correctly.+-}+module Text.PrettyPrint.Final.Extensions.Precedence+  ( -- * Precedence information+    PrecEnv(..)+  , precEnv0+    -- * Precedence effects+  , askLevel+  , localLevel+  , infl+  , infr+  , atLevel+  , botLevel+  , app+  , askBumped+  -- * The transformer+  , MonadReaderPrec(..)+  , MonadPrettyPrec(..)+  , PrecT(..)+  , runPrecT+  , mapPrecT+  ) where++import Control.Monad+import Control.Applicative+import Control.Monad.Reader+import Control.Monad.Writer+import Control.Monad.State+import Control.Monad.RWS+import Data.List+import Data.String (IsString(..))+import Data.Text (Text)+import qualified Data.Text as T++import Text.PrettyPrint.Final as Final++-- | A precedence environment contains enough information to determine+-- whether parentheses should be inserted.+data PrecEnv ann = PrecEnv+  { level :: Int+    -- ^ The current precedence level of the context+  , bumped :: Bool+    -- ^ A tiebreaker used to distinguish left- and right-associative contexts+  , lparen :: (Text, Maybe ann)+    -- ^ What to show for a left parenthesis. The optional annotation+    -- will be applied.+  , rparen :: (Text, Maybe ann)+    -- ^ What to show for a right parenthesis. The optional annotation+    -- will be applied.+  }++-- | An initial precedence environment that works for languages with+-- parentheses as delimiters.+precEnv0 :: PrecEnv ann+precEnv0 = PrecEnv+  { level = 0+  , bumped = False+  , lparen = ("(", Nothing)+  , rparen = (")", Nothing)+  }+++-- | Precedence follows the structure of a document, so a Reader+-- provides the appropriate dynamic extent of precedence information.+class MonadReaderPrec ann m | m -> ann where+  -- | What is the current precedence environment? (see 'ask')+  askPrecEnv :: m (PrecEnv ann)+  -- | Override the precedence environment in a subcomputation. (see 'local')+  localPrecEnv :: (PrecEnv ann -> PrecEnv ann) -> m a -> m a++-- | What is the current precedence level?+askLevel :: (Functor m, MonadReaderPrec ann m) => m Int+askLevel = level <$> askPrecEnv++-- | Run a subcomputation with a modified precedence level.+localLevel :: (Functor m, MonadReaderPrec ann m) => (Int -> Int) -> m a -> m a+localLevel f = localPrecEnv $ \ pe -> pe { level = f $ level pe }++-- | Is the current precedence bumped? See 'PrecEnv'.+askBumped :: (Functor m, MonadReaderPrec ann m) => m Bool+askBumped = bumped <$> askPrecEnv++localBumped :: (Functor m, MonadReaderPrec ann m) => (Bool -> Bool) -> m a -> m a+localBumped f = localPrecEnv $ \ pe -> pe { bumped = f $ bumped pe }++askLParen :: (Functor m, MonadReaderPrec ann m) => m (Text, Maybe ann)+askLParen = lparen <$> askPrecEnv++localLParen :: (Functor m, MonadReaderPrec ann m) => ((Text, Maybe ann) -> (Text, Maybe ann)) -> m a -> m a+localLParen f = localPrecEnv $ \ pe -> pe { lparen = f $ lparen pe }++askRParen :: (Functor m, MonadReaderPrec ann m) => m (Text, Maybe ann)+askRParen = rparen <$> askPrecEnv++localRParen :: (Functor m, MonadReaderPrec ann m) => ((Text, Maybe ann) -> (Text, Maybe ann)) -> m a -> m a+localRParen f = localPrecEnv $ \ pe -> pe { rparen = f $ rparen pe }++-- | A pretty monad that can read precedence environments+class ( MonadPretty w ann fmt m+      , MonadReaderPrec ann m+      ) =>+      MonadPrettyPrec w ann fmt m+      | m -> w, m -> ann, m -> fmt++-- Operations++-- | Put a subdocument in the lowest precedence context+botLevel :: (MonadPrettyPrec w ann fmt m) => m () -> m ()+botLevel = localLevel (const 0) . localBumped (const False)++-- | Close a context with left and right delimiters+closed :: (MonadPrettyPrec w ann fmt m) => m () -> m () -> m () -> m ()+closed alM arM aM = do+  alM+  botLevel $ aM+  arM++-- | Close a context with the configured left and right parentheses+parens :: (MonadPrettyPrec w ann fmt m) => m () -> m ()+parens aM = do+  (lp, lpA) <- askLParen+  (rp, rpA) <- askRParen+  let lpD = maybe id annotate lpA $ text lp+      rpD = maybe id annotate rpA $ text rp+  closed lpD rpD $ align aM++-- | Run a subcomputation at a particular precedence level+atLevel :: (MonadPrettyPrec w ann fmt m) => Int -> m () -> m ()+atLevel i' aM = do+  i <- askLevel+  b <- askBumped+  let aM' = localLevel (const i') $ localBumped (const False) aM+  if i < i' || (i == i' && not b)+    then aM'+    else parens aM'++-- | Bump the precedence to implement associativity+bump :: (MonadPrettyPrec w ann fmt m) => m a -> m a+bump = localBumped $ const True++-- | Display a non-associative infix operator at a precedence level+inf :: (MonadPrettyPrec w ann fmt m) => Int -> m () -> m () -> m () -> m ()+inf i oM x1M x2M = atLevel i $ bump x1M >> space 1 >> oM >> space 1 >> bump x2M++-- | Display a left-associative infix operator at a precedence level+infl :: (MonadPrettyPrec w ann fmt m) => Int -> m () -> m () -> m () -> m ()+infl i oM x1M x2M = atLevel i $ x1M >> space 1 >> oM >> space 1 >> bump x2M++-- | Display a right-associative infix operator at a precedence level+infr :: (MonadPrettyPrec w ann fmt m) => Int -> m () -> m () -> m () -> m ()+infr i oM x1M x2M = atLevel i $ bump x1M >> space 1 >> oM >> space 1 >> x2M++-- | Display a prefix operator at a precedence level+pre :: (MonadPrettyPrec w ann fmt m) => Int -> m () -> m () -> m ()+pre i oM xM = atLevel i $ oM >> space 1 >> xM++-- | Display a postfix operator at a precedence level+post :: (MonadPrettyPrec w ann fmt m) => Int -> m () -> m () -> m ()+post i oM xM = atLevel i $ xM >> space 1 >> oM++-- | Perform function application with precedence level <100+app :: (MonadPrettyPrec w ann fmt m) => m () -> [m ()] -> m ()+app x xs = atLevel 100 $ hvsep $ x : map (align . bump) xs++-- | Lay out a collection like 'Final.collection', but reset the precedence level.+collection :: (MonadPrettyPrec w ann fmt m) => m () -> m () -> m () -> [m ()] -> m ()+collection open close sep = Final.collection open close sep . map botLevel++-- Monad Transformer+-- | A monad transformer that adds a precedence effects+newtype PrecT ann m a = PrecT { unPrecT :: ReaderT (PrecEnv ann) m a }+  deriving+  ( Functor, Monad, Applicative, Alternative, MonadTrans+  , MonadState s, MonadWriter o+  )++-- | Run a precedence transformer with some initial precedence environment+runPrecT :: PrecEnv ann -> PrecT ann m a -> m a+runPrecT pr xM = runReaderT (unPrecT xM) pr++-- | Transform the value returned by a 'PrecT'+mapPrecT :: (m a -> n b) -> PrecT ann m a -> PrecT ann n b+mapPrecT f = PrecT . mapReaderT f . unPrecT++instance (MonadReader r m) => MonadReader r (PrecT ann m) where+  ask = PrecT $ lift ask+  local f = PrecT . mapReaderT (local f) . unPrecT++instance (Monad m) => MonadReaderPrec ann (PrecT ann m) where+  askPrecEnv = PrecT ask+  localPrecEnv f = PrecT . local f . unPrecT
+ Text/PrettyPrint/Final/Rendering/Console.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}++{-|+Module      : Text.PrettyPrint.Final.Rendering.Console+Description : A renderer for colored monospace text on a console+Copyright   : (c) David Darais, David Christiansen, and Weixi Ma 2016-2017+License     : MIT+Maintainer  : david.darais@gmail.com+Stability   : experimental+Portability : Portable++A renderer for colored monospace text on a console.+-}++module Text.PrettyPrint.Final.Rendering.Console (render, dumpDoc) where++import Control.Monad+import Control.Applicative+import Control.Monad.Reader+import Control.Monad.Writer+import Control.Monad.State+import Control.Monad.RWS+import Data.List+import Data.String (IsString(..))+import Data.Text (Text)+import qualified Data.Text as T++import System.Console.ANSI++import Text.PrettyPrint.Final++renderChunk :: Chunk Int -> Text+renderChunk (CText t) = t+renderChunk (CSpace w) = T.replicate w " "++renderAtom :: Atom Int -> Text+renderAtom (AChunk c) = renderChunk c+renderAtom ANewline = "\n"++-- | Render a 'POut' in some monad.+render :: forall m ann . Monad m+       => (ann -> m () -> m ()) -- ^ How to transform a rendering based on an annotation+       -> (Text -> m ())        -- ^ How to output an atomic string+       -> POut Int ann          -- ^ The document to render+       -> m ()+render renderAnnotation str out = render' out+  where render' :: POut Int ann -> m ()+        render' pout = case pout of+          PNull      -> str ""+          PAtom a    -> str $ renderAtom a+          PSeq o1 o2 -> do render' o1+                           render' o2+          PAnn a o   -> renderAnnotation a $ render' o++-- | Dump pretty printer output to a console.+--+-- In 'IO' to support rendering colors on Windows.+dumpDoc :: (ann -> [SGR])+        -> (ann -> StateT [ann] IO () -> StateT [ann] IO ())+        -> POut Int ann+        -> IO ()+dumpDoc toSGR renderAnnotation =+  flip evalStateT [] .+  render renderAnnotation (lift . putStr . T.unpack)
+ Text/PrettyPrint/Final/Rendering/HTML.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}++{-|+Module      : Text.PrettyPrint.Final.Rendering.HTML+Description : Monospaced text output to be included in HTML+Copyright   : (c) David Darais, David Christiansen, and Weixi Ma 2016-2017+License     : MIT+Maintainer  : david.darais@gmail.com+Stability   : experimental+Portability : Portable++HTML has its own conventions around whitespace and newlines. This+modules contains a renderer that inserts the appropriate non-breaking+spaces and line break tags.++-}++module Text.PrettyPrint.Final.Rendering.HTML (render) where++import Control.Monad+import Control.Applicative+import Control.Monad.Reader+import Control.Monad.Writer+import Control.Monad.State+import Control.Monad.RWS+import Data.List+import Data.String (IsString(..))+import Data.Text (Text)+import qualified Data.Text as T++import Text.PrettyPrint.Final++renderChunk :: Chunk Int -> Text+renderChunk (CText t) = t+renderChunk (CSpace w) = T.replicate w " "++renderAtom :: Atom Int -> Text+renderAtom (AChunk c) = T.concatMap swapSpace $ renderChunk c+  where+    swapSpace ' ' = "&nbsp;"+    swapSpace c = T.singleton c+renderAtom ANewline = "<br/>"++-- | Render an document to a string suitable for inclusion in HTML.+-- The HTML should use a monospaced font for the code.+render :: forall ann . (ann -> Text -> Text) -> POut Int ann -> Text+render renderAnnotation out = render' out+  where render' :: POut Int ann -> Text+        render' pout = case pout of+          PNull -> T.pack ""+          PAtom a -> renderAtom a+          PSeq o1 o2 -> render' o1 `T.append` render' o2+          PAnn a o -> renderAnnotation a $ render' o
+ Text/PrettyPrint/Final/Rendering/PlainText.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}++{-|+Module      : Text.PrettyPrint.Final.Rendering.PlainText+Description : Plain-text output from final pretty printers+Copyright   : (c) David Darais, David Christiansen, and Weixi Ma 2016-2017+License     : MIT+Maintainer  : david.darais@gmail.com+Stability   : experimental+Portability : Portable++This is the simplest renderer for a pretty printer: plain text, with+no formatting and fixed-width fonts.+-}++module Text.PrettyPrint.Final.Rendering.PlainText (hPutDoc, saveDoc, tempDoc) where++import Control.Monad+import Control.Applicative+import Control.Monad.Catch(MonadMask)+import Control.Monad.Reader+import Control.Monad.Writer+import Control.Monad.State+import Control.Monad.RWS+import Data.List+import Data.String (IsString(..))+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.IO as TIO+import System.IO+import System.IO.Temp++import Text.PrettyPrint.Final++hRenderChunk :: MonadIO m => Handle -> Chunk Int -> m ()+hRenderChunk h (CText t) = liftIO $ TIO.hPutStr h t+hRenderChunk h (CSpace w) = replicateM_ w (liftIO $ TIO.hPutStr h " ")++hRenderAtom :: MonadIO m => Handle -> Atom Int -> m ()+hRenderAtom h (AChunk c) = hRenderChunk h c+hRenderAtom h ANewline = liftIO $ TIO.hPutStr h "\n"++-- | Send pretty printer output to a 'Handle'+hPutDoc :: MonadIO m => Handle -> POut Int ann -> m ()+hPutDoc h out = render' out+  where+        render' pout = case pout of+          PNull      -> return ()+          PAtom a    -> hRenderAtom h a+          PSeq o1 o2 -> render' o1 >> render' o2+          PAnn a o   -> render' o++-- | Save pretty printer output to a named file+saveDoc :: MonadIO m => FilePath -> IOMode -> POut Int ann -> m ()+saveDoc f mode out = liftIO $ withFile f mode (flip hPutDoc out)++-- | Save pretty printer output to temporary file. Useful for performance tests.+tempDoc :: (MonadIO m, MonadMask m) => POut Int ann -> m ()+tempDoc out = withSystemTempFile "pretty.txt" (\_ h -> hPutDoc h out)
+ Text/PrettyPrint/Final/Words.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}++{-|+Module      : Text.PrettyPrint.Final.Words+Description : Convenient helpers for pretty printing+Copyright   : (c) David Darais, David Christiansen, and Weixi Ma 2016-2017+License     : MIT+Maintainer  : david.darais@gmail.com+Stability   : experimental+Portability : Portable++This module contains atomic pretty printer documents, for your convenience.+-}+module Text.PrettyPrint.Final.Words+  ( -- * Atomic documents+    equals+  , colon+  , comma+    -- * Wrappers+  , parens+  , braces+  ) where++import Control.Monad+import Control.Applicative+import Control.Monad.Reader+import Control.Monad.Writer+import Control.Monad.State+import Control.Monad.RWS+import Data.List+import Data.Text (Text)+import qualified Data.Text as T++import Text.PrettyPrint.Final++-- | The equals sign+equals :: (MonadPretty w ann fmt m) => m ()+equals = char '='++-- | Wrap a document in parentheses+parens :: (MonadPretty w ann fmt m) => m () -> m ()+parens x = char '(' >> x >> char ')'++-- | Wrap a document in braces+braces :: (MonadPretty w ann fmt m) => m () -> m ()+braces x = char '{' >> x >> char '}'++-- | A single colon+colon :: (MonadPretty w ann fmt m) => m ()+colon = char ':'++-- | A single comma+comma :: (MonadPretty w ann fmt m) => m ()+comma = char ','++
+ final-pretty-printer.cabal view
@@ -0,0 +1,64 @@+name:                final-pretty-printer+version:             0.1.0.0+synopsis:            Extensible pretty printing with semantic annotations and proportional fonts++description:         This is the Final Pretty Printer, an extensible+                     prettry printing library that supports semantic+                     annotations and proportional-width fonts.++                     The library is extensible because it uses a+                     final, rather than initial, encoding of pretty+                     printer documents - they are monadic programs,+                     rather than a datatype.  This means it can be+                     extended by monad transformers.+                     Semantic annotations allow pretty printer+                     documents to contain references to the data that+                     they represent, which can enable interactive output.+                     Proportional-width fonts are supported by+                     allowing the measurement of widths to be+                     performed in some arbitrary monad, so IO can be+                     used to look at the output of a font rendering library.++license:             MIT+license-file:        LICENSE+author:              David Christiansen and David Darais and Weixi Ma+maintainer:          david@davidchristiansen.dk+copyright:           Copyright (c) 2016-2017 David Darais, David Christiansen, and Weixi Ma+category:            Text+build-type:          Simple+--extra-source-files:  ChangeLog.md+cabal-version:       >=1.10++source-repository head+  type:     git+  location: git://github.com/david-christiansen/final-pretty-printer.git++library+  default-language: Haskell2010+  exposed-modules:+                  Text.PrettyPrint.Final+                , Text.PrettyPrint.Final.Words+                , Text.PrettyPrint.Final.Extensions.Environment+                , Text.PrettyPrint.Final.Extensions.Precedence+                , Text.PrettyPrint.Final.Rendering.HTML+                , Text.PrettyPrint.Final.Rendering.Console+                , Text.PrettyPrint.Final.Rendering.PlainText+  other-modules:+                Text.PrettyPrint.Final.Demos.STLCDemo+              , Text.PrettyPrint.Final.Demos.ListDemo+  other-extensions:+                   KindSignatures+                 , MultiParamTypeClasses+                 , FunctionalDependencies+                 , ScopedTypeVariables+                 , DeriveFunctor+                 , FlexibleContexts+  build-depends:+                base >= 4.3 && < 4.10+              , mtl  >= 2.1 && < 2.3+              , text == 1.2.*+              , ansi-terminal == 0.6.*+              , containers == 0.5.*+              , temporary >= 1.1+              , exceptions == 0.8.*+  -- hs-source-dirs: