FPretty (empty) → 1.0

raw patch · 4 files changed

+445/−0 lines, 4 filesdep +basedep +containerssetup-changed

Dependencies added: base, containers

Files

• FPretty.cabal +22/−0
• LICENSE +30/−0
• Setup.hs +2/−0
• Text/PrettyPrint/FPretty.hs +391/−0

@@ -0,0 +1,22 @@+name:                FPretty+version:             1.0+synopsis:            Efficient simple pretty printing combinators+description:         A pretty printer turns a tree structure into indented text,+                     such that the indentation reflects the tree structure. To keep+                     text short, substructures are put into a single line as far as+                     possible. The library provides combinators for building+                     pretty printers. It emphasizes simplicity and efficiency.+homepage:            http://www.cs.kent.ac.uk/~oc/pretty.html+license:             BSD3+license-file:        LICENSE+author:              Olaf Chitil+maintainer:          O.Chitil@kent.ac.uk+-- copyright:           +category:            Text.PrettyPrint+build-type:          Simple+cabal-version:       >=1.8++library+  exposed-modules:     Text.PrettyPrint.FPretty+  -- other-modules:       +  build-depends:       base >=4.5 && < 5, containers >= 0.4

@@ -0,0 +1,30 @@+Copyright (c) 2012, Olaf Chitil++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Olaf Chitil nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,391 @@+{-# LANGUAGE Safe #-}++-- | +-- Module      : Text.PrettyPrint.FPretty+-- License     : BSD3+-- Maintainer  : Olaf Chitil <O.Chitil@kent.ac.uk>+-- Portability : portable+--+-- Fast pretty-printing library+--+-- A pretty printer turns a tree structure into indented text, such that the+-- indentation reflects the tree structure. To minimise the number of lines,+-- substructures are put on a single line as far as possible within the given +-- line-width limit.+--+-- An pretty-printed example with 35 characters line-width:+--+-- > if True+-- >    then if True then True else True+-- >    else+-- >       if False +-- >          then False +-- >          else False+--+-- To obtain the above the user of a library only has to convert their tree +-- structure into a document of type 'Doc'.+--+-- > data Exp = ETrue | EFalse | If Exp Exp Exp+-- >+-- > toDoc :: Exp -> Doc+-- > toDoc ETrue = text "True"+-- > toDoc EFalse = text "False"+-- > toDoc (If e1 e2 e3) =+-- >   group (nest 3 (+-- >     group (nest 3 (text "if" <> line <> toDoc e1)) <> line <>+-- >     group (nest 3 (text "then" <> line <> toDoc e2)) <> line <>+-- >     group (nest 3 (text "else" <> line <> toDoc e3))))+--+-- A document represents a set of layouts. The function 'pretty' then takes+-- a desired maximal printing width and a document and selects the layout that fits+-- best.+--+-- Another example filling lines with elements of a list:+--+-- > list2Doc :: Show a => [a] -> Doc+-- > list2Doc xs = text "[" <> go xs <> text "]"+-- >   where+-- >   go [] = empty+-- >   go [x] = text (show x)+-- >   go (x:y:ys) = text (show x) </> text ", " <> go (y:ys)+-- >+-- > main = putStrLn (pretty 40 (list2Doc [1..20]))+--+-- The output is+--+-- > [1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9 , 10+-- > , 11 , 12 , 13 , 14 , 15 , 16 , 17 , 18+-- > , 19 , 20]+--+-- FPretty is an implementation of the simple combinators designed by Phil Wadler.+-- The library uses a single associative combinator '<>' to concatenate documents with+-- 'empty' as identity. There is a primitive document for potential line breaks, i.e.,+-- its two layouts are both a line break and a space. The 'group' combinator then+-- enforces that all potential line breaks within a document must be layouted in the+-- same way, i.e. either line breaks or spaces.+--+-- The time complexity is linear in the output size.+-- In contrast, all other pretty printing libraries+-- (original Phil Wadler, PPrint by Leijen, Hughes / Peyton Jones) +-- use more or less backtracking, and their speed depends unpredictably on the +-- desired output width.+--+-- Also FPretty provides both relative and absolute indentation via+-- nest and align, whereas HughesPJ provides only relative indentation.+--+-- Unlike other libraries, FPretty does not provide several rendering modes,+-- but could be extended to do so.+--+-- The combinators are a subset of those of PPrint and are similar to HughesPJ+-- to make moving from one library to the other as painless as possible.+-- +-- For more implementation notes see <http://www.cs.kent.ac.uk/~oc/pretty.html> or+-- Doitse Swierstra and Olaf Chitil: Linear, bounded, functional pretty-printing.+-- Journal of Functional Programming, 19(1):1-16, January 2009.++-- The implementation could be speeded up further by specialisation of the interpreter+-- for dequeues of size 0, 1 and >1.++module Text.PrettyPrint.FPretty +  (+  -- * The type of documents+   Doc+  -- * Pretty printing+  ,pretty+  -- * Basic documents+  ,empty,text+  -- * Basic documents with several layouts+  ,line,linebreak,softline,softbreak+  -- * Combining two documents+  -- ** The base binary combinator+  ,(<>)+  -- ** Derived binary combinators+  ,(<+>),(<$>),(<$$>),(</>),(<//>)+  -- * Modifying the layouts of one document+  ,group,nest,align,hang+  -- * Combining many documents+  ,hsep,vsep,fillSep,sep,hcat,vcat,fillCat,cat) where++import Data.Sequence as Dequeue (Seq, (<|), viewl, viewr, ViewL(..), ViewR(..))+import qualified Data.Sequence as Dequeue (empty)+  -- Originally used Banker's dequeue from Okasaki's book +  -- on Functional Data Structures.+  -- Efficiency probably similar, but Data.Sequence is part of the standard Haskell +  -- libraries.++infixr 6 <>,<+>+infixr 5 <$>,<$$>,</>,<//>++----------------------+-- derived combinators++-- | A space, if the following still fits on the current line, otherwise newline.+softline :: Doc+softline = group line++-- | Nothing, if the following still fits on the current line, otherwise newline.+softbreak :: Doc+softbreak = group linebreak++-- | Increase identation relative to the *current* column.+hang :: Int -> Doc -> Doc+hang i x = align (nest i x)++-- | Combine with a space in between.+(<+>) :: Doc -> Doc -> Doc+dl <+> dr = dl <> text " " <> dr++-- | Combine with a 'line' in between.+(<$>) :: Doc -> Doc -> Doc+dl <$> dr = dl <> line <> dr++-- | Combine with a 'linebreak' in between.+(<$$>) :: Doc -> Doc -> Doc+dl <$$> dr = dl <> linebreak <> dr++-- | Combine with a 'softline' in between.+(</>) :: Doc -> Doc -> Doc+dl </> dr = dl <> softline <> dr++-- | Combine with a 'softbreak' in between.+(<//>) :: Doc -> Doc -> Doc+dl <//> dr = dl <> softbreak <> dr++-- ** Combining lists of documents+-- These combinators all assume a non-empty list of documents+-- and they do not start a new line at the end (unlike PPrint).++-- | Combine non-empty list of documents with '<+>', i.e., a space separator.+hsep :: [Doc] -> Doc+hsep = foldr1 (<+>)  -- differs from PPrint++-- | Combine non-empty list of documents with '<$>', i.e., a 'line' separator.+vsep :: [Doc] -> Doc+vsep = foldr1 (<$>)  -- differs from PPrint++-- | Combine non-empty list of documents with '</>', i.e., a 'softline' separator.+fillSep :: [Doc] -> Doc+fillSep = foldr1 (</>)  -- differs from PPrint++-- | Combine non-empty list of documents vertically as a group.+-- Seperated by space instead if all fit on one line.+sep :: [Doc] -> Doc+sep xs = group (vsep xs)  -- differs from PPrint++-- | Combine non-empty list of documents with '<>'.+hcat :: [Doc] -> Doc+hcat = foldr1 (<>)  -- differs from PPrint++-- | Combine non-empty list of documents with '<$$>', i.e., a 'linebreak' separator.+vcat :: [Doc] -> Doc+vcat = foldr1 (<$$>)  -- differs from PPrint++-- | Combine non-empty list of documents with '<//>', i.e., a 'softbreak' separator.+fillCat :: [Doc] -> Doc+fillCat = foldr1 (<//>)   -- differs from PPrint++-- | Combine non-empty list of documents, filling lines as far as possible.+cat :: [Doc] -> Doc+cat xs = group (vcat xs)  -- differs from PPrint++-------------------+-- basic combinators++-- | The empty document; equal to text \"\".+empty :: Doc++-- | Atomic document consisting of just the given text.+-- There should be no newline \\n in the string.+text :: String -> Doc++-- | Either a space or a new line.+line :: Doc++-- | Either nothing ('empty') or a new line.+linebreak :: Doc++-- | Horizontal composition of two documents. +-- Is associative with identity 'empty'.+(<>) :: Doc -> Doc -> Doc++-- | Mark document as group, that is, layout as a single line if possible.+-- Within a group for all basic documents with several layouts the same layout+-- is chosen, that is, they are all horizontal or all new lines.+-- Within a vertical group there can be a horizontal group, but within a +-- horizontal group all groups are also layouted horizontally.+group :: Doc -> Doc++-- | Increases current indentation level (absolute). Assumes argument >= 0.+nest :: Int -> Doc -> Doc++-- | Set indentation to current column.+align :: Doc -> Doc++-- | Pretty print within given width.+-- Selects from the *set* of layouts that the document represents the widest+-- that fits within the given width.+-- If no such layout exists, then it will choose the narrowest that exceeds the given+-- width.+pretty :: Int -> Doc -> String++-- | A Document represents a *set* of layouts.+data Doc = Text Int String  -- includes length of text string+         | Nil+         | Line Int String  -- includes length of optional text+         | Doc :<> Doc+         | Group Doc+         | Nest Int Doc     -- increase current indentation+         | Align Int Doc    -- set indentation to current column plus increment++empty = Nil+text t = Text (length t) t+line = Line 1 " "+linebreak = Line 0 ""+(<>) = (:<>)+group = Group+nest = Nest+align = Align 0+pretty w d = interpret (normalise d) w (\p dq r i -> "") 0 Dequeue.empty w 0+++-- semantic-preserving transformation that ensures that between every end+-- of group and a subsequent line there is no text+normalise :: Doc -> Doc+normalise d = td :<> sd+  where+  (td,sd) = go d Nil+  -- Assume second argument only built from text,nil and <>.+  -- Ensures first component of result built only from text,nil and <>.+  -- go d tt = (td,sd) implies  d <> tt and td <> sd denote the same set of +  -- layouts.+  go :: Doc -> Doc -> (Doc,Doc)+  go Nil tt = (tt,Nil)+  go (Text l t) tt = (Text l t :<> tt,Nil)+  go (Line l t) tt = (Nil,Line l t :<> tt)+  go (dl :<> dr) tt = let (tdl,sdl) = go dl tdr+                          (tdr,sdr) = go dr tt+                      in  (tdl,sdl :<> sdr)+  go (Group d) tt = let (td,sd) = go d tt in (td,Group sd)+  go (Nest i d) tt = let (td,sd) = go d tt in (td,Nest i sd)+  go (Align i d) tt = let (td,sd) = go d tt in (td,Align (i - docLength td) sd)++-- Determine length of a document consisting only of text,nil and <>.+-- To ensure linear complexity for align should actually keep track+-- of document length within go function itself.+docLength :: Doc -> Int+docLength Nil = 0+docLength (Text l _) = l+docLength (dl :<> dr) = docLength dl + docLength dr++type Width = Int+type Position =  Int+type Indentation = Int +type Horizontal = Bool+type Remaining =  Int+type Out = Remaining -> Indentation -> String  +     -- indentation needed here because of align combinator+type OutGroup = Horizontal -> Out -> Out+type TreeCont = Position -> Dequeue.Seq (Position,OutGroup) -> Out+++interpret :: Doc -> Width -> TreeCont -> TreeCont+interpret Nil w tc p ds = tc p ds+interpret (Text l t) w tc p ds =+  extendFrontGroup id prune outText tc (p+l) ds+  where+  outText :: OutGroup+  outText h c r i = t ++ c (r-l) i+interpret (Line l t) w tc p ds =+  extendFrontGroup id prune outLine tc (p+l) ds+  where+  outLine :: OutGroup+  outLine h c r i = if h then t ++ c (r-l) i+                         else '\n' : replicate i ' ' ++ c (w-i) i+interpret (dl :<> dr) w tc p ds =+  interpret dl w (interpret dr w tc) p ds+interpret (Group d) w tc p ds = +  interpret d w (leaveGroup tc) p ((p,\h c -> c) <| ds)+interpret (Nest j d) w tc p ds =+  extendFrontGroup (interpret d w) (interpret d w) outNest tc p ds+  where+  outNest :: OutGroup+  outNest h c r i = c r (i+j)+interpret (Align j d) w tc p ds = +  extendFrontGroup (interpret d w) (interpret d w) outAlign tc p ds+  where+  outAlign :: OutGroup+  outAlign h c r i = c r (w-r+j)+++-- If no pending groups, then do out directly,+-- otherwise add out to pending group, applying given prune function.+-- This extracts an otherwise repeated pattern of the interpret function.+extendFrontGroup :: (TreeCont -> TreeCont) -> (TreeCont -> TreeCont) -> +                    OutGroup -> TreeCont -> TreeCont+extendFrontGroup cont1 cont2 out tc p ds =+  case viewl ds of+    EmptyL -> out False (cont1 tc p ds)+    (s,outGrp) :< ds' -> +      cont2 tc p ((s,\h c -> outGrp h (out h c)) <| ds')+++leaveGroup :: TreeCont -> TreeCont+leaveGroup tc p ds = +  case viewl ds of+    EmptyL -> tc p ds+    (s1,outGrp1) :< ds1 -> +      case viewl ds1 of+        EmptyL -> outGrp1 True (tc p Dequeue.empty)+        (s2,outGrp2) :< ds2 ->+          tc p ((s2, \f c -> outGrp2 f (\r1 -> outGrp1 (p <= s2+r1) c r1)) <| ds2)+++prune :: TreeCont -> TreeCont+prune tc p ds = +  case viewr ds of+    EmptyR -> tc p ds+    ds' :> (s,outGrp) -> \r -> if p > s+r +                                 then outGrp False (prune tc p ds') r+                                 else tc p ds r+++-- -------------------------------------------+-- Properties for testing. All should be True.++prop0 = pretty 6 (group (text "Hi" <> line <> text "you") <> text "!") ==+        "Hi\nyou!"+prop1 = pretty 4 (group (text "hi" <> line <> text "world")) ==+        "hi\nworld"+prop2 = +  pretty 8 (group (text "hi" <> line <> text "world") <> text "liness") ==+  "hi\nworldliness"+prop3 = +  take 6 (pretty 4 (group (text "hi" <> line <> text "you" <> undefined))) ==+  "hi\nyou"+prop4 = +  take 6 (pretty 4 (group (text "hi" <> line) <>+           group (text "you" <> line) <> undefined)) ==+  "hi\nyou"+prop5 = +  take 6 (pretty 4 (group (text "hi" <> +           group (line <> text "you" <> undefined)))) ==+  "hi\nyou"+prop6 = +  take 7 (pretty 3 (group (text "hi" <> line <> +           group (line <> text "you" <> undefined)))) ==+  "hi\n\nyou"+prop7 = +  pretty 10 (group (text "what" <>+    align (group (text "do" <> line <> text "you" <> line <> +      text "do" <> align (line <> text "now?"))))) ==+  "whatdo\n    you\n    do\n      now?"++prop8 = +  pretty 10 (group (text "one " <> (align (line <> text "two" <> +    align (line <> text "three"))))) ==+  "one \n    two\n       three"++prop9 =+  pretty 10 (group (text "one " <> (nest 2 (line <> text "two" <>+    nest 3 (line <> text "three"))))) ==+  "one \n  two\n     three"