boxes-0.1.5/0000755000000000000000000000000013251041657011027 5ustar0000000000000000boxes-0.1.5/Setup.lhs0000644000000000000000000000011413251041657012633 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain boxes-0.1.5/boxes.cabal0000644000000000000000000000224713251041657013140 0ustar0000000000000000name: boxes version: 0.1.5 synopsis: 2D text pretty-printing library description: A pretty-printing library for laying out text in two dimensions, using a simple box model. category: Text license: BSD3 license-file: LICENSE extra-source-files: CHANGES, README.md, include/boxes.h author: Brent Yorgey maintainer: David Feuer build-type: Simple cabal-version: >= 1.9.2 -- Minimum Cabal version supporting test suites library build-depends: base >= 3 && < 5, split >=0.2 && <0.3 exposed-modules: Text.PrettyPrint.Boxes extensions: CPP include-dirs: include Test-Suite test-boxes type: exitcode-stdio-1.0 main-is: Text/PrettyPrint/Tests.hs build-depends: base >= 3 && < 5, split >=0.2 && <0.3, QuickCheck extensions: CPP include-dirs: include cpp-options: -DTESTING other-modules: Text.PrettyPrint.Boxes -- Export some internals so the tests can get at them source-repository head type: git location: https://github.com/treeowl/boxes.git boxes-0.1.5/LICENSE0000644000000000000000000000267013251041657012041 0ustar0000000000000000Copyright (c) Brent Yorgey 2008 Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. 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. 3. Neither the name of the author nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. All other rights are reserved. THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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. boxes-0.1.5/README.md0000644000000000000000000000030113251041657012300 0ustar0000000000000000# boxes A pretty-printing library for laying out text in two dimensions, using a simple box model. Hackage: https://hackage.haskell.org/package/boxes GitHub: https://github.com/treeowl/boxes boxes-0.1.5/CHANGES0000644000000000000000000000127413251041657012026 0ustar00000000000000000.1.5: March 10, 2018 * Add support for GHC 8.4.1. Thanks, Andrés Sicard-Ramírez. * Clean up QuickCheck generators, and prevent them from blowing up. Thanks, Harry Garrood. * Generalize functions for combining multiple boxes from lists to `Foldable` containers. 0.1.4: January 14, 2015 * Require Cabal >= 1.9.2 * Require CPP * Only require OverloadedStrings for GHC * Fix imports to work with 7.10.1 * Fix other imports to work with versions as far back as 7.0.1, but only because it was easy this time * Add testing framework skeletons for Cabal and Travis-CI. 0.1.2: August 23, 2011 * Export rows/cols. 0.1.1: August 22, 2009 * Export Box and Alignment types boxes-0.1.5/include/0000755000000000000000000000000013251041657012452 5ustar0000000000000000boxes-0.1.5/include/boxes.h0000644000000000000000000000336013251041657013745 0ustar0000000000000000/* * Common macros for boxes */ #ifndef HASKELL_BOXES_H #define HASKELL_BOXES_H #ifdef __GLASGOW_HASKELL__ #define OVERLOADED_STRINGS 1 #endif /* * We use cabal-generated MIN_VERSION_base to adapt to changes of base. * Nevertheless, as a convenience, we also allow compiling without cabal by * defining an approximate MIN_VERSION_base if needed. The alternative version * guesses the version of base using the version of GHC. This is usually * sufficiently accurate. However, it completely ignores minor version numbers, * and it makes the assumption that a pre-release version of GHC will ship with * base libraries with the same version numbers as the final release. This * assumption is violated in certain stages of GHC development, but in practice * this should very rarely matter, and will not affect any released version. */ #ifndef MIN_VERSION_base #if __GLASGOW_HASKELL__ >= 709 #define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=8))) #elif __GLASGOW_HASKELL__ >= 707 #define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=7))) #elif __GLASGOW_HASKELL__ >= 705 #define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=6))) #elif __GLASGOW_HASKELL__ >= 703 #define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=5))) #elif __GLASGOW_HASKELL__ >= 701 #define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=4))) #elif __GLASGOW_HASKELL__ >= 700 #define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=3))) #else #define MIN_VERSION_base(major1,major2,minor) (0) #endif #endif /* ifndef MIN_VERSION_base */ #endif /* ifndef HASKELL_BOXES_H */ boxes-0.1.5/Text/0000755000000000000000000000000013251041657011753 5ustar0000000000000000boxes-0.1.5/Text/PrettyPrint/0000755000000000000000000000000013251041657014257 5ustar0000000000000000boxes-0.1.5/Text/PrettyPrint/Boxes.hs0000644000000000000000000003337713251041657015710 0ustar0000000000000000{-# LANGUAGE CPP #-} #include "boxes.h" ----------------------------------------------------------------------------- -- | -- Module : Text.PrettyPrint.Boxes -- Copyright : (c) Brent Yorgey 2009 -- License : BSD-style (see LICENSE) -- Maintainer : David.Feuer@gmail.com -- Stability : experimental -- Portability : portable -- -- A pretty-printing library for laying out text in two dimensions, -- using a simple box model. -- ----------------------------------------------------------------------------- module Text.PrettyPrint.Boxes ( -- * Constructing boxes #ifdef TESTING Box(Box, content) #else Box #endif , nullBox , emptyBox , char , text , para , columns -- * Layout of boxes , (<>) , (<+>) , hcat , hsep , (//) , (/+/) , vcat , vsep , punctuateH, punctuateV -- * Alignment #ifdef TESTING , Alignment(..) #else , Alignment #endif #ifdef TESTING , Content(..) #endif , left, right , top, bottom , center1, center2 , moveLeft , moveRight , moveUp , moveDown , alignHoriz , alignVert , align -- * Inspecting boxes , rows , cols -- * Rendering boxes , render , printBox ) where #if MIN_VERSION_base(4,11,0) import Prelude hiding ( (<>), Word ) #elif MIN_VERSION_base(4,8,0) import Prelude hiding (Word) #else import Data.Foldable (Foldable (foldr)) import Prelude hiding (foldr) #endif import Data.Foldable (toList) #if MIN_VERSION_base(4,4,0) import Data.String (words, unwords) #else import Data.List (words, unwords) #endif #ifdef OVERLOADED_STRINGS import Data.String (IsString(..)) #endif import Control.Arrow ((***), first) import Data.List (foldl', intersperse) import Data.List.Split (chunksOf) -- | The basic data type. A box has a specified size and some sort of -- contents. data Box = Box { rows :: Int , cols :: Int , content :: Content } deriving (Show) #ifdef OVERLOADED_STRINGS -- | Convenient ability to use bare string literals as boxes. instance IsString Box where fromString = text #endif -- | Data type for specifying the alignment of boxes. data Alignment = AlignFirst -- ^ Align at the top/left. | AlignCenter1 -- ^ Centered, biased to the top/left. | AlignCenter2 -- ^ Centered, biased to the bottom/right. | AlignLast -- ^ Align at the bottom/right. deriving (Eq, Read, Show) -- | Align boxes along their tops. top :: Alignment top = AlignFirst -- | Align boxes along their bottoms. bottom :: Alignment bottom = AlignLast -- | Align boxes to the left. left :: Alignment left = AlignFirst -- | Align boxes to the right. right :: Alignment right = AlignLast -- | Align boxes centered, but biased to the left/top in case of -- unequal parities. center1 :: Alignment center1 = AlignCenter1 -- | Align boxes centered, but biased to the right/bottom in case of -- unequal parities. center2 :: Alignment center2 = AlignCenter2 -- | Contents of a box. data Content = Blank -- ^ No content. | Text String -- ^ A raw string. | Row [Box] -- ^ A row of sub-boxes. | Col [Box] -- ^ A column of sub-boxes. | SubBox Alignment Alignment Box -- ^ A sub-box with a specified alignment. deriving (Show) -- | The null box, which has no content and no size. It is quite -- useless. nullBox :: Box nullBox = emptyBox 0 0 -- | @emptyBox r c@ is an empty box with @r@ rows and @c@ columns. -- Useful for effecting more fine-grained positioning of other -- boxes, by inserting empty boxes of the desired size in between -- them. emptyBox :: Int -> Int -> Box emptyBox r c = Box r c Blank -- | A @1x1@ box containing a single character. char :: Char -> Box char c = Box 1 1 (Text [c]) -- | A (@1 x len@) box containing a string of length @len@. text :: String -> Box text t = Box 1 (length t) (Text t) -- | Paste two boxes together horizontally, using a default (top) -- alignment. (<>) :: Box -> Box -> Box l <> r = hcat top [l,r] -- | Paste two boxes together horizontally with a single intervening -- column of space, using a default (top) alignment. (<+>) :: Box -> Box -> Box l <+> r = hcat top [l, emptyBox 0 1, r] -- | Paste two boxes together vertically, using a default (left) -- alignment. (//) :: Box -> Box -> Box t // b = vcat left [t,b] -- | Paste two boxes together vertically with a single intervening row -- of space, using a default (left) alignment. (/+/) :: Box -> Box -> Box t /+/ b = vcat left [t, emptyBox 1 0, b] -- | Glue a list of boxes together horizontally, with the given alignment. hcat :: Foldable f => Alignment -> f Box -> Box hcat a bs = Box h w (Row $ map (alignVert a h) bsl) where (w, h) = sumMax cols 0 rows bsl bsl = toList bs -- | @hsep sep a bs@ lays out @bs@ horizontally with alignment @a@, -- with @sep@ amount of space in between each. hsep :: Foldable f => Int -> Alignment -> f Box -> Box hsep sep a bs = punctuateH a (emptyBox 0 sep) bs -- | Glue a list of boxes together vertically, with the given alignment. vcat :: Foldable f => Alignment -> f Box -> Box vcat a bs = Box h w (Col $ map (alignHoriz a w) bsl) where (h, w) = sumMax rows 0 cols bsl bsl = toList bs -- Calculate a sum and a maximum over a list in one pass. If the list is -- empty, the maximum is reported as the given default. This would -- normally be done using the foldl library, but we don't want that -- dependency. sumMax :: (Num n, Ord b, Foldable f) => (a -> n) -> b -> (a -> b) -> f a -> (n, b) sumMax f defaultMax g as = foldr go (,) as 0 defaultMax where go a r n b = (r $! f a + n) $! g a `max` b -- | @vsep sep a bs@ lays out @bs@ vertically with alignment @a@, -- with @sep@ amount of space in between each. vsep :: Foldable f => Int -> Alignment -> f Box -> Box vsep sep a bs = punctuateV a (emptyBox sep 0) (toList bs) -- | @punctuateH a p bs@ horizontally lays out the boxes @bs@ with a -- copy of @p@ interspersed between each. punctuateH :: Foldable f => Alignment -> Box -> f Box -> Box punctuateH a p bs = hcat a (intersperse p (toList bs)) -- | A vertical version of 'punctuateH'. punctuateV :: Foldable f => Alignment -> Box -> f Box -> Box punctuateV a p bs = vcat a (intersperse p (toList bs)) -------------------------------------------------------------------------------- -- Paragraph flowing --------------------------------------------------------- -------------------------------------------------------------------------------- -- | @para algn w t@ is a box of width @w@, containing text @t@, -- aligned according to @algn@, flowed to fit within the given -- width. para :: Alignment -> Int -> String -> Box para a n t = (\ss -> mkParaBox a (length ss) ss) $ flow n t -- | @columns w h t@ is a list of boxes, each of width @w@ and height -- at most @h@, containing text @t@ flowed into as many columns as -- necessary. columns :: Alignment -> Int -> Int -> String -> [Box] columns a w h t = map (mkParaBox a h) . chunksOf h $ flow w t -- | @mkParaBox a n s@ makes a box of height @n@ with the text @s@ -- aligned according to @a@. mkParaBox :: Alignment -> Int -> [String] -> Box mkParaBox a n = alignVert top n . vcat a . map text -- | Flow the given text into the given width. flow :: Int -> String -> [String] flow n t = map (take n) . getLines $ foldl' addWordP (emptyPara n) (map mkWord . words $ t) data Para = Para { paraWidth :: Int , paraContent :: ParaContent } data ParaContent = Block { fullLines :: [Line] , lastLine :: Line } emptyPara :: Int -> Para emptyPara pw = Para pw (Block [] (Line 0 [])) getLines :: Para -> [String] getLines (Para _ (Block ls l)) | lLen l == 0 = process ls | otherwise = process (l:ls) where process = map (unwords . reverse . map getWord . getWords) . reverse data Line = Line { lLen :: Int, getWords :: [Word] } mkLine :: [Word] -> Line mkLine ws = Line (sum (map ((+1) . wLen) ws) - 1) ws startLine :: Word -> Line startLine = mkLine . (:[]) data Word = Word { wLen :: Int, getWord :: String } mkWord :: String -> Word mkWord w = Word (length w) w addWordP :: Para -> Word -> Para addWordP (Para pw (Block fl l)) w | wordFits pw w l = Para pw (Block fl (addWordL w l)) | otherwise = Para pw (Block (l:fl) (startLine w)) addWordL :: Word -> Line -> Line addWordL w (Line len ws) = Line (len + wLen w + 1) (w:ws) wordFits :: Int -> Word -> Line -> Bool wordFits pw w l = lLen l == 0 || lLen l + wLen w + 1 <= pw -------------------------------------------------------------------------------- -- Alignment ----------------------------------------------------------------- -------------------------------------------------------------------------------- -- | @alignHoriz algn n bx@ creates a box of width @n@, with the -- contents and height of @bx@, horizontally aligned according to -- @algn@. alignHoriz :: Alignment -> Int -> Box -> Box alignHoriz a c b = align a AlignFirst (rows b) c b -- | @alignVert algn n bx@ creates a box of height @n@, with the -- contents and width of @bx@, vertically aligned according to -- @algn@. alignVert :: Alignment -> Int -> Box -> Box alignVert a r b = align AlignFirst a r (cols b) b -- | @align ah av r c bx@ creates an @r@ x @c@ box with the contents -- of @bx@, aligned horizontally according to @ah@ and vertically -- according to @av@. align :: Alignment -> Alignment -> Int -> Int -> Box -> Box align ah av r c = Box r c . SubBox ah av -- | Move a box \"up\" by putting it in a larger box with extra rows, -- aligned to the top. See the disclaimer for 'moveLeft'. moveUp :: Int -> Box -> Box moveUp n b = alignVert top (rows b + n) b -- | Move a box down by putting it in a larger box with extra rows, -- aligned to the bottom. See the disclaimer for 'moveLeft'. moveDown :: Int -> Box -> Box moveDown n b = alignVert bottom (rows b + n) b -- | Move a box left by putting it in a larger box with extra columns, -- aligned left. Note that the name of this function is -- something of a white lie, as this will only result in the box -- being moved left by the specified amount if it is already in a -- larger right-aligned context. moveLeft :: Int -> Box -> Box moveLeft n b = alignHoriz left (cols b + n) b -- | Move a box right by putting it in a larger box with extra -- columns, aligned right. See the disclaimer for 'moveLeft'. moveRight :: Int -> Box -> Box moveRight n b = alignHoriz right (cols b + n) b -------------------------------------------------------------------------------- -- Implementation ------------------------------------------------------------ -------------------------------------------------------------------------------- -- | Render a 'Box' as a String, suitable for writing to the screen or -- a file. render :: Box -> String render = unlines . renderBox -- XXX make QC properties for takeP -- | \"Padded take\": @takeP a n xs@ is the same as @take n xs@, if @n -- <= length xs@; otherwise it is @xs@ followed by enough copies of -- @a@ to make the length equal to @n@. takeP :: a -> Int -> [a] -> [a] takeP _ n _ | n <= 0 = [] takeP b n [] = replicate n b takeP b n (x:xs) = x : takeP b (n-1) xs -- | @takePA @ is like 'takeP', but with alignment. That is, we -- imagine a copy of @xs@ extended infinitely on both sides with -- copies of @a@, and a window of size @n@ placed so that @xs@ has -- the specified alignment within the window; @takePA algn a n xs@ -- returns the contents of this window. takePA :: Alignment -> a -> Int -> [a] -> [a] takePA c b n = glue . (takeP b (numRev c n) *** takeP b (numFwd c n)) . split where split t = first reverse . splitAt (numRev c (length t)) $ t glue = uncurry (++) . first reverse numFwd AlignFirst n = n numFwd AlignLast _ = 0 numFwd AlignCenter1 n = n `div` 2 numFwd AlignCenter2 n = (n+1) `div` 2 numRev AlignFirst _ = 0 numRev AlignLast n = n numRev AlignCenter1 n = (n+1) `div` 2 numRev AlignCenter2 n = n `div` 2 -- | Generate a string of spaces. blanks :: Int -> String blanks = flip replicate ' ' -- | Render a box as a list of lines. renderBox :: Box -> [String] renderBox (Box r c Blank) = resizeBox r c [""] renderBox (Box r c (Text t)) = resizeBox r c [t] renderBox (Box r c (Row bs)) = resizeBox r c . merge . map (renderBoxWithRows r) $ bs where merge = foldr (zipWith (++)) (repeat []) renderBox (Box r c (Col bs)) = resizeBox r c . concatMap (renderBoxWithCols c) $ bs renderBox (Box r c (SubBox ha va b)) = resizeBoxAligned r c ha va . renderBox $ b -- | Render a box as a list of lines, using a given number of rows. renderBoxWithRows :: Int -> Box -> [String] renderBoxWithRows r b = renderBox (b{rows = r}) -- | Render a box as a list of lines, using a given number of columns. renderBoxWithCols :: Int -> Box -> [String] renderBoxWithCols c b = renderBox (b{cols = c}) -- | Resize a rendered list of lines. resizeBox :: Int -> Int -> [String] -> [String] resizeBox r c = takeP (blanks c) r . map (takeP ' ' c) -- | Resize a rendered list of lines, using given alignments. resizeBoxAligned :: Int -> Int -> Alignment -> Alignment -> [String] -> [String] resizeBoxAligned r c ha va = takePA va (blanks c) r . map (takePA ha ' ' c) -- | A convenience function for rendering a box to stdout. printBox :: Box -> IO () printBox = putStr . render boxes-0.1.5/Text/PrettyPrint/Tests.hs0000644000000000000000000000413313251041657015716 0ustar0000000000000000import Test.QuickCheck import Text.PrettyPrint.Boxes #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif import Control.Monad import System.Exit (exitFailure, exitSuccess) #if MIN_VERSION_base(4,11,0) import Prelude hiding ((<>)) #endif instance Arbitrary Alignment where arbitrary = elements [ AlignFirst , AlignCenter1 , AlignCenter2 , AlignLast ] instance Arbitrary Box where arbitrary = sized arbBox -- A sized generator for boxes. The larger the parameter is, the larger a -- generated Box is likely to be. This is necessary in order to avoid -- the tests getting stuck trying to generate ridiculously huge Box values. arbBox :: Int -> Gen Box arbBox n = Box <$> nonnegative <*> nonnegative <*> arbContent n where nonnegative = getNonNegative <$> arbitrary instance Arbitrary Content where arbitrary = sized arbContent -- A sized generator for Content values. The larger the parameter is, the -- larger a generated Content is likely to be. This is necessary in order to -- avoid the tests getting stuck trying to generate ridiculously huge Content -- values. -- -- See also section 3.2 of http://www.cs.tufts.edu/%7Enr/cs257/archive/john-hughes/quick.pdf arbContent :: Int -> Gen Content arbContent 0 = pure Blank arbContent n = oneof [ pure Blank , Text <$> arbitrary , Row <$> halveSize (listOf box) , Col <$> halveSize (listOf box) , SubBox <$> arbitrary <*> arbitrary <*> decrementSize box ] where decrementSize = scale (\s -> max (s - 1) 0) halveSize = scale (`quot` 2) box = arbBox n -- extensional equivalence for Boxes b1 ==== b2 = render b1 == render b2 prop_render_text s = render (text s) == (s ++ "\n") prop_empty_right_id b = b <> nullBox ==== b prop_empty_left_id b = nullBox <> b ==== b prop_empty_top_id b = nullBox // b ==== b prop_empty_bot_id b = b // nullBox ==== b main = do quickCheck prop_render_text quickCheck prop_empty_right_id quickCheck prop_empty_left_id quickCheck prop_empty_top_id quickCheck prop_empty_bot_id