-- | Frequently useful definitions for working with general prettyprinters.
module Prettyprinter.Util (
    module Prettyprinter.Util
) where



import           Data.Text                             (Text)
import qualified Data.Text                             as T
import           Prettyprinter.Render.Text
import           Prelude                               hiding (words)
import           System.IO

import Prettyprinter



-- | Split an input into word-sized 'Doc's.
--
-- >>> putDoc (tupled (words "Lorem ipsum dolor"))
-- (Lorem, ipsum, dolor)
words :: Text -> [Doc ann]
words :: Text -> [Doc ann]
words = (Text -> Doc ann) -> [Text] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Text] -> [Doc ann]) -> (Text -> [Text]) -> Text -> [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words

-- | Insert soft linebreaks between words, so that text is broken into multiple
-- lines when it exceeds the available width.
--
-- >>> putDocW 32 (reflow "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua.")
-- Lorem ipsum dolor sit amet,
-- consectetur adipisicing elit,
-- sed do eiusmod tempor incididunt
-- ut labore et dolore magna
-- aliqua.
--
-- @
-- 'reflow' = 'fillSep' . 'words'
-- @
reflow :: Text -> Doc ann
reflow :: Text -> Doc ann
reflow = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
fillSep ([Doc ann] -> Doc ann) -> (Text -> [Doc ann]) -> Text -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Doc ann]
forall ann. Text -> [Doc ann]
words

-- | Render a document with a certain width. Useful for quick-and-dirty testing
-- of layout behaviour. Used heavily in the doctests of this package, for
-- example.
--
-- >>> let doc = reflow "Lorem ipsum dolor sit amet, consectetur adipisicing elit"
-- >>> putDocW 20 doc
-- Lorem ipsum dolor
-- sit amet,
-- consectetur
-- adipisicing elit
-- >>> putDocW 30 doc
-- Lorem ipsum dolor sit amet,
-- consectetur adipisicing elit
putDocW :: Int -> Doc ann -> IO ()
putDocW :: Int -> Doc ann -> IO ()
putDocW Int
w Doc ann
doc = Handle -> SimpleDocStream Any -> IO ()
forall ann. Handle -> SimpleDocStream ann -> IO ()
renderIO Handle
System.IO.stdout (LayoutOptions -> Doc Any -> SimpleDocStream Any
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
layoutOptions (Doc ann -> Doc Any
forall ann xxx. Doc ann -> Doc xxx
unAnnotate Doc ann
doc))
  where
    layoutOptions :: LayoutOptions
layoutOptions = LayoutOptions :: PageWidth -> LayoutOptions
LayoutOptions { layoutPageWidth :: PageWidth
layoutPageWidth = Int -> Double -> PageWidth
AvailablePerLine Int
w Double
1 }



-- $setup
--
-- (Definitions for the doctests)
--
-- >>> :set -XOverloadedStrings