{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Ormolu.Printer.Internal
(
R,
runR,
txt,
interferingTxt,
atom,
space,
newline,
askSourceType,
askFixityOverrides,
askFixityMap,
inci,
inciHalf,
sitcc,
Layout (..),
enterLayout,
vlayout,
getLayout,
useBraces,
dontUseBraces,
canUseBraces,
CommentPosition (..),
registerPendingCommentLine,
trimSpanStream,
nextEltSpan,
popComment,
getEnclosingSpan,
withEnclosingSpan,
thisLineSpans,
SpanMark (..),
spanMarkSpan,
HaddockStyle (..),
setSpanMark,
getSpanMark,
isExtensionEnabled,
)
where
import Control.Monad.Reader
import Control.Monad.State.Strict
import Data.Bool (bool)
import Data.Coerce
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.Data.EnumSet (EnumSet)
import qualified GHC.Data.EnumSet as EnumSet
import GHC.LanguageExtensions.Type
import GHC.Types.SrcLoc
import GHC.Utils.Outputable (Outputable)
import Ormolu.Config (SourceType (..))
import Ormolu.Fixity (FixityMap, LazyFixityMap)
import Ormolu.Parser.CommentStream
import Ormolu.Printer.SpanStream
import Ormolu.Utils (showOutputable)
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 -> Bool
rcCanUseBraces :: Bool,
RC -> EnumSet Extension
rcExtensions :: EnumSet Extension,
RC -> SourceType
rcSourceType :: SourceType,
RC -> FixityMap
rcFixityOverrides :: FixityMap,
RC -> LazyFixityMap
rcFixityMap :: LazyFixityMap
}
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 ->
SourceType ->
EnumSet Extension ->
FixityMap ->
LazyFixityMap ->
Text
runR :: R ()
-> SpanStream
-> CommentStream
-> SourceType
-> EnumSet Extension
-> FixityMap
-> LazyFixityMap
-> Text
runR (R ReaderT RC (State SC) ()
m) SpanStream
sstream CommentStream
cstream SourceType
sourceType EnumSet Extension
extensions FixityMap
fixityOverrides LazyFixityMap
fixityMap =
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]
-> Bool
-> EnumSet Extension
-> SourceType
-> FixityMap
-> LazyFixityMap
-> RC
RC
{ rcIndent :: Int
rcIndent = Int
0,
rcLayout :: Layout
rcLayout = Layout
MultiLine,
rcEnclosingSpans :: [RealSrcSpan]
rcEnclosingSpans = [],
rcCanUseBraces :: Bool
rcCanUseBraces = Bool
False,
rcExtensions :: EnumSet Extension
rcExtensions = EnumSet Extension
extensions,
rcSourceType :: SourceType
rcSourceType = SourceType
sourceType,
rcFixityOverrides :: FixityMap
rcFixityOverrides = FixityMap
fixityOverrides,
rcFixityMap :: LazyFixityMap
rcFixityMap = LazyFixityMap
fixityMap
}
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 <- (RC -> Maybe RealSrcSpan)
-> ReaderT RC (State SC) (Maybe RealSrcSpan)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ([RealSrcSpan] -> Maybe RealSrcSpan
forall a. [a] -> Maybe a
listToMaybe ([RealSrcSpan] -> Maybe RealSrcSpan)
-> (RC -> [RealSrcSpan]) -> RC -> Maybe RealSrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
}
askSourceType :: R SourceType
askSourceType :: R SourceType
askSourceType = ReaderT RC (State SC) SourceType -> R SourceType
forall a. ReaderT RC (State SC) a -> R a
R ((RC -> SourceType) -> ReaderT RC (State SC) SourceType
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RC -> SourceType
rcSourceType)
askFixityOverrides :: R FixityMap
askFixityOverrides :: R FixityMap
askFixityOverrides = ReaderT RC (State SC) FixityMap -> R FixityMap
forall a. ReaderT RC (State SC) a -> R a
R ((RC -> FixityMap) -> ReaderT RC (State SC) FixityMap
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RC -> FixityMap
rcFixityOverrides)
askFixityMap :: R LazyFixityMap
askFixityMap :: R LazyFixityMap
askFixityMap = ReaderT RC (State SC) LazyFixityMap -> R LazyFixityMap
forall a. ReaderT RC (State SC) a -> R a
R ((RC -> LazyFixityMap) -> ReaderT RC (State SC) LazyFixityMap
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RC -> LazyFixityMap
rcFixityMap)
inciBy :: Int -> R () -> R ()
inciBy :: Int -> R () -> R ()
inciBy Int
step (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
{ rcIndent :: Int
rcIndent = RC -> Int
rcIndent RC
rc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
step
}
inci :: R () -> R ()
inci :: R () -> R ()
inci = Int -> R () -> R ()
inciBy Int
indentStep
inciHalf :: R () -> R ()
inciHalf :: R () -> R ()
inciHalf = Int -> R () -> R ()
inciBy (Int -> R () -> R ()) -> Int -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ (Int
indentStep Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
1
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)
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)
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)
indentStep :: Int
indentStep :: Int
indentStep = Int
2
isExtensionEnabled :: Extension -> R Bool
isExtensionEnabled :: Extension -> R Bool
isExtensionEnabled Extension
ext = ReaderT RC (State SC) Bool -> R Bool
forall a. ReaderT RC (State SC) a -> R a
R (ReaderT RC (State SC) Bool -> R Bool)
-> ((RC -> Bool) -> ReaderT RC (State SC) Bool)
-> (RC -> Bool)
-> R Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RC -> Bool) -> ReaderT RC (State SC) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((RC -> Bool) -> R Bool) -> (RC -> Bool) -> R Bool
forall a b. (a -> b) -> a -> b
$ Extension -> EnumSet Extension -> Bool
forall a. Enum a => a -> EnumSet a -> Bool
EnumSet.member Extension
ext (EnumSet Extension -> Bool)
-> (RC -> EnumSet Extension) -> RC -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RC -> EnumSet Extension
rcExtensions