diff --git a/prettyprinter/prettyprinter.cabal b/prettyprinter/prettyprinter.cabal index 4f83971d..609c8441 100644 --- a/prettyprinter/prettyprinter.cabal +++ b/prettyprinter/prettyprinter.cabal @@ -27,6 +27,7 @@ library exposed-modules: Data.Text.Prettyprint.Doc , Data.Text.Prettyprint.Doc.Internal + , Data.Text.Prettyprint.Doc.Internal.Debug , Data.Text.Prettyprint.Doc.Internal.Type , Data.Text.Prettyprint.Doc.Render.String , Data.Text.Prettyprint.Doc.Render.Text diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs index 9c966c25..f3910f1f 100755 --- a/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs +++ b/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs @@ -15,9 +15,7 @@ -- For a stable API, use the non-internal modules. For the special case of -- writing adaptors to this library’s @'Doc'@ type, see -- "Data.Text.Prettyprint.Doc.Internal.Type". -module Data.Text.Prettyprint.Doc.Internal ( - module Data.Text.Prettyprint.Doc.Internal -) where +module Data.Text.Prettyprint.Doc.Internal where @@ -1624,6 +1622,9 @@ data PageWidth deriving (Eq, Ord, Show, Typeable) +defaultPageWidth :: PageWidth +defaultPageWidth = AvailablePerLine 80 1 + -- $ Test to avoid surprising behaviour -- >>> Unbounded > AvailablePerLine maxBound 1 -- True @@ -1639,7 +1640,7 @@ newtype LayoutOptions = LayoutOptions { layoutPageWidth :: PageWidth } -- >>> defaultLayoutOptions -- LayoutOptions {layoutPageWidth = AvailablePerLine 80 1.0} defaultLayoutOptions :: LayoutOptions -defaultLayoutOptions = LayoutOptions { layoutPageWidth = AvailablePerLine 80 1 } +defaultLayoutOptions = LayoutOptions { layoutPageWidth = defaultPageWidth } -- | This is the default layout algorithm, and it is used by 'show', 'putDoc' -- and 'hPutDoc'. @@ -1883,7 +1884,6 @@ renderShowS = \sds -> case sds of SAnnPop x -> renderShowS x - -- $setup -- -- (Definitions for the doctests) diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal/Debug.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal/Debug.hs new file mode 100644 index 00000000..c6f0bc79 --- /dev/null +++ b/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal/Debug.hs @@ -0,0 +1,95 @@ +-- | __Warning: internal module!__ This means that the API may change +-- arbitrarily between versions without notice. Depending on this module may +-- lead to unexpected breakages, so proceed with caution! +-- +-- This module provides debugging helpers for inspecting 'Doc's. +-- +-- Use the @pretty-simple@ package to get a nicer layout for 'show'n +-- 'Diag's: +-- +-- >>> Text.Pretty.Simple.pPrintNoColor . diag $ align (vcat ["foo", "bar"]) +-- Column +-- [ +-- ( 10 +-- , Nesting +-- [ +-- ( 10 +-- , Cat ( Text 3 "foo" ) +-- ( Cat ( FlatAlt Line Empty ) ( Text 3 "bar" ) ) +-- ) +-- ] +-- ) +-- ] + + +module Data.Text.Prettyprint.Doc.Internal.Debug where + +import Data.Text (Text) +import Data.Text.Prettyprint.Doc.Internal (PageWidth, Doc) +import qualified Data.Text.Prettyprint.Doc.Internal as Doc + +-- | A variant of 'Doc' for debugging. +-- +-- Unlike in the 'Doc' type, the 'Column', 'WithPageWidth' and 'Nesting' +-- constructors don't contain functions but are \"sampled\" to allow +-- simple inspection with 'show'. +data Diag ann = + Fail + | Empty + | Char !Char + | Text !Int !Text + | Line + | FlatAlt (Diag ann) (Diag ann) + | Cat (Diag ann) (Diag ann) + | Nest !Int (Diag ann) + | Union (Diag ann) (Diag ann) + | Column [(Int, Diag ann)] + -- ^ 'Doc': @(Int -> Diag ann)@ + | WithPageWidth [(PageWidth, Diag ann)] + -- ^ 'Doc': @(PageWidth -> Diag ann)@ + | Nesting [(Int, Diag ann)] + -- ^ 'Doc': @(Int -> Diag ann)@ + | Annotated ann (Diag ann) + deriving Show + +-- | Convert a 'Doc' to its diagnostic representation. +-- +-- The functions in the 'Column', 'WithPageWidth' and 'Nesting' constructors are +-- sampled with some default values. +-- +-- Use `diag'` to control the function inputs yourself. +-- +-- >>> diag $ align (vcat ["foo", "bar"]) +-- Column [(10,Nesting [(10,Cat (Text 3 "foo") (Cat (FlatAlt Line Empty) (Text 3 "bar")))])] +diag :: Doc ann -> Diag ann +diag = diag' [10] [Doc.defaultPageWidth] [10] + +diag' + :: [Int] + -- ^ Cursor positions for the 'Column' constructor + -> [PageWidth] + -- ^ For 'WithPageWidth' + -> [Int] + -- ^ Nesting levels for 'Nesting' + -> Doc ann + -> Diag ann +diag' columns pageWidths nestings = go + where + go doc = case doc of + Doc.Fail -> Fail + Doc.Empty -> Empty + Doc.Char c -> Char c + Doc.Text l t -> Text l t + Doc.Line -> Line + Doc.FlatAlt a b -> FlatAlt (go a) (go b) + Doc.Cat a b -> Cat (go a) (go b) + Doc.Nest i d -> Nest i (go d) + Doc.Union a b -> Union (go a) (go b) + Doc.Column f -> Column (apply f columns) + Doc.WithPageWidth f -> WithPageWidth (apply f pageWidths) + Doc.Nesting f -> Nesting (apply f nestings) + Doc.Annotated ann d -> Annotated ann (go d) + + apply :: (a -> Doc ann) -> [a] -> [(a, Diag ann)] + apply f = map (\x -> (x, go (f x))) +