1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
-- | This module provides the 'FormattedWriter' monad, which extends a basic
-- "Writer" over 'Text' by allowing formatting features like indentation, line
-- breaks, and ensuring the output is well-structured for readability.
--
-- The 'FormattedWriter' is useful for generating pretty-printed output, such as
-- source code generation, where indentation and newline management are essential.
module Language.Fiddle.Compiler.Backend.Internal.FormattedWriter
( -- * Types
FormattedWriter, -- | The main writer monad with formatting features.
-- * Core Operations
ensureNL, -- | Ensures that there is a newline at the end of the current line.
flush, -- | Flushes any pending text (writes the pending line).
incIndent, -- | Increases the indentation level.
decIndent, -- | Decreases the indentation level.
indented, -- | Performs an action with increased indentation.
execFormattedWriter, -- | Runs the 'FormattedWriter' and produces the final formatted 'Text'.
)
where
import Control.Monad (forM_)
import Control.Monad.RWS.Strict
import Data.Text (Text)
import qualified Data.Text as Text
-- | Internal state for the 'FormattedWriter' monad.
--
-- * 'indentLevel': The current level of indentation.
-- * 'pendingLine': The current line that is being built but not yet written.
data Fmt = Fmt
{ indentLevel :: Int, -- ^ Current indentation level.
pendingLine :: Text -- ^ Text that has been added but not yet written to the output.
}
-- | The 'FormattedWriter' is a monad that provides functionality for writing
-- formatted text, with control over indentation and newlines.
newtype FormattedWriter a = FormattedWriter (RWS () Text Fmt a)
deriving newtype (Functor, Applicative, Monad, MonadState Fmt)
-- | 'MonadWriter' instance for 'FormattedWriter', which allows writing text
-- while maintaining proper indentation and ensuring that newlines are handled
-- correctly. Each line is prefixed with the correct indentation level.
instance MonadWriter Text FormattedWriter where
tell txt = FormattedWriter $ do
-- Get the current indentation level and prepare the indentation prefix.
indent <- (`Text.replicate` " ") <$> gets indentLevel
-- Split the text into lines.
let lines = Text.splitOn "\n" txt
-- For each line, write the indent, the pending line, and then the line itself.
forM_ (Prelude.init lines) $ \line -> do
pending <- gets pendingLine
modify $ \s -> s {pendingLine = ""} -- Reset pending line
tell indent -- Add indentation
tell pending -- Write any pending text
tell line -- Write the actual line
tell "\n" -- Add a newline after the line
-- The last fragment is kept as the new pending line, to be written later.
modify $ \s -> s {pendingLine = pendingLine s <> Prelude.last lines}
-- Allow listening to the written text within the 'FormattedWriter' context.
listen (FormattedWriter fn) = FormattedWriter $ listen fn
-- Allow transformation of the written text via a pass operation.
pass (FormattedWriter fn) = FormattedWriter $ pass fn
-- | Ensures that a newline is written if there is any pending text. This is
-- useful for ensuring that the output ends on a clean line.
ensureNL :: FormattedWriter ()
ensureNL = do
p <- gets pendingLine
if Text.null p
then return ()
else do
modify $ \s -> s {pendingLine = ""}
tell p
tell "\n"
-- | Flushes the pending line by writing it to the output and clearing the
-- pending state. This is useful when you want to force the current line to
-- be written immediately.
flush :: FormattedWriter ()
flush = do
p <- gets pendingLine
modify $ \s -> s {pendingLine = ""}
tell p
-- | Increases the indentation level by one. This will affect all subsequent
-- lines written within the 'FormattedWriter' monad.
incIndent :: FormattedWriter ()
incIndent = modify (\(Fmt id p) -> Fmt (id + 1) p)
-- | Decreases the indentation level by one. This will affect all subsequent
-- lines written within the 'FormattedWriter' monad.
decIndent :: FormattedWriter ()
decIndent = modify (\(Fmt id p) -> Fmt (id - 1) p)
-- | Runs the given 'FormattedWriter' action with an additional indentation level.
-- Once the action completes, the indentation level is decreased.
indented :: FormattedWriter () -> FormattedWriter ()
indented fn = do
incIndent -- Increase indentation level
fn -- Run the action with the increased indentation
decIndent -- Restore the original indentation level
-- | Runs a 'FormattedWriter' and returns the final formatted 'Text' output.
-- It ensures that any pending lines are flushed before returning the result.
execFormattedWriter :: FormattedWriter a -> Text
execFormattedWriter ((>> flush) -> FormattedWriter rws) =
snd $ execRWS rws () (Fmt 0 "") -- Execute the RWS monad, starting with no indentation and no pending line.
|
