{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Ormolu.Printer.Internal
(
R,
runR,
txt,
atom,
space,
newline,
isLineDirty,
useRecordDot,
inci,
sitcc,
Layout (..),
enterLayout,
vlayout,
getLayout,
useBraces,
dontUseBraces,
canUseBraces,
CommentPosition (..),
registerPendingCommentLine,
trimSpanStream,
nextEltSpan,
popComment,
getEnclosingSpan,
withEnclosingSpan,
HaddockStyle (..),
setLastCommentSpan,
getLastCommentSpan,
getAnns,
)
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
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
}
data SC
= SC
{
SC -> Int
scColumn :: !Int,
SC -> Builder
scBuilder :: Builder,
SC -> SpanStream
scSpanStream :: SpanStream,
:: CommentStream,
:: ![(CommentPosition, Int, Text)],
SC -> Bool
scDirtyLine :: !Bool,
SC -> RequestedDelimiter
scRequestedDelimiter :: !RequestedDelimiter,
:: !(Maybe (Maybe HaddockStyle, RealSrcSpan))
}
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 ->
Bool ->
Text
runR :: R () -> SpanStream -> CommentStream -> Anns -> Bool -> Text
runR (R m :: ReaderT RC (State SC) ()
m) sstream :: SpanStream
sstream cstream :: CommentStream
cstream anns :: Anns
anns recDot :: 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 =
$WRC :: Int -> Layout -> [RealSrcSpan] -> Anns -> Bool -> Bool -> RC
RC
{ rcIndent :: Int
rcIndent = 0,
rcLayout :: Layout
rcLayout = Layout
MultiLine,
rcEnclosingSpans :: [RealSrcSpan]
rcEnclosingSpans = [],
rcAnns :: Anns
rcAnns = Anns
anns,
rcCanUseBraces :: Bool
rcCanUseBraces = Bool
False,
rcUseRecDot :: Bool
rcUseRecDot = Bool
recDot
}
sc :: SC
sc =
$WSC :: Int
-> Builder
-> SpanStream
-> CommentStream
-> [(CommentPosition, Int, Text)]
-> Bool
-> RequestedDelimiter
-> Maybe (Maybe HaddockStyle, RealSrcSpan)
-> SC
SC
{ scColumn :: Int
scColumn = 0,
scBuilder :: Builder
scBuilder = Builder
forall a. Monoid a => a
mempty,
scSpanStream :: SpanStream
scSpanStream = SpanStream
sstream,
scCommentStream :: CommentStream
scCommentStream = CommentStream
cstream,
scPendingComments :: [(CommentPosition, Int, Text)]
scPendingComments = [],
scDirtyLine :: Bool
scDirtyLine = Bool
False,
scRequestedDelimiter :: RequestedDelimiter
scRequestedDelimiter = RequestedDelimiter
VeryBeginning,
scLastCommentSpan :: Maybe (Maybe HaddockStyle, RealSrcSpan)
scLastCommentSpan = Maybe (Maybe HaddockStyle, RealSrcSpan)
forall a. Maybe a
Nothing
}
txt ::
Text ->
R ()
txt :: Text -> R ()
txt = Bool -> Bool -> Text -> R ()
spit Bool
False Bool
False
atom ::
Outputable a =>
a ->
R ()
atom :: a -> R ()
atom = Bool -> Bool -> Text -> R ()
spit Bool
True Bool
False (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 ::
Bool ->
Bool ->
Text ->
R ()
spit :: Bool -> Bool -> Text -> R ()
spit dirty :: Bool
dirty printingComments :: Bool
printingComments txt' :: Text
txt' = 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)
case RequestedDelimiter
requestedDel of
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
sc
{ scRequestedDelimiter :: RequestedDelimiter
scRequestedDelimiter = RequestedDelimiter
RequestedNothing
}
if Bool
printingComments
then R ()
newlineRaw
else R ()
newline
_ -> () -> 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
let spaces :: Text
spaces =
if Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i
then Int -> Text -> Text
T.replicate (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c) " "
else Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
forall a. Monoid a => a
mempty " " (RequestedDelimiter
requestedDel RequestedDelimiter -> RequestedDelimiter -> Bool
forall a. Eq a => a -> a -> Bool
== RequestedDelimiter
RequestedSpace)
indentedTxt :: Text
indentedTxt = Text
spaces Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt'
(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
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,
scDirtyLine :: Bool
scDirtyLine = SC -> Bool
scDirtyLine SC
sc Bool -> Bool -> Bool
|| Bool
dirty,
scRequestedDelimiter :: RequestedDelimiter
scRequestedDelimiter = RequestedDelimiter
RequestedNothing,
scLastCommentSpan :: Maybe (Maybe HaddockStyle, RealSrcSpan)
scLastCommentSpan =
if Bool
printingComments Bool -> Bool -> Bool
|| (Bool -> Bool
not (Bool -> Bool) -> (SC -> Bool) -> SC -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(CommentPosition, Int, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(CommentPosition, Int, Text)] -> Bool)
-> (SC -> [(CommentPosition, Int, Text)]) -> SC -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SC -> [(CommentPosition, Int, Text)]
scPendingComments) SC
sc
then SC -> Maybe (Maybe HaddockStyle, RealSrcSpan)
scLastCommentSpan SC
sc
else Maybe (Maybe HaddockStyle, RealSrcSpan)
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
sc
{ scRequestedDelimiter :: RequestedDelimiter
scRequestedDelimiter = case SC -> RequestedDelimiter
scRequestedDelimiter SC
sc of
RequestedNothing -> RequestedDelimiter
RequestedSpace
other :: RequestedDelimiter
other -> RequestedDelimiter
other
}
newline :: R ()
newline :: R ()
newline = do
[(CommentPosition, Int, Text)]
cs <- [(CommentPosition, Int, Text)] -> [(CommentPosition, Int, Text)]
forall a. [a] -> [a]
reverse ([(CommentPosition, Int, Text)] -> [(CommentPosition, Int, Text)])
-> R [(CommentPosition, Int, Text)]
-> R [(CommentPosition, Int, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT RC (State SC) [(CommentPosition, Int, Text)]
-> R [(CommentPosition, Int, Text)]
forall a. ReaderT RC (State SC) a -> R a
R ((SC -> [(CommentPosition, Int, Text)])
-> ReaderT RC (State SC) [(CommentPosition, Int, Text)]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SC -> [(CommentPosition, Int, Text)]
scPendingComments)
case [(CommentPosition, Int, Text)]
cs of
[] -> R ()
newlineRaw
((position :: CommentPosition
position, _, _) : _) -> do
case CommentPosition
position of
OnTheSameLine -> R ()
space
OnNextLine -> R ()
newlineRaw
ReaderT RC (State SC) () -> R ()
forall a. ReaderT RC (State SC) a -> R a
R (ReaderT RC (State SC) () -> R ())
-> (((CommentPosition, Int, Text) -> ReaderT RC (State SC) ())
-> ReaderT RC (State SC) ())
-> ((CommentPosition, Int, Text) -> ReaderT RC (State SC) ())
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(CommentPosition, Int, Text)]
-> ((CommentPosition, Int, 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, Int, Text)]
cs (((CommentPosition, Int, Text) -> ReaderT RC (State SC) ())
-> R ())
-> ((CommentPosition, Int, Text) -> ReaderT RC (State SC) ())
-> R ()
forall a b. (a -> b) -> a -> b
$ \(_, indent :: Int
indent, txt' :: Text
txt') ->
let modRC :: RC -> RC
modRC rc :: RC
rc =
RC
rc
{ rcIndent :: Int
rcIndent = Int
indent
}
R m :: ReaderT RC (State SC) ()
m = do
Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
txt') (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
Bool -> Bool -> Text -> R ()
spit Bool
False Bool
True Text
txt'
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
sc
{ scPendingComments :: [(CommentPosition, Int, 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
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
AfterNewline -> Builder
builderSoFar
RequestedNewline -> Builder
builderSoFar
VeryBeginning -> Builder
builderSoFar
_ -> Builder
builderSoFar Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> "\n",
scColumn :: Int
scColumn = 0,
scDirtyLine :: Bool
scDirtyLine = Bool
False,
scRequestedDelimiter :: RequestedDelimiter
scRequestedDelimiter = case SC -> RequestedDelimiter
scRequestedDelimiter SC
sc of
AfterNewline -> RequestedDelimiter
RequestedNewline
RequestedNewline -> RequestedDelimiter
RequestedNewline
VeryBeginning -> RequestedDelimiter
VeryBeginning
_ -> RequestedDelimiter
AfterNewline
}
isLineDirty :: R Bool
isLineDirty :: R Bool
isLineDirty = ReaderT RC (State SC) Bool -> R Bool
forall a. ReaderT RC (State SC) a -> R a
R ((SC -> Bool) -> ReaderT RC (State SC) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SC -> Bool
scDirtyLine)
useRecordDot :: R Bool
useRecordDot :: R Bool
useRecordDot = ReaderT RC (State SC) Bool -> R Bool
forall a. ReaderT RC (State SC) a -> R a
R (ReaderT RC (State SC) Bool -> R Bool)
-> ReaderT RC (State SC) Bool -> R Bool
forall a b. (a -> b) -> a -> b
$ (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 (R m :: 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
rc
{ rcIndent :: Int
rcIndent = RC -> Int
rcIndent RC
rc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indentStep
}
sitcc :: R () -> R ()
sitcc :: R () -> R ()
sitcc (R m :: 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
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 0 1 (RequestedDelimiter
requestedDel RequestedDelimiter -> RequestedDelimiter -> Bool
forall a. Eq a => a -> a -> Bool
== RequestedDelimiter
RequestedSpace)
}
R () -> R () -> R ()
forall a. R a -> R a -> R a
vlayout (ReaderT RC (State SC) () -> R ()
forall a. ReaderT RC (State SC) a -> R a
R ReaderT RC (State SC) ()
m) (R () -> R ())
-> (ReaderT RC (State SC) () -> R ())
-> ReaderT RC (State SC) ()
-> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
sc
{ scRequestedDelimiter :: RequestedDelimiter
scRequestedDelimiter = case RequestedDelimiter
requestedDel of
RequestedSpace -> RequestedDelimiter
RequestedNothing
other :: RequestedDelimiter
other -> RequestedDelimiter
other
}
(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 l :: Layout
l (R m :: 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
rc
{ rcLayout :: Layout
rcLayout = Layout
l
}
vlayout ::
R a ->
R a ->
R a
vlayout :: R a -> R a -> R a
vlayout sline :: R a
sline mline :: R a
mline = do
Layout
l <- R Layout
getLayout
case Layout
l of
SingleLine -> R a
sline
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 ()
position :: CommentPosition
position txt' :: Text
txt' = 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
(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
sc
{ scPendingComments :: [(CommentPosition, Int, Text)]
scPendingComments = (CommentPosition
position, Int
i, Text
txt') (CommentPosition, Int, Text)
-> [(CommentPosition, Int, Text)] -> [(CommentPosition, Int, Text)]
forall a. a -> [a] -> [a]
: SC -> [(CommentPosition, Int, Text)]
scPendingComments SC
sc
}
trimSpanStream ::
RealSrcSpan ->
R ()
trimSpanStream :: RealSrcSpan -> R ()
trimSpanStream ref :: RealSrcSpan
ref = do
let leRef :: RealSrcSpan -> Bool
leRef :: RealSrcSpan -> Bool
leRef x :: 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
sc
{ scSpanStream :: SpanStream
scSpanStream = ([RealSrcSpan] -> [RealSrcSpan]) -> SpanStream -> SpanStream
forall a b. Coercible a b => a -> b
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]
forall a b. Coercible a b => a -> b
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))
f :: 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 cstream :: [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
(x :: RealLocated Comment
x : xs :: [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
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 f :: 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 spn :: RealSrcSpan
spn (R m :: 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
rc
{ rcEnclosingSpans :: [RealSrcSpan]
rcEnclosingSpans = RealSrcSpan
spn RealSrcSpan -> [RealSrcSpan] -> [RealSrcSpan]
forall a. a -> [a] -> [a]
: RC -> [RealSrcSpan]
rcEnclosingSpans RC
rc
}
data HaddockStyle
=
Pipe
|
Caret
|
Asterisk Int
|
Named String
setLastCommentSpan ::
Maybe HaddockStyle ->
RealSrcSpan ->
R ()
mhStyle :: Maybe HaddockStyle
mhStyle spn :: RealSrcSpan
spn = 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
sc
{ scLastCommentSpan :: Maybe (Maybe HaddockStyle, RealSrcSpan)
scLastCommentSpan = (Maybe HaddockStyle, RealSrcSpan)
-> Maybe (Maybe HaddockStyle, RealSrcSpan)
forall a. a -> Maybe a
Just (Maybe HaddockStyle
mhStyle, RealSrcSpan
spn)
}
getLastCommentSpan :: R (Maybe (Maybe HaddockStyle, RealSrcSpan))
= ReaderT RC (State SC) (Maybe (Maybe HaddockStyle, RealSrcSpan))
-> R (Maybe (Maybe HaddockStyle, RealSrcSpan))
forall a. ReaderT RC (State SC) a -> R a
R ((SC -> Maybe (Maybe HaddockStyle, RealSrcSpan))
-> ReaderT RC (State SC) (Maybe (Maybe HaddockStyle, RealSrcSpan))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SC -> Maybe (Maybe HaddockStyle, RealSrcSpan)
scLastCommentSpan)
getAnns ::
SrcSpan ->
R [AnnKeywordId]
getAnns :: SrcSpan -> R [AnnKeywordId]
getAnns spn :: 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 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 (\i :: RC
i -> RC
i {rcCanUseBraces :: Bool
rcCanUseBraces = Bool
True}) ReaderT RC (State SC) ()
r)
dontUseBraces :: R () -> R ()
dontUseBraces :: R () -> R ()
dontUseBraces (R 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 (\i :: 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 (ReaderT RC (State SC) Bool -> R Bool)
-> ReaderT RC (State SC) Bool -> R Bool
forall a b. (a -> b) -> a -> b
$ (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 = 2