{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Ormolu.Printer.Internal
(
R,
runR,
txt,
interferingTxt,
atom,
space,
newline,
useRecordDot,
inci,
inciBy,
sitcc,
Layout (..),
enterLayout,
vlayout,
getLayout,
getPrinterOpt,
useBraces,
dontUseBraces,
canUseBraces,
CommentPosition (..),
registerPendingCommentLine,
trimSpanStream,
nextEltSpan,
popComment,
getEnclosingSpan,
withEnclosingSpan,
thisLineSpans,
SpanMark (..),
spanMarkSpan,
HaddockStyle (..),
setSpanMark,
getSpanMark,
getAnns,
)
where
import Control.Monad.Reader
import Control.Monad.State.Strict
import Data.Bool (bool)
import Data.Coerce
import Data.Functor.Identity (runIdentity)
import Data.Maybe (listToMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Text.Lazy.Builder
import GHC
import Ormolu.Config
import Ormolu.Parser.Anns
import Ormolu.Parser.CommentStream
import Ormolu.Printer.SpanStream
import Ormolu.Utils (showOutputable)
import Outputable (Outputable)
newtype R a = R (ReaderT RC (State SC) a)
deriving (a -> R b -> R a
(a -> b) -> R a -> R b
(forall a b. (a -> b) -> R a -> R b)
-> (forall a b. a -> R b -> R a) -> Functor R
forall a b. a -> R b -> R a
forall a b. (a -> b) -> R a -> R b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> R b -> R a
$c<$ :: forall a b. a -> R b -> R a
fmap :: (a -> b) -> R a -> R b
$cfmap :: forall a b. (a -> b) -> R a -> R b
Functor, Functor R
a -> R a
Functor R
-> (forall a. a -> R a)
-> (forall a b. R (a -> b) -> R a -> R b)
-> (forall a b c. (a -> b -> c) -> R a -> R b -> R c)
-> (forall a b. R a -> R b -> R b)
-> (forall a b. R a -> R b -> R a)
-> Applicative R
R a -> R b -> R b
R a -> R b -> R a
R (a -> b) -> R a -> R b
(a -> b -> c) -> R a -> R b -> R c
forall a. a -> R a
forall a b. R a -> R b -> R a
forall a b. R a -> R b -> R b
forall a b. R (a -> b) -> R a -> R b
forall a b c. (a -> b -> c) -> R a -> R b -> R c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: R a -> R b -> R a
$c<* :: forall a b. R a -> R b -> R a
*> :: R a -> R b -> R b
$c*> :: forall a b. R a -> R b -> R b
liftA2 :: (a -> b -> c) -> R a -> R b -> R c
$cliftA2 :: forall a b c. (a -> b -> c) -> R a -> R b -> R c
<*> :: R (a -> b) -> R a -> R b
$c<*> :: forall a b. R (a -> b) -> R a -> R b
pure :: a -> R a
$cpure :: forall a. a -> R a
$cp1Applicative :: Functor R
Applicative, Applicative R
a -> R a
Applicative R
-> (forall a b. R a -> (a -> R b) -> R b)
-> (forall a b. R a -> R b -> R b)
-> (forall a. a -> R a)
-> Monad R
R a -> (a -> R b) -> R b
R a -> R b -> R b
forall a. a -> R a
forall a b. R a -> R b -> R b
forall a b. R a -> (a -> R b) -> R b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> R a
$creturn :: forall a. a -> R a
>> :: R a -> R b -> R b
$c>> :: forall a b. R a -> R b -> R b
>>= :: R a -> (a -> R b) -> R b
$c>>= :: forall a b. R a -> (a -> R b) -> R b
$cp1Monad :: Applicative R
Monad)
data RC = RC
{
RC -> Int
rcIndent :: !Int,
RC -> Layout
rcLayout :: Layout,
RC -> [RealSrcSpan]
rcEnclosingSpans :: [RealSrcSpan],
RC -> Anns
rcAnns :: Anns,
RC -> Bool
rcCanUseBraces :: Bool,
RC -> Bool
rcUseRecDot :: Bool,
RC -> PrinterOptsTotal
rcPrinterOpts :: PrinterOptsTotal
}
data SC = SC
{
SC -> Int
scColumn :: !Int,
SC -> Int
scIndent :: !Int,
SC -> Builder
scBuilder :: Builder,
SC -> SpanStream
scSpanStream :: SpanStream,
SC -> [RealSrcSpan]
scThisLineSpans :: [RealSrcSpan],
:: CommentStream,
:: ![(CommentPosition, Text)],
SC -> RequestedDelimiter
scRequestedDelimiter :: !RequestedDelimiter,
SC -> Maybe SpanMark
scSpanMark :: !(Maybe SpanMark)
}
data RequestedDelimiter
=
RequestedSpace
|
RequestedNewline
|
RequestedNothing
|
AfterNewline
|
VeryBeginning
deriving (RequestedDelimiter -> RequestedDelimiter -> Bool
(RequestedDelimiter -> RequestedDelimiter -> Bool)
-> (RequestedDelimiter -> RequestedDelimiter -> Bool)
-> Eq RequestedDelimiter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestedDelimiter -> RequestedDelimiter -> Bool
$c/= :: RequestedDelimiter -> RequestedDelimiter -> Bool
== :: RequestedDelimiter -> RequestedDelimiter -> Bool
$c== :: RequestedDelimiter -> RequestedDelimiter -> Bool
Eq, Int -> RequestedDelimiter -> ShowS
[RequestedDelimiter] -> ShowS
RequestedDelimiter -> String
(Int -> RequestedDelimiter -> ShowS)
-> (RequestedDelimiter -> String)
-> ([RequestedDelimiter] -> ShowS)
-> Show RequestedDelimiter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestedDelimiter] -> ShowS
$cshowList :: [RequestedDelimiter] -> ShowS
show :: RequestedDelimiter -> String
$cshow :: RequestedDelimiter -> String
showsPrec :: Int -> RequestedDelimiter -> ShowS
$cshowsPrec :: Int -> RequestedDelimiter -> ShowS
Show)
data Layout
=
SingleLine
|
MultiLine
deriving (Layout -> Layout -> Bool
(Layout -> Layout -> Bool)
-> (Layout -> Layout -> Bool) -> Eq Layout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Layout -> Layout -> Bool
$c/= :: Layout -> Layout -> Bool
== :: Layout -> Layout -> Bool
$c== :: Layout -> Layout -> Bool
Eq, Int -> Layout -> ShowS
[Layout] -> ShowS
Layout -> String
(Int -> Layout -> ShowS)
-> (Layout -> String) -> ([Layout] -> ShowS) -> Show Layout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Layout] -> ShowS
$cshowList :: [Layout] -> ShowS
show :: Layout -> String
$cshow :: Layout -> String
showsPrec :: Int -> Layout -> ShowS
$cshowsPrec :: Int -> Layout -> ShowS
Show)
data
=
OnTheSameLine
|
OnNextLine
deriving (CommentPosition -> CommentPosition -> Bool
(CommentPosition -> CommentPosition -> Bool)
-> (CommentPosition -> CommentPosition -> Bool)
-> Eq CommentPosition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommentPosition -> CommentPosition -> Bool
$c/= :: CommentPosition -> CommentPosition -> Bool
== :: CommentPosition -> CommentPosition -> Bool
$c== :: CommentPosition -> CommentPosition -> Bool
Eq, Int -> CommentPosition -> ShowS
[CommentPosition] -> ShowS
CommentPosition -> String
(Int -> CommentPosition -> ShowS)
-> (CommentPosition -> String)
-> ([CommentPosition] -> ShowS)
-> Show CommentPosition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommentPosition] -> ShowS
$cshowList :: [CommentPosition] -> ShowS
show :: CommentPosition -> String
$cshow :: CommentPosition -> String
showsPrec :: Int -> CommentPosition -> ShowS
$cshowsPrec :: Int -> CommentPosition -> ShowS
Show)
runR ::
R () ->
SpanStream ->
CommentStream ->
Anns ->
PrinterOptsTotal ->
Bool ->
Text
runR :: R ()
-> SpanStream
-> CommentStream
-> Anns
-> PrinterOptsTotal
-> Bool
-> Text
runR (R ReaderT RC (State SC) ()
m) SpanStream
sstream CommentStream
cstream Anns
anns PrinterOptsTotal
printerOpts Bool
recDot =
Text -> Text
TL.toStrict (Text -> Text) -> (SC -> Text) -> SC -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText (Builder -> Text) -> (SC -> Builder) -> SC -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SC -> Builder
scBuilder (SC -> Text) -> SC -> Text
forall a b. (a -> b) -> a -> b
$ State SC () -> SC -> SC
forall s a. State s a -> s -> s
execState (ReaderT RC (State SC) () -> RC -> State SC ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT RC (State SC) ()
m RC
rc) SC
sc
where
rc :: RC
rc =
RC :: Int
-> Layout
-> [RealSrcSpan]
-> Anns
-> Bool
-> Bool
-> PrinterOptsTotal
-> RC
RC
{ rcIndent :: Int
rcIndent = Int
0,
rcLayout :: Layout
rcLayout = Layout
MultiLine,
rcEnclosingSpans :: [RealSrcSpan]
rcEnclosingSpans = [],
rcAnns :: Anns
rcAnns = Anns
anns,
rcCanUseBraces :: Bool
rcCanUseBraces = Bool
False,
rcUseRecDot :: Bool
rcUseRecDot = Bool
recDot,
rcPrinterOpts :: PrinterOptsTotal
rcPrinterOpts = PrinterOptsTotal
printerOpts
}
sc :: SC
sc =
SC :: Int
-> Int
-> Builder
-> SpanStream
-> [RealSrcSpan]
-> CommentStream
-> [(CommentPosition, Text)]
-> RequestedDelimiter
-> Maybe SpanMark
-> SC
SC
{ scColumn :: Int
scColumn = Int
0,
scIndent :: Int
scIndent = Int
0,
scBuilder :: Builder
scBuilder = Builder
forall a. Monoid a => a
mempty,
scSpanStream :: SpanStream
scSpanStream = SpanStream
sstream,
scThisLineSpans :: [RealSrcSpan]
scThisLineSpans = [],
scCommentStream :: CommentStream
scCommentStream = CommentStream
cstream,
scPendingComments :: [(CommentPosition, Text)]
scPendingComments = [],
scRequestedDelimiter :: RequestedDelimiter
scRequestedDelimiter = RequestedDelimiter
VeryBeginning,
scSpanMark :: Maybe SpanMark
scSpanMark = Maybe SpanMark
forall a. Maybe a
Nothing
}
data SpitType
=
SimpleText
|
InterferingText
|
Atom
|
deriving (Int -> SpitType -> ShowS
[SpitType] -> ShowS
SpitType -> String
(Int -> SpitType -> ShowS)
-> (SpitType -> String) -> ([SpitType] -> ShowS) -> Show SpitType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpitType] -> ShowS
$cshowList :: [SpitType] -> ShowS
show :: SpitType -> String
$cshow :: SpitType -> String
showsPrec :: Int -> SpitType -> ShowS
$cshowsPrec :: Int -> SpitType -> ShowS
Show, SpitType -> SpitType -> Bool
(SpitType -> SpitType -> Bool)
-> (SpitType -> SpitType -> Bool) -> Eq SpitType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpitType -> SpitType -> Bool
$c/= :: SpitType -> SpitType -> Bool
== :: SpitType -> SpitType -> Bool
$c== :: SpitType -> SpitType -> Bool
Eq)
txt ::
Text ->
R ()
txt :: Text -> R ()
txt = SpitType -> Text -> R ()
spit SpitType
SimpleText
interferingTxt ::
Text ->
R ()
interferingTxt :: Text -> R ()
interferingTxt = SpitType -> Text -> R ()
spit SpitType
InterferingText
atom ::
Outputable a =>
a ->
R ()
atom :: a -> R ()
atom = SpitType -> Text -> R ()
spit SpitType
Atom (Text -> R ()) -> (a -> Text) -> a -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall o. Outputable o => o -> String
showOutputable
spit ::
SpitType ->
Text ->
R ()
spit :: SpitType -> Text -> R ()
spit SpitType
_ Text
"" = () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
spit SpitType
stype Text
text = do
RequestedDelimiter
requestedDel <- ReaderT RC (State SC) RequestedDelimiter -> R RequestedDelimiter
forall a. ReaderT RC (State SC) a -> R a
R ((SC -> RequestedDelimiter)
-> ReaderT RC (State SC) RequestedDelimiter
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SC -> RequestedDelimiter
scRequestedDelimiter)
[(CommentPosition, Text)]
pendingComments <- ReaderT RC (State SC) [(CommentPosition, Text)]
-> R [(CommentPosition, Text)]
forall a. ReaderT RC (State SC) a -> R a
R ((SC -> [(CommentPosition, Text)])
-> ReaderT RC (State SC) [(CommentPosition, Text)]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SC -> [(CommentPosition, Text)]
scPendingComments)
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SpitType
stype SpitType -> SpitType -> Bool
forall a. Eq a => a -> a -> Bool
== SpitType
InterferingText Bool -> Bool -> Bool
&& Bool -> Bool
not ([(CommentPosition, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(CommentPosition, Text)]
pendingComments)) R ()
newline
case RequestedDelimiter
requestedDel of
RequestedDelimiter
RequestedNewline -> do
ReaderT RC (State SC) () -> R ()
forall a. ReaderT RC (State SC) a -> R a
R (ReaderT RC (State SC) () -> R ())
-> ((SC -> SC) -> ReaderT RC (State SC) ()) -> (SC -> SC) -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SC -> SC) -> ReaderT RC (State SC) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SC -> SC) -> R ()) -> (SC -> SC) -> R ()
forall a b. (a -> b) -> a -> b
$ \SC
sc ->
SC
sc
{ scRequestedDelimiter :: RequestedDelimiter
scRequestedDelimiter = RequestedDelimiter
RequestedNothing
}
case SpitType
stype of
SpitType
CommentPart -> R ()
newlineRaw
SpitType
_ -> R ()
newline
RequestedDelimiter
_ -> () -> R ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ReaderT RC (State SC) () -> R ()
forall a. ReaderT RC (State SC) a -> R a
R (ReaderT RC (State SC) () -> R ())
-> ReaderT RC (State SC) () -> R ()
forall a b. (a -> b) -> a -> b
$ do
Int
i <- (RC -> Int) -> ReaderT RC (State SC) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RC -> Int
rcIndent
Int
c <- (SC -> Int) -> ReaderT RC (State SC) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SC -> Int
scColumn
Maybe RealSrcSpan
closestEnclosing <- [RealSrcSpan] -> Maybe RealSrcSpan
forall a. [a] -> Maybe a
listToMaybe ([RealSrcSpan] -> Maybe RealSrcSpan)
-> ReaderT RC (State SC) [RealSrcSpan]
-> ReaderT RC (State SC) (Maybe RealSrcSpan)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RC -> [RealSrcSpan]) -> ReaderT RC (State SC) [RealSrcSpan]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RC -> [RealSrcSpan]
rcEnclosingSpans
let indentedTxt :: Text
indentedTxt = Text
spaces Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
text
spaces :: Text
spaces = Int -> Text -> Text
T.replicate Int
spacesN Text
" "
spacesN :: Int
spacesN =
if Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then Int
i
else Int -> Int -> Bool -> Int
forall a. a -> a -> Bool -> a
bool Int
0 Int
1 (RequestedDelimiter
requestedDel RequestedDelimiter -> RequestedDelimiter -> Bool
forall a. Eq a => a -> a -> Bool
== RequestedDelimiter
RequestedSpace)
(SC -> SC) -> ReaderT RC (State SC) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SC -> SC) -> ReaderT RC (State SC) ())
-> (SC -> SC) -> ReaderT RC (State SC) ()
forall a b. (a -> b) -> a -> b
$ \SC
sc ->
SC
sc
{ scBuilder :: Builder
scBuilder = SC -> Builder
scBuilder SC
sc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
indentedTxt,
scColumn :: Int
scColumn = SC -> Int
scColumn SC
sc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
indentedTxt,
scIndent :: Int
scIndent =
if Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then Int
i
else SC -> Int
scIndent SC
sc,
scThisLineSpans :: [RealSrcSpan]
scThisLineSpans =
let xs :: [RealSrcSpan]
xs = SC -> [RealSrcSpan]
scThisLineSpans SC
sc
in case SpitType
stype of
SpitType
Atom -> case Maybe RealSrcSpan
closestEnclosing of
Maybe RealSrcSpan
Nothing -> [RealSrcSpan]
xs
Just RealSrcSpan
x -> RealSrcSpan
x RealSrcSpan -> [RealSrcSpan] -> [RealSrcSpan]
forall a. a -> [a] -> [a]
: [RealSrcSpan]
xs
SpitType
_ -> [RealSrcSpan]
xs,
scRequestedDelimiter :: RequestedDelimiter
scRequestedDelimiter = RequestedDelimiter
RequestedNothing,
scSpanMark :: Maybe SpanMark
scSpanMark =
if (SpitType
stype SpitType -> SpitType -> Bool
forall a. Eq a => a -> a -> Bool
== SpitType
CommentPart) Bool -> Bool -> Bool
|| (Bool -> Bool
not (Bool -> Bool) -> (SC -> Bool) -> SC -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(CommentPosition, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(CommentPosition, Text)] -> Bool)
-> (SC -> [(CommentPosition, Text)]) -> SC -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SC -> [(CommentPosition, Text)]
scPendingComments) SC
sc
then SC -> Maybe SpanMark
scSpanMark SC
sc
else Maybe SpanMark
forall a. Maybe a
Nothing
}
space :: R ()
space :: R ()
space = ReaderT RC (State SC) () -> R ()
forall a. ReaderT RC (State SC) a -> R a
R (ReaderT RC (State SC) () -> R ())
-> ((SC -> SC) -> ReaderT RC (State SC) ()) -> (SC -> SC) -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SC -> SC) -> ReaderT RC (State SC) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SC -> SC) -> R ()) -> (SC -> SC) -> R ()
forall a b. (a -> b) -> a -> b
$ \SC
sc ->
SC
sc
{ scRequestedDelimiter :: RequestedDelimiter
scRequestedDelimiter = case SC -> RequestedDelimiter
scRequestedDelimiter SC
sc of
RequestedDelimiter
RequestedNothing -> RequestedDelimiter
RequestedSpace
RequestedDelimiter
other -> RequestedDelimiter
other
}
newline :: R ()
newline :: R ()
newline = do
Int
indent <- ReaderT RC (State SC) Int -> R Int
forall a. ReaderT RC (State SC) a -> R a
R ((SC -> Int) -> ReaderT RC (State SC) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SC -> Int
scIndent)
[(CommentPosition, Text)]
cs <- [(CommentPosition, Text)] -> [(CommentPosition, Text)]
forall a. [a] -> [a]
reverse ([(CommentPosition, Text)] -> [(CommentPosition, Text)])
-> R [(CommentPosition, Text)] -> R [(CommentPosition, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT RC (State SC) [(CommentPosition, Text)]
-> R [(CommentPosition, Text)]
forall a. ReaderT RC (State SC) a -> R a
R ((SC -> [(CommentPosition, Text)])
-> ReaderT RC (State SC) [(CommentPosition, Text)]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SC -> [(CommentPosition, Text)]
scPendingComments)
case [(CommentPosition, Text)]
cs of
[] -> R ()
newlineRaw
((CommentPosition
position, Text
_) : [(CommentPosition, Text)]
_) -> do
case CommentPosition
position of
CommentPosition
OnTheSameLine -> R ()
space
CommentPosition
OnNextLine -> R ()
newlineRaw
ReaderT RC (State SC) () -> R ()
forall a. ReaderT RC (State SC) a -> R a
R (ReaderT RC (State SC) () -> R ())
-> (((CommentPosition, Text) -> ReaderT RC (State SC) ())
-> ReaderT RC (State SC) ())
-> ((CommentPosition, Text) -> ReaderT RC (State SC) ())
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(CommentPosition, Text)]
-> ((CommentPosition, Text) -> ReaderT RC (State SC) ())
-> ReaderT RC (State SC) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(CommentPosition, Text)]
cs (((CommentPosition, Text) -> ReaderT RC (State SC) ()) -> R ())
-> ((CommentPosition, Text) -> ReaderT RC (State SC) ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \(CommentPosition
_, Text
text) ->
let modRC :: RC -> RC
modRC RC
rc =
RC
rc
{ rcIndent :: Int
rcIndent = Int
indent
}
R ReaderT RC (State SC) ()
m = do
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
text) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
SpitType -> Text -> R ()
spit SpitType
CommentPart Text
text
R ()
newlineRaw
in (RC -> RC) -> ReaderT RC (State SC) () -> ReaderT RC (State SC) ()
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local RC -> RC
modRC ReaderT RC (State SC) ()
m
ReaderT RC (State SC) () -> R ()
forall a. ReaderT RC (State SC) a -> R a
R (ReaderT RC (State SC) () -> R ())
-> ((SC -> SC) -> ReaderT RC (State SC) ()) -> (SC -> SC) -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SC -> SC) -> ReaderT RC (State SC) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SC -> SC) -> R ()) -> (SC -> SC) -> R ()
forall a b. (a -> b) -> a -> b
$ \SC
sc ->
SC
sc
{ scPendingComments :: [(CommentPosition, Text)]
scPendingComments = []
}
newlineRaw :: R ()
newlineRaw :: R ()
newlineRaw = ReaderT RC (State SC) () -> R ()
forall a. ReaderT RC (State SC) a -> R a
R (ReaderT RC (State SC) () -> R ())
-> ((SC -> SC) -> ReaderT RC (State SC) ()) -> (SC -> SC) -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SC -> SC) -> ReaderT RC (State SC) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SC -> SC) -> R ()) -> (SC -> SC) -> R ()
forall a b. (a -> b) -> a -> b
$ \SC
sc ->
let requestedDel :: RequestedDelimiter
requestedDel = SC -> RequestedDelimiter
scRequestedDelimiter SC
sc
builderSoFar :: Builder
builderSoFar = SC -> Builder
scBuilder SC
sc
in SC
sc
{ scBuilder :: Builder
scBuilder = case RequestedDelimiter
requestedDel of
RequestedDelimiter
AfterNewline -> Builder
builderSoFar
RequestedDelimiter
RequestedNewline -> Builder
builderSoFar
RequestedDelimiter
VeryBeginning -> Builder
builderSoFar
RequestedDelimiter
_ -> Builder
builderSoFar Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n",
scColumn :: Int
scColumn = Int
0,
scIndent :: Int
scIndent = Int
0,
scThisLineSpans :: [RealSrcSpan]
scThisLineSpans = [],
scRequestedDelimiter :: RequestedDelimiter
scRequestedDelimiter = case SC -> RequestedDelimiter
scRequestedDelimiter SC
sc of
RequestedDelimiter
AfterNewline -> RequestedDelimiter
RequestedNewline
RequestedDelimiter
RequestedNewline -> RequestedDelimiter
RequestedNewline
RequestedDelimiter
VeryBeginning -> RequestedDelimiter
VeryBeginning
RequestedDelimiter
_ -> RequestedDelimiter
AfterNewline
}
useRecordDot :: R Bool
useRecordDot :: R Bool
useRecordDot = ReaderT RC (State SC) Bool -> R Bool
forall a. ReaderT RC (State SC) a -> R a
R ((RC -> Bool) -> ReaderT RC (State SC) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RC -> Bool
rcUseRecDot)
inci :: R () -> R ()
inci :: R () -> R ()
inci = Int -> R () -> R ()
inciBy Int
1
inciBy :: Int -> R () -> R ()
inciBy :: Int -> R () -> R ()
inciBy Int
x (R ReaderT RC (State SC) ()
m) = do
Int
step <- (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
x) (Int -> Int) -> R Int -> R Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT RC (State SC) Int -> R Int
forall a. ReaderT RC (State SC) a -> R a
R ((RC -> Int) -> ReaderT RC (State SC) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Identity Int -> Int
forall a. Identity a -> a
runIdentity (Identity Int -> Int) -> (RC -> Identity Int) -> RC -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrinterOptsTotal -> Identity Int
forall (f :: * -> *). PrinterOpts f -> f Int
poIndentation (PrinterOptsTotal -> Identity Int)
-> (RC -> PrinterOptsTotal) -> RC -> Identity Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RC -> PrinterOptsTotal
rcPrinterOpts))
let modRC :: RC -> RC
modRC RC
rc =
RC
rc
{ rcIndent :: Int
rcIndent = Int -> Int -> Int
forall a. Integral a => a -> a -> a
roundDownToNearest Int
step (RC -> Int
rcIndent RC
rc) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
step
}
ReaderT RC (State SC) () -> R ()
forall a. ReaderT RC (State SC) a -> R a
R ((RC -> RC) -> ReaderT RC (State SC) () -> ReaderT RC (State SC) ()
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local RC -> RC
modRC ReaderT RC (State SC) ()
m)
where
roundDownToNearest :: a -> a -> a
roundDownToNearest a
r a
n = (a
n a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
r) a -> a -> a
forall a. Num a => a -> a -> a
* a
r
sitcc :: R () -> R ()
sitcc :: R () -> R ()
sitcc (R ReaderT RC (State SC) ()
m) = do
RequestedDelimiter
requestedDel <- ReaderT RC (State SC) RequestedDelimiter -> R RequestedDelimiter
forall a. ReaderT RC (State SC) a -> R a
R ((SC -> RequestedDelimiter)
-> ReaderT RC (State SC) RequestedDelimiter
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SC -> RequestedDelimiter
scRequestedDelimiter)
Int
i <- ReaderT RC (State SC) Int -> R Int
forall a. ReaderT RC (State SC) a -> R a
R ((RC -> Int) -> ReaderT RC (State SC) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RC -> Int
rcIndent)
Int
c <- ReaderT RC (State SC) Int -> R Int
forall a. ReaderT RC (State SC) a -> R a
R ((SC -> Int) -> ReaderT RC (State SC) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SC -> Int
scColumn)
let modRC :: RC -> RC
modRC RC
rc =
RC
rc
{ rcIndent :: Int
rcIndent = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
i (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Bool -> Int
forall a. a -> a -> Bool -> a
bool Int
0 Int
1 (RequestedDelimiter
requestedDel RequestedDelimiter -> RequestedDelimiter -> Bool
forall a. Eq a => a -> a -> Bool
== RequestedDelimiter
RequestedSpace))
}
ReaderT RC (State SC) () -> R ()
forall a. ReaderT RC (State SC) a -> R a
R ((RC -> RC) -> ReaderT RC (State SC) () -> ReaderT RC (State SC) ()
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local RC -> RC
modRC ReaderT RC (State SC) ()
m)
enterLayout :: Layout -> R () -> R ()
enterLayout :: Layout -> R () -> R ()
enterLayout Layout
l (R ReaderT RC (State SC) ()
m) = ReaderT RC (State SC) () -> R ()
forall a. ReaderT RC (State SC) a -> R a
R ((RC -> RC) -> ReaderT RC (State SC) () -> ReaderT RC (State SC) ()
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local RC -> RC
modRC ReaderT RC (State SC) ()
m)
where
modRC :: RC -> RC
modRC RC
rc =
RC
rc
{ rcLayout :: Layout
rcLayout = Layout
l
}
vlayout ::
R a ->
R a ->
R a
vlayout :: R a -> R a -> R a
vlayout R a
sline R a
mline = do
Layout
l <- R Layout
getLayout
case Layout
l of
Layout
SingleLine -> R a
sline
Layout
MultiLine -> R a
mline
getLayout :: R Layout
getLayout :: R Layout
getLayout = ReaderT RC (State SC) Layout -> R Layout
forall a. ReaderT RC (State SC) a -> R a
R ((RC -> Layout) -> ReaderT RC (State SC) Layout
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RC -> Layout
rcLayout)
getPrinterOpt :: (forall f. PrinterOpts f -> f a) -> R a
getPrinterOpt :: (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt forall (f :: * -> *). PrinterOpts f -> f a
f = ReaderT RC (State SC) a -> R a
forall a. ReaderT RC (State SC) a -> R a
R (ReaderT RC (State SC) a -> R a) -> ReaderT RC (State SC) a -> R a
forall a b. (a -> b) -> a -> b
$ (RC -> a) -> ReaderT RC (State SC) a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((RC -> a) -> ReaderT RC (State SC) a)
-> (RC -> a) -> ReaderT RC (State SC) a
forall a b. (a -> b) -> a -> b
$ Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> (RC -> Identity a) -> RC -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrinterOptsTotal -> Identity a
forall (f :: * -> *). PrinterOpts f -> f a
f (PrinterOptsTotal -> Identity a)
-> (RC -> PrinterOptsTotal) -> RC -> Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RC -> PrinterOptsTotal
rcPrinterOpts
registerPendingCommentLine ::
CommentPosition ->
Text ->
R ()
CommentPosition
position Text
text = ReaderT RC (State SC) () -> R ()
forall a. ReaderT RC (State SC) a -> R a
R (ReaderT RC (State SC) () -> R ())
-> ReaderT RC (State SC) () -> R ()
forall a b. (a -> b) -> a -> b
$ do
(SC -> SC) -> ReaderT RC (State SC) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SC -> SC) -> ReaderT RC (State SC) ())
-> (SC -> SC) -> ReaderT RC (State SC) ()
forall a b. (a -> b) -> a -> b
$ \SC
sc ->
SC
sc
{ scPendingComments :: [(CommentPosition, Text)]
scPendingComments = (CommentPosition
position, Text
text) (CommentPosition, Text)
-> [(CommentPosition, Text)] -> [(CommentPosition, Text)]
forall a. a -> [a] -> [a]
: SC -> [(CommentPosition, Text)]
scPendingComments SC
sc
}
trimSpanStream ::
RealSrcSpan ->
R ()
trimSpanStream :: RealSrcSpan -> R ()
trimSpanStream RealSrcSpan
ref = do
let leRef :: RealSrcSpan -> Bool
leRef :: RealSrcSpan -> Bool
leRef RealSrcSpan
x = RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
x RealSrcLoc -> RealSrcLoc -> Bool
forall a. Ord a => a -> a -> Bool
<= RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
ref
ReaderT RC (State SC) () -> R ()
forall a. ReaderT RC (State SC) a -> R a
R (ReaderT RC (State SC) () -> R ())
-> ((SC -> SC) -> ReaderT RC (State SC) ()) -> (SC -> SC) -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SC -> SC) -> ReaderT RC (State SC) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SC -> SC) -> R ()) -> (SC -> SC) -> R ()
forall a b. (a -> b) -> a -> b
$ \SC
sc ->
SC
sc
{ scSpanStream :: SpanStream
scSpanStream = ([RealSrcSpan] -> [RealSrcSpan]) -> SpanStream -> SpanStream
coerce ((RealSrcSpan -> Bool) -> [RealSrcSpan] -> [RealSrcSpan]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile RealSrcSpan -> Bool
leRef) (SC -> SpanStream
scSpanStream SC
sc)
}
nextEltSpan :: R (Maybe RealSrcSpan)
nextEltSpan :: R (Maybe RealSrcSpan)
nextEltSpan = [RealSrcSpan] -> Maybe RealSrcSpan
forall a. [a] -> Maybe a
listToMaybe ([RealSrcSpan] -> Maybe RealSrcSpan)
-> (SpanStream -> [RealSrcSpan]) -> SpanStream -> Maybe RealSrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanStream -> [RealSrcSpan]
coerce (SpanStream -> Maybe RealSrcSpan)
-> R SpanStream -> R (Maybe RealSrcSpan)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT RC (State SC) SpanStream -> R SpanStream
forall a. ReaderT RC (State SC) a -> R a
R ((SC -> SpanStream) -> ReaderT RC (State SC) SpanStream
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SC -> SpanStream
scSpanStream)
popComment ::
(RealLocated Comment -> Bool) ->
R (Maybe (RealLocated Comment))
RealLocated Comment -> Bool
f = ReaderT RC (State SC) (Maybe (RealLocated Comment))
-> R (Maybe (RealLocated Comment))
forall a. ReaderT RC (State SC) a -> R a
R (ReaderT RC (State SC) (Maybe (RealLocated Comment))
-> R (Maybe (RealLocated Comment)))
-> ReaderT RC (State SC) (Maybe (RealLocated Comment))
-> R (Maybe (RealLocated Comment))
forall a b. (a -> b) -> a -> b
$ do
CommentStream [RealLocated Comment]
cstream <- (SC -> CommentStream) -> ReaderT RC (State SC) CommentStream
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SC -> CommentStream
scCommentStream
case [RealLocated Comment]
cstream of
[] -> Maybe (RealLocated Comment)
-> ReaderT RC (State SC) (Maybe (RealLocated Comment))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (RealLocated Comment)
forall a. Maybe a
Nothing
(RealLocated Comment
x : [RealLocated Comment]
xs) ->
if RealLocated Comment -> Bool
f RealLocated Comment
x
then
RealLocated Comment -> Maybe (RealLocated Comment)
forall a. a -> Maybe a
Just RealLocated Comment
x
Maybe (RealLocated Comment)
-> ReaderT RC (State SC) ()
-> ReaderT RC (State SC) (Maybe (RealLocated Comment))
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (SC -> SC) -> ReaderT RC (State SC) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
( \SC
sc ->
SC
sc
{ scCommentStream :: CommentStream
scCommentStream = [RealLocated Comment] -> CommentStream
CommentStream [RealLocated Comment]
xs
}
)
else Maybe (RealLocated Comment)
-> ReaderT RC (State SC) (Maybe (RealLocated Comment))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (RealLocated Comment)
forall a. Maybe a
Nothing
getEnclosingSpan ::
(RealSrcSpan -> Bool) ->
R (Maybe RealSrcSpan)
getEnclosingSpan :: (RealSrcSpan -> Bool) -> R (Maybe RealSrcSpan)
getEnclosingSpan RealSrcSpan -> Bool
f =
[RealSrcSpan] -> Maybe RealSrcSpan
forall a. [a] -> Maybe a
listToMaybe ([RealSrcSpan] -> Maybe RealSrcSpan)
-> ([RealSrcSpan] -> [RealSrcSpan])
-> [RealSrcSpan]
-> Maybe RealSrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RealSrcSpan -> Bool) -> [RealSrcSpan] -> [RealSrcSpan]
forall a. (a -> Bool) -> [a] -> [a]
filter RealSrcSpan -> Bool
f ([RealSrcSpan] -> Maybe RealSrcSpan)
-> R [RealSrcSpan] -> R (Maybe RealSrcSpan)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT RC (State SC) [RealSrcSpan] -> R [RealSrcSpan]
forall a. ReaderT RC (State SC) a -> R a
R ((RC -> [RealSrcSpan]) -> ReaderT RC (State SC) [RealSrcSpan]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RC -> [RealSrcSpan]
rcEnclosingSpans)
withEnclosingSpan :: RealSrcSpan -> R () -> R ()
withEnclosingSpan :: RealSrcSpan -> R () -> R ()
withEnclosingSpan RealSrcSpan
spn (R ReaderT RC (State SC) ()
m) = ReaderT RC (State SC) () -> R ()
forall a. ReaderT RC (State SC) a -> R a
R ((RC -> RC) -> ReaderT RC (State SC) () -> ReaderT RC (State SC) ()
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local RC -> RC
modRC ReaderT RC (State SC) ()
m)
where
modRC :: RC -> RC
modRC RC
rc =
RC
rc
{ rcEnclosingSpans :: [RealSrcSpan]
rcEnclosingSpans = RealSrcSpan
spn RealSrcSpan -> [RealSrcSpan] -> [RealSrcSpan]
forall a. a -> [a] -> [a]
: RC -> [RealSrcSpan]
rcEnclosingSpans RC
rc
}
thisLineSpans :: R [RealSrcSpan]
thisLineSpans :: R [RealSrcSpan]
thisLineSpans = ReaderT RC (State SC) [RealSrcSpan] -> R [RealSrcSpan]
forall a. ReaderT RC (State SC) a -> R a
R ((SC -> [RealSrcSpan]) -> ReaderT RC (State SC) [RealSrcSpan]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SC -> [RealSrcSpan]
scThisLineSpans)
data SpanMark
=
HaddockSpan HaddockStyle RealSrcSpan
|
RealSrcSpan
|
StatementSpan RealSrcSpan
spanMarkSpan :: SpanMark -> RealSrcSpan
spanMarkSpan :: SpanMark -> RealSrcSpan
spanMarkSpan = \case
HaddockSpan HaddockStyle
_ RealSrcSpan
s -> RealSrcSpan
s
CommentSpan RealSrcSpan
s -> RealSrcSpan
s
StatementSpan RealSrcSpan
s -> RealSrcSpan
s
data HaddockStyle
=
Pipe
|
Caret
|
Asterisk Int
|
Named String
setSpanMark ::
SpanMark ->
R ()
setSpanMark :: SpanMark -> R ()
setSpanMark SpanMark
spnMark = ReaderT RC (State SC) () -> R ()
forall a. ReaderT RC (State SC) a -> R a
R (ReaderT RC (State SC) () -> R ())
-> ((SC -> SC) -> ReaderT RC (State SC) ()) -> (SC -> SC) -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SC -> SC) -> ReaderT RC (State SC) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SC -> SC) -> R ()) -> (SC -> SC) -> R ()
forall a b. (a -> b) -> a -> b
$ \SC
sc ->
SC
sc
{ scSpanMark :: Maybe SpanMark
scSpanMark = SpanMark -> Maybe SpanMark
forall a. a -> Maybe a
Just SpanMark
spnMark
}
getSpanMark :: R (Maybe SpanMark)
getSpanMark :: R (Maybe SpanMark)
getSpanMark = ReaderT RC (State SC) (Maybe SpanMark) -> R (Maybe SpanMark)
forall a. ReaderT RC (State SC) a -> R a
R ((SC -> Maybe SpanMark) -> ReaderT RC (State SC) (Maybe SpanMark)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SC -> Maybe SpanMark
scSpanMark)
getAnns ::
SrcSpan ->
R [AnnKeywordId]
getAnns :: SrcSpan -> R [AnnKeywordId]
getAnns SrcSpan
spn = SrcSpan -> Anns -> [AnnKeywordId]
lookupAnns SrcSpan
spn (Anns -> [AnnKeywordId]) -> R Anns -> R [AnnKeywordId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT RC (State SC) Anns -> R Anns
forall a. ReaderT RC (State SC) a -> R a
R ((RC -> Anns) -> ReaderT RC (State SC) Anns
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RC -> Anns
rcAnns)
useBraces :: R () -> R ()
useBraces :: R () -> R ()
useBraces (R ReaderT RC (State SC) ()
r) = ReaderT RC (State SC) () -> R ()
forall a. ReaderT RC (State SC) a -> R a
R ((RC -> RC) -> ReaderT RC (State SC) () -> ReaderT RC (State SC) ()
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\RC
i -> RC
i {rcCanUseBraces :: Bool
rcCanUseBraces = Bool
True}) ReaderT RC (State SC) ()
r)
dontUseBraces :: R () -> R ()
dontUseBraces :: R () -> R ()
dontUseBraces (R ReaderT RC (State SC) ()
r) = ReaderT RC (State SC) () -> R ()
forall a. ReaderT RC (State SC) a -> R a
R ((RC -> RC) -> ReaderT RC (State SC) () -> ReaderT RC (State SC) ()
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\RC
i -> RC
i {rcCanUseBraces :: Bool
rcCanUseBraces = Bool
False}) ReaderT RC (State SC) ()
r)
canUseBraces :: R Bool
canUseBraces :: R Bool
canUseBraces = ReaderT RC (State SC) Bool -> R Bool
forall a. ReaderT RC (State SC) a -> R a
R ((RC -> Bool) -> ReaderT RC (State SC) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RC -> Bool
rcCanUseBraces)