@@ -0,0 +1,234 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+{-# LANGUAGE OverloadedStrings #-}
4+-- | In most cases import "Ormolu.Printer.Combinators" instead, these
5+-- functions are the low-level building blocks and should not be used on
6+-- their own. The 'R' monad is re-exported from "Ormolu.Printer.Combinators"
9+module Ormolu.Printer.Internal
13+ -- * Internal functions
26+import Control.Monad.Reader
27+import Control.Monad.State.Strict
28+import Data.Data (Data)
29+import Data.Text (Text)
30+import Data.Text.Lazy.Builder
32+import Language.Haskell.GHC.ExactPrint.Types
34+import qualified Data.Text.Lazy as TL
35+import qualified Data.Map as M
36+import qualified Data.Text as T
38+----------------------------------------------------------------------------
41+-- | The 'R' monad hosts combinators that allow us to describe how to render
44+newtype R a = R (ReaderT RC (State SC) a)
45+ deriving (Functor, Applicative, Monad)
47+-- | Reader context of 'R'.
51+ -- ^ Indentation level, as the column index we need to start from after a
52+ -- newline if we break lines
56+ -- ^ The collection of annotations obtained after parsing
58+ -- ^ Whether to print debugging info as we go
61+-- | State context of 'R'.
65+ -- ^ Index of the next column to render
66+ , scBuilder :: Builder
67+ -- ^ Rendered source code so far
70+-- | 'Layout' options.
73+ = SingleLine -- ^ Put everything on single line
74+ | MultiLine -- ^ Use multiple lines
77+-- | Run an 'R' monad.
80+ :: Bool -- ^ Whether to print debugging info
81+ -> R () -- ^ Monad to run
82+ -> Anns -- ^ Annotations to use
83+ -> Text -- ^ Resulting rendition
84+runR debug (R m) anns =
85+ TL.toStrict . toLazyText . scBuilder $ execState (runReaderT m rc) sc
89+ , rcLayout = MultiLine
98+----------------------------------------------------------------------------
101+-- | Grow current output by appending given 'Text' to it, which may not
106+ traceR "spit_before" (Just x)
108+ traceR "spit_after" Nothing
111+ { scBuilder = scBuilder sc <> fromText x
112+ , scColumn = scColumn sc + T.length x
115+-- | Output a newline.
119+ traceR "newline_before" (Just "\n")
121+ traceR "newline_after" Nothing
124+ { scBuilder = scBuilder sc <> "\n"
128+-- | Ensure that indentation level is satisfied. Insert correct number of
129+-- spaces if it isn't.
133+ traceR "ensure_indent" Nothing
134+ i <- R (asks rcIndent)
135+ c <- R (gets scColumn)
137+ spit (T.replicate (i - c) " ")
139+-- | Increase indentation level by one indentation step for the inner
144+ traceR "inci_before" Nothing
145+ let R m = traceR "inci_inside" Nothing >> m'
147+ traceR "inci_ended" Nothing
150+ { rcIndent = rcIndent x + indentStep
153+-- | Set indentation level for the inner computation equal to current
154+-- column. This makes sure that the entire inner block is uniformly
155+-- \"shifted\" to the right. Only works (and makes sense) when enclosing
156+-- layout is multilined.
158+sitcc :: R () -> R ()
160+ traceR "sitcc_before" Nothing
161+ i <- R (asks rcIndent)
162+ c <- R (gets scColumn)
164+ { rcIndent = max i c
166+ R m = traceR "sitcc_inside" Nothing >> m'
167+ vlayout m' (R (local modRC m))
168+ traceR "sitcc_ended" Nothing
170+-- | Set 'Layout' for internal computation.
172+enterLayout :: Layout -> R () -> R ()
173+enterLayout l (R m) = do
176+ SingleLine -> "single_line"
177+ MultiLine -> "multi_line"
178+ traceR ("lstart_" ++ label) Nothing
183+ traceR ("lend_" ++ label) Nothing
185+-- | Do one or another thing depending on current 'Layout'.
188+ :: R () -- ^ Single line
189+ -> R () -- ^ Multi line
191+vlayout sline mline = do
192+ l <- R (asks rcLayout)
197+-- | Lookup an annotation.
199+lookupAnn :: Data a => Located a -> R (Maybe Annotation)
200+lookupAnn (L s d) = do
201+ anns <- R (asks rcAnns)
202+ let k = AnnKey s (annGetConstr d)
203+ traceShow k $ return (M.lookup k anns)
205+----------------------------------------------------------------------------
211+ :: String -- ^ Label
212+ -> Maybe Text -- ^ Output, if any
214+traceR label moutput = R $ do
215+ debug <- asks rcDebug
218+ when debug . traceM . concat $
220+ , unwords [ label ++ ":"
224+ ] ++ case moutput of
226+ Just output -> [" out=" ++ show output]
228+----------------------------------------------------------------------------
231+-- | Indentation step.