Add experimental support for local print option overrides

Author: natefaubion

packages.dhall

@@ -1,5 +1,5 @@
 let upstream =
-      https://github.com/purescript/package-sets/releases/download/psc-0.14.0-20210324/packages.dhall sha256:b4564d575da6aed1c042ca7936da97c8b7a29473b63f4515f09bb95fae8dddab
+      https://github.com/purescript/package-sets/releases/download/psc-0.14.3-20210811/packages.dhall sha256:a2de7ef2f2e753733eddfa90573a82da0c7c61d46fa87d015b7f15ef8a6e97d5
 
 let overrides = {=}
 

spago.dhall

@@ -6,18 +6,30 @@ You can edit this file as you like.
 , dependencies =
   [ "aff"
   , "ansi"
+  , "arrays"
   , "avar"
   , "console"
+  , "control"
   , "effect"
+  , "either"
+  , "exceptions"
   , "foldable-traversable"
+  , "integers"
   , "lists"
   , "maybe"
   , "minibench"
+  , "node-buffer"
   , "node-child-process"
   , "node-fs-aff"
+  , "node-path"
   , "node-process"
+  , "node-streams"
+  , "parallel"
+  , "posix-types"
+  , "prelude"
   , "psci-support"
   , "strings"
+  , "tuples"
   ]
 , packages = ./packages.dhall
 , sources = [ "src/**/*.purs", "test/**/*.purs" ]

src/Dodo.purs

@@ -28,6 +28,7 @@ module Dodo
   , encloseWithSeparator
   , foldWithSeparator
   , foldWith
+  , locally
   , print
   , Printer(..)
   , plainText
@@ -48,7 +49,7 @@ import Data.String as String
 import Data.String.Regex as Regex
 import Data.String.Regex.Flags (global)
 import Data.String.Regex.Unsafe (unsafeRegex)
-import Dodo.Internal (Doc(..), Position, bothNotEmpty, isEmpty, notEmpty)
+import Dodo.Internal (Doc(..), Position, LocalOptions, bothNotEmpty, isEmpty, notEmpty)
 import Dodo.Internal (Doc, Position, bothNotEmpty, isEmpty, notEmpty) as Exports
 import Dodo.Internal.Buffer (Buffer)
 import Dodo.Internal.Buffer as Buffer
@@ -193,6 +194,11 @@ foldWithSeparator separator = foldWith (\a b -> a <> (separator <> b))
 foldWith :: forall f a. Foldable f => (Doc a -> Doc a -> Doc a) -> f (Doc a) -> Doc a
 foldWith f = foldr (bothNotEmpty f) mempty
 
+-- | *EXPERIMENTAL:* modifies printing state and options locally for a document.
+-- | This may change or be removed at any time.
+locally :: forall a. (LocalOptions -> LocalOptions) -> Doc a -> Doc a
+locally = Local
+
 -- | Custom printers can be used to render richer documents than just plain
 -- | text.
 -- | * `emptyBuffer` - The initial buffer.
@@ -255,6 +261,7 @@ data DocCmd a
   | Dedent String Int
   | LeaveAnnotation a (List a)
   | LeaveFlexGroup (Doc a) (Doc a)
+  | LeaveLocal LocalOptions
 
 data FlexGroupStatus b a
   = NoFlexGroup
@@ -267,6 +274,7 @@ type FlexGroupState b a =
   , annotations :: List a
   , indentSpaces :: String
   , stack :: List (DocCmd a)
+  , options :: PrintOptions
   }
 
 type DocState b a =
@@ -275,15 +283,39 @@ type DocState b a =
   , annotations :: List a
   , indentSpaces :: String
   , flexGroup :: FlexGroupStatus b a
+  , options :: PrintOptions
   }
 
 resetState :: forall a b. FlexGroupState b a -> DocState b a
-resetState { position, buffer, annotations, indentSpaces } =
-  { position, buffer, annotations, indentSpaces, flexGroup: NoFlexGroup }
+resetState { position, buffer, annotations, indentSpaces, options } =
+  { position, buffer, annotations, indentSpaces, flexGroup: NoFlexGroup, options }
 
 storeState :: forall a b. List (DocCmd a) -> DocState b a -> FlexGroupState b a
-storeState stack { position, buffer, annotations, indentSpaces } =
-  { position, buffer, annotations, indentSpaces, stack }
+storeState stack { position, buffer, annotations, indentSpaces, options } =
+  { position, buffer, annotations, indentSpaces, stack, options }
+
+storeOptions :: forall a b. Int -> LocalOptions -> DocState b a -> DocState b a
+storeOptions prevIndent localOptions state = do
+  let
+    newOptions =
+      { indentUnit: localOptions.indentUnit
+      , indentWidth: localOptions.indentWidth
+      , pageWidth: localOptions.pageWidth
+      , ribbonRatio: localOptions.ribbonRatio
+      }
+  state
+    { indentSpaces = localOptions.indentSpaces
+    , options = newOptions
+    , position
+        { pageWidth = newOptions.pageWidth
+        , ribbonWidth = calcRibbonWidth newOptions prevIndent
+        , nextIndent = localOptions.indent
+        }
+    }
+
+calcRibbonWidth :: PrintOptions -> Int -> Int
+calcRibbonWidth { pageWidth, ribbonRatio } n =
+  max 0 $ Int.ceil $ mul ribbonRatio $ Int.toNumber $ pageWidth - n
 
 -- | Prints a documents given a printer and print options.
 -- |
@@ -297,11 +329,8 @@ storeState stack { position, buffer, annotations, indentSpaces } =
 print :: forall b a r. Printer b a r -> PrintOptions -> Doc a -> r
 print (Printer printer) opts = flip go initState <<< pure <<< Doc
   where
-  ribbonRatio :: Number
-  ribbonRatio = max 0.0 (min 1.0 opts.ribbonRatio)
-
-  calcRibbonWidth :: Int -> Int
-  calcRibbonWidth = max 0 <<< Int.ceil <<< mul ribbonRatio <<< Int.toNumber <<< (opts.pageWidth - _)
+  initOptions :: PrintOptions
+  initOptions = opts { ribbonRatio = max 0.0 (min 1.0 opts.ribbonRatio) }
 
   initState :: DocState b a
   initState =
@@ -310,13 +339,14 @@ print (Printer printer) opts = flip go initState <<< pure <<< Doc
         , column: 0
         , indent: 0
         , nextIndent: 0
-        , pageWidth: opts.pageWidth
-        , ribbonWidth: calcRibbonWidth 0
+        , pageWidth: initOptions.pageWidth
+        , ribbonWidth: calcRibbonWidth initOptions 0
         }
     , buffer: Buffer.new printer.emptyBuffer
     , annotations: List.Nil
     , indentSpaces: ""
     , flexGroup: NoFlexGroup
+    , options: initOptions
     }
 
   go :: List (DocCmd a) -> DocState b a -> r
@@ -356,7 +386,7 @@ print (Printer printer) opts = flip go initState <<< pure <<< Doc
                   { line = state.position.line + 1
                   , column = 0
                   , indent = state.position.nextIndent
-                  , ribbonWidth = calcRibbonWidth state.position.nextIndent
+                  , ribbonWidth = calcRibbonWidth state.options state.position.nextIndent
                   }
               , buffer = Buffer.modify printer.writeBreak state.buffer
               , flexGroup = NoFlexGroup
@@ -367,7 +397,7 @@ print (Printer printer) opts = flip go initState <<< pure <<< Doc
                 { position
                     { indent = state.position.nextIndent + opts.indentWidth
                     , nextIndent = state.position.nextIndent + opts.indentWidth
-                    , ribbonWidth = calcRibbonWidth (state.position.nextIndent + opts.indentWidth)
+                    , ribbonWidth = calcRibbonWidth state.options (state.position.nextIndent + opts.indentWidth)
                     }
                 , indentSpaces = state.indentSpaces <> opts.indentUnit
                 }
@@ -382,7 +412,7 @@ print (Printer printer) opts = flip go initState <<< pure <<< Doc
                 { position
                     { indent = state.position.nextIndent + width
                     , nextIndent = state.position.nextIndent + width
-                    , ribbonWidth = calcRibbonWidth (state.position.nextIndent + width)
+                    , ribbonWidth = calcRibbonWidth state.options (state.position.nextIndent + width)
                     }
                 , indentSpaces = state.indentSpaces <> power " " width
                 }
@@ -423,6 +453,18 @@ print (Printer printer) opts = flip go initState <<< pure <<< Doc
             { annotations = ann : state.annotations
             , buffer = Buffer.modify (printer.enterAnnotation ann state.annotations) state.buffer
             }
+        Local k doc1 -> do
+          let
+            prevOptions =
+              { indent: state.position.indent
+              , indentSpaces: state.indentSpaces
+              , indentUnit: state.options.indentUnit
+              , indentWidth: state.options.indentWidth
+              , pageWidth: state.options.pageWidth
+              , ribbonRatio: state.options.ribbonRatio
+              }
+            localOptions = k prevOptions
+          go (Doc doc1 : LeaveLocal prevOptions: stk) $ storeOptions state.position.indent localOptions state
         Empty ->
           go stk state
       LeaveFlexGroup doc1 doc2 -> case state.flexGroup of
@@ -445,3 +487,5 @@ print (Printer printer) opts = flip go initState <<< pure <<< Doc
           { annotations = anns
           , buffer = Buffer.modify (printer.leaveAnnotation ann anns) state.buffer
           }
+      LeaveLocal prevOptions ->
+        go stk $ storeOptions state.position.indent prevOptions state

src/Dodo/Ansi.purs

@@ -118,7 +118,7 @@ ansiGraphics = Printer
       }
 
   leaveAnnotation :: Ansi.GraphicsParam -> List Ansi.GraphicsParam -> AnsiBuffer -> AnsiBuffer
-  leaveAnnotation a as (AnsiBuffer buffer) = do
+  leaveAnnotation _ as (AnsiBuffer buffer) = do
     let current = getCurrentGraphics as
     AnsiBuffer buffer
       { pending = Just $ fromMaybe (pure Ansi.Reset) $ getPendingGraphics current

src/Dodo/Internal.purs

@@ -23,10 +23,20 @@ data Doc a
   | FlexSelect (Doc a) (Doc a) (Doc a)
   | FlexAlt (Doc a) (Doc a)
   | WithPosition (Position -> Doc a)
+  | Local (LocalOptions -> LocalOptions) (Doc a)
   | Text Int String
   | Break
   | Empty
 
+type LocalOptions =
+  { indent :: Int
+  , indentSpaces :: String
+  , indentUnit :: String
+  , indentWidth :: Int
+  , pageWidth :: Int
+  , ribbonRatio :: Number
+  }
+
 derive instance functorDoc :: Functor Doc
 
 instance semigroupDoc :: Semigroup (Doc a) where

test/Snapshot.purs

@@ -84,7 +84,7 @@ snapshotMainOutput directory accept mbPattern = do
             writeFile outputFile =<< liftEffect (Buffer.fromString output UTF8)
         savedOutput <- try $ readFile outputFile
         case savedOutput of
-          Left err -> do
+          Left _ -> do
             acceptOutput
             pure { name, output, result: Saved }
           Right buffer -> do

test/snapshots/DodoLocally.output

@@ -0,0 +1,5 @@
+hello
+    indented
+  undented
+      undented indent
+    indented again

test/snapshots/DodoLocally.purs

@@ -0,0 +1,25 @@
+module DodoLocally where
+
+import Prelude
+
+import Dodo (Doc, fourSpaces, indent, lines, locally, plainText, print, text)
+import Effect (Effect)
+import Effect.Class.Console as Console
+
+test1 :: forall a. Doc a
+test1 = lines
+  [ text "hello"
+  , indent $ lines
+      [ text "indented"
+      , locally (_ { indent = 2, indentSpaces = "  " }) do
+          lines
+            [ text "undented"
+            , indent $ text "undented indent"
+            ]
+      , text "indented again"
+      ]
+  ]
+
+main :: Effect Unit
+main = do
+  Console.log $ print plainText fourSpaces test1