doclayout 0.1 → 0.2

raw patch · 4 files changed

+113/−38 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• changelog.md +15/−0
• doclayout.cabal +1/−1
• src/Text/DocLayout.hs +82/−35
• test/test.hs +15/−2

@@ -1,3 +1,18 @@ # doclayout +## 0.2++  * Add instances for `Doc`: `Data`, `Typeable`, `Ord`, `Read`, `Generic`.+  * Add `literal` (like `text`, but polymorphic).+  * Change some `IsString` constraints to `HasChars`.+  * Add some default definitions for methods in `HasChars`.+  * Change `offset` and `minOffset` to be more efficient (in+    simple cases they no longer render and count line lengths).+  * Add `updateColumn`.+  * Fix problem with `lblock`/`cblock`/`rblock` when `chop` is+    invoked. This caused very strange behavior in which text+    got reversed in certain circumstances.+ ## 0.1++  * Initial release.

@@ -1,5 +1,5 @@ name:                doclayout-version:             0.1+version:             0.2 synopsis:            A prettyprinting library for laying out text documents. description:         doclayout is a prettyprinting library for laying out                      text documents, with several features not present

@@ -2,9 +2,11 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP               #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DeriveGeneric     #-} {-# LANGUAGE DeriveFunctor     #-} {-# LANGUAGE DeriveFoldable    #-} {-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE DeriveDataTypeable #-} {- |    Module      : Text.DocLayout    Copyright   : Copyright (C) 2010-2019 John MacFarlane@@ -27,6 +29,7 @@      , blankline      , blanklines      , space+     , literal      , text      , char      , prefixed@@ -61,6 +64,7 @@      , isEmpty      , offset      , minOffset+     , updateColumn      , height      , charWidth      , realLength@@ -74,8 +78,10 @@ import Safe (lastMay, initSafe) import Control.Monad import Control.Monad.State.Strict+import GHC.Generics import Data.Char (isSpace) import Data.List (intersperse, foldl')+import Data.Data (Data, Typeable) import Data.String import qualified Data.Text as T import qualified Data.Text.Lazy as TL@@ -86,12 +92,20 @@ #endif  -- | Class abstracting over various string types that--- can fold over characters.+-- can fold over characters.  Minimal definition is 'foldrChar',+-- but defining the other methods can give better performance. class (IsString a, Semigroup a, Monoid a, Show a) => HasChars a where   foldrChar     :: (Char -> b -> b) -> b -> a -> b-  splitLines    :: a -> [a]   replicateChar :: Int -> Char -> a+  replicateChar n c = fromString (replicate n c)   isNull        :: a -> Bool+  isNull = foldrChar (\_ _ -> False) True+  splitLines    :: a -> [a]+  splitLines s = (fromString firstline : otherlines)+   where+    (firstline, otherlines) = foldrChar go ([],[]) s+    go '\n' (cur,lns) = ([], fromString cur : lns)+    go c    (cur,lns) = (c:cur, lns)  instance HasChars Text where   foldrChar         = T.foldr@@ -129,7 +143,8 @@          | BlankLines Int          -- ^ Ensure a number of blank lines.          | Concat (Doc a) (Doc a)  -- ^ Two documents concatenated.          | Empty-         deriving (Show, Eq, Functor, Foldable, Traversable)+         deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable,+                  Data, Typeable, Generic)  instance Semigroup (Doc a) where   x <> Empty = x@@ -140,7 +155,7 @@   mappend = (<>)   mempty = Empty -instance IsString a => IsString (Doc a) where+instance HasChars a => IsString (Doc a) where   fromString = text  -- | Unfold a 'Doc' into a flat list.@@ -354,18 +369,6 @@     (x:_) | isBlank x -> renderList xs           | otherwise -> renderDoc d >> renderList xs     []                -> renderList xs- where-   isBlank :: HasChars a => Doc a -> Bool-   isBlank BreakingSpace  = True-   isBlank CarriageReturn = True-   isBlank NewLine        = True-   isBlank (BlankLines _) = True-   isBlank (Text _ t)     = foldrChar-                                (\c _ -> if isSpace c then True else False)-                                False t-   isBlank _              = False-- renderList (BlankLines num : xs) = do   st <- get   case output st of@@ -429,6 +432,16 @@  renderList (x:_) = error $ "renderList encountered " ++ show x +isBlank :: HasChars a => Doc a -> Bool+isBlank BreakingSpace  = True+isBlank CarriageReturn = True+isBlank NewLine        = True+isBlank (BlankLines _) = True+isBlank (Text _ t)     = foldrChar+                             (\c _ -> if isSpace c then True else False)+                             False t+isBlank _              = False+ isBlock :: Doc a -> Bool isBlock Block{} = True isBlock VFill{} = True@@ -441,18 +454,22 @@ offsetOf BreakingSpace   = 1 offsetOf _               = 0 --- | A literal string.-text :: IsString a => String -> Doc a-text "" = mempty-text s = case break (=='\n') s of-           ("", "")   -> Empty-           (xs, "")   -> Text (realLength xs) (fromString xs)-           ("", _:ys) -> NewLine <> text ys-           (xs, _:ys) -> Text (realLength xs) (fromString xs) <>-                           NewLine <> text ys+-- | Create a 'Doc' from a stringlike value.+literal :: HasChars a => a -> Doc a+literal x =+  mconcat $+    intersperse NewLine $+      map (\s -> if isNull s+                    then Empty+                    else Text (realLength s) s) $+        splitLines x +-- | A literal string.  (Like 'literal', but restricted to String.)+text :: HasChars a => String -> Doc a+text = literal . fromString+ -- | A character.-char :: IsString a => Char -> Doc a+char :: HasChars a => Char -> Doc a char c = text $ fromString [c]  -- | A breaking (reflowable) space.@@ -515,13 +532,43 @@ afterBreak = AfterBreak  -- | Returns the width of a 'Doc'.-offset :: HasChars a => Doc a -> Int-offset d = maximum (0: map realLength (splitLines $ render Nothing d))+offset :: (IsString a, HasChars a) => Doc a -> Int+offset (Text n _) = n+offset (Block n _) = n+offset (VFill n _) = n+offset Empty = 0+offset CarriageReturn = 0+offset NewLine = 0+offset (BlankLines _) = 0+offset d = maximum (0 : map realLength (splitLines (render Nothing d)))  -- | Returns the minimal width of a 'Doc' when reflowed at breakable spaces. minOffset :: HasChars a => Doc a -> Int-minOffset d = maximum (0: map realLength (splitLines $ render (Just 0) d))+minOffset (Text n _) = n+minOffset (Block n _) = n+minOffset (VFill n _) = n+minOffset Empty = 0+minOffset CarriageReturn = 0+minOffset NewLine = 0+minOffset (BlankLines _) = 0+minOffset d = maximum (0 : map realLength (splitLines (render (Just 0) d))) +-- | Returns the column that would be occupied by the last+-- laid out character (assuming no wrapping).+updateColumn :: HasChars a => Doc a -> Int -> Int+updateColumn (Text n _) = (+ n)+updateColumn (Block n _) = (+ n)+updateColumn (VFill n _) = (+ n)+updateColumn Empty = const 0+updateColumn CarriageReturn = const 0+updateColumn NewLine = const 0+updateColumn (BlankLines _) = const 0+updateColumn d =+  case map realLength (splitLines (render Nothing d)) of+    []  -> id+    [n] -> (+ n)+    xs  -> const (last xs)+ -- | @lblock n d@ is a block of width @n@ characters, with -- text derived from @d@ and aligned to the left. lblock :: HasChars a => Int -> Doc a -> Doc a@@ -572,7 +619,7 @@                                | len' + clen > n ->                                    (clen, cs):(len', l'):rest                                | otherwise ->-                                   (len' + clen, l' <> cs):rest+                                   (len' + clen, cs <> l'):rest                              [] -> [(clen, cs)]) [] l  -- | Encloses a 'Doc' inside a start and end 'Doc'.@@ -581,23 +628,23 @@   start <> contents <> end  -- | Puts a 'Doc' in curly braces.-braces :: IsString a => Doc a -> Doc a+braces :: HasChars a => Doc a -> Doc a braces = inside (char '{') (char '}')  -- | Puts a 'Doc' in square brackets.-brackets :: IsString a => Doc a -> Doc a+brackets :: HasChars a => Doc a -> Doc a brackets = inside (char '[') (char ']')  -- | Puts a 'Doc' in parentheses.-parens :: IsString a => Doc a -> Doc a+parens :: HasChars a => Doc a -> Doc a parens = inside (char '(') (char ')')  -- | Wraps a 'Doc' in single quotes.-quotes :: IsString a => Doc a -> Doc a+quotes :: HasChars a => Doc a -> Doc a quotes = inside (char '\'') (char '\'')  -- | Wraps a 'Doc' in double quotes.-doubleQuotes :: IsString a => Doc a -> Doc a+doubleQuotes :: HasChars a => Doc a -> Doc a doubleQuotes = inside (char '"') (char '"')  -- | Returns width of a character in a monospace font:  0 for a combining

@@ -20,8 +20,21 @@  tests :: [TestTree] tests =-  [-    renderTest "simple vcat"+  [ testCase "offset prefixed" $+      (offset (nest 3 (text "**" <> text "thisIsGoingToBeTooLongAnyway" <>+                       text "**") <> blankline :: Doc Text) @?= 35)++  , renderTest "lblock with chop"+      Nothing+      (lblock 4 (text "hi there" :: Doc Text))+      "hi t\nhere"++  , renderTest "nesting should not wrap"+      (Just 10)+      (nest 3 (text "abcdefghi" :: Doc Text))+      "   abcdefghi"++  , renderTest "simple vcat"       (Just 10)       (vcat $ map chomp ["aaa", "bbb", "ccc"])       "aaa\nbbb\nccc"