    module Futhark.Fmt.Monad
      ( Fmt,
        -- functions for building fmt
        nil,
        nest,
        stdNest,
        text,
        space,
        hardline,
        line,
        sep,
        brackets,
        braces,
        parens,
        (<|>),
        (<+>),
        (</>),
        (<:/>),
        hardIndent,
        indent,
        hardStdIndent,
        stdIndent,
        FmtM,
        popComments,
        runFormat,
        align,
        fmtCopyLoc,
        comment,
        sepArgs,
        localLayout,
        localLayoutList,
        sepDecs,
        fmtByLayout,
        addComments,
        sepComments,
        sepLineComments,
        sepLine,

        -- * Formatting styles
        commentStyle,
        constantStyle,
        keywordStyle,
        bindingStyle,
        infixStyle,
      )
    where

    import Control.Monad (liftM2)
    import Control.Monad.Reader
      ( MonadReader (..),
        ReaderT (..),
      )
    import Control.Monad.State
      ( MonadState (..),
        State,
        evalState,
        gets,
        modify,
      )
    import Data.ByteString qualified as BS
    import Data.List.NonEmpty qualified as NE
    import Data.Loc (Loc (..), Located (..), locStart, posCoff, posLine)
    import Data.Maybe (fromMaybe)
    import Data.String
    import Data.Text qualified as T
    import Data.Text.Encoding qualified as T
    import Language.Futhark.Parser.Monad (Comment (..))
    import Prettyprinter qualified as P
    import Prettyprinter.Render.Terminal
      ( AnsiStyle,
        Color (..),
        bold,
        color,
        colorDull,
        italicized,
      )

    -- These are right associative since we want to evaluate the monadic
    -- computation from left to right. Since the left most expression is
    -- printed first and our monad is checking if a comment should be
    -- printed.

    infixr 6 <:/>

    infixr 6 <+>

    infixr 6 </>

    infixr 4 <|>

    type Fmt = FmtM (P.Doc AnsiStyle)

    instance Semigroup Fmt where
      <> :: Fmt -> Fmt -> Fmt
    (<>) = (Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle)
    -> Fmt -> Fmt -> Fmt
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Semigroup a => a -> a -> a
    (<>)

    instance Monoid Fmt where
      mempty :: Fmt
    mempty = Fmt
    nil

    instance IsString Fmt where
      fromString :: String -> Fmt
    fromString String
    s = AnsiStyle -> Text -> Fmt
    text AnsiStyle
    style Text
    s'
        where
          s' :: Text
    s' = String -> Text
    forall a. IsString a => String -> a
    fromString String
    s
          style :: AnsiStyle
    style =
            if Text
    s' Text -> [Text] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Text]
    keywords
              then AnsiStyle
    keywordStyle
              else AnsiStyle
    forall a. Monoid a => a
    mempty
          keywords :: [Text]
    keywords =
            [ Text
    "true",
              Text
    "false",
              Text
    "if",
              Text
    "then",
              Text
    "else",
              Text
    "def",
              Text
    "let",
              Text
    "loop",
              Text
    "in",
              Text
    "val",
              Text
    "for",
              Text
    "do",
              Text
    "with",
              Text
    "local",
              Text
    "open",
              Text
    "include",
              Text
    "import",
              Text
    "type",
              Text
    "entry",
              Text
    "module",
              Text
    "while",
              Text
    "assert",
              Text
    "match",
              Text
    "case"
            ]

    commentStyle, keywordStyle, constantStyle, bindingStyle, infixStyle :: AnsiStyle
    commentStyle :: AnsiStyle
    commentStyle = AnsiStyle
    italicized
    keywordStyle :: AnsiStyle
    keywordStyle = Color -> AnsiStyle
    color Color
    Magenta AnsiStyle -> AnsiStyle -> AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> AnsiStyle
    bold
    constantStyle :: AnsiStyle
    constantStyle = Color -> AnsiStyle
    color Color
    Green
    bindingStyle :: AnsiStyle
    bindingStyle = Color -> AnsiStyle
    colorDull Color
    Blue
    infixStyle :: AnsiStyle
    infixStyle = Color -> AnsiStyle
    colorDull Color
    Cyan

    -- | This function allows to inspect the layout of an expression @a@ and if it
    -- is singleline line then use format @s@ and if it is multiline format @m@.
    fmtByLayout ::
      (Located a) => a -> Fmt -> Fmt -> Fmt
    fmtByLayout :: forall a. Located a => a -> Fmt -> Fmt -> Fmt
    fmtByLayout a
    a Fmt
    s Fmt
    m =
      Fmt
    s
        Fmt -> Fmt -> Fmt
    <|> ( case a -> Maybe Layout
    forall a. Located a => a -> Maybe Layout
    lineLayout a
    a of
                Just Layout
    SingleLine -> Fmt
    s
                Maybe Layout
    _any -> Fmt
    m
            )

    -- | This function determines the Layout of @a@ and updates the monads
    -- environment to format in the appropriate style. It determines this
    -- by checking if the location of @a@ spans over two or more lines.
    localLayout :: (Located a) => a -> FmtM b -> FmtM b
    localLayout :: forall a b. Located a => a -> FmtM b -> FmtM b
    localLayout a
    a = (Layout -> Layout)
    -> ReaderT Layout (State FmtState) b
    -> ReaderT Layout (State FmtState) b
    forall a.
    (Layout -> Layout)
    -> ReaderT Layout (State FmtState) a
    -> ReaderT Layout (State FmtState) a
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local (\Layout
    lo -> Layout -> Maybe Layout -> Layout
    forall a. a -> Maybe a -> a
    fromMaybe Layout
    lo (Maybe Layout -> Layout) -> Maybe Layout -> Layout
    forall a b. (a -> b) -> a -> b
    $ a -> Maybe Layout
    forall a. Located a => a -> Maybe Layout
    lineLayout a
    a)

    -- | This function determines the Layout of @[a]@ and if it is singleline then it
    -- updates the monads enviroment to format singleline style otherwise format using
    -- multiline style. It determines this by checking if the locations of @[a]@
    -- start and end at any different line number.
    localLayoutList :: (Located a) => [a] -> FmtM b -> FmtM b
    localLayoutList :: forall a b. Located a => [a] -> FmtM b -> FmtM b
    localLayoutList [a]
    a FmtM b
    m = do
      Layout
    lo <- ReaderT Layout (State FmtState) Layout
    forall r (m :: * -> *). MonadReader r m => m r
    ask
      case Layout
    lo of
        Layout
    MultiLine -> (Layout -> Layout) -> FmtM b -> FmtM b
    forall a.
    (Layout -> Layout)
    -> ReaderT Layout (State FmtState) a
    -> ReaderT Layout (State FmtState) a
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local (Layout -> Layout -> Layout
    forall a b. a -> b -> a
    const (Layout -> Layout -> Layout) -> Layout -> Layout -> Layout
    forall a b. (a -> b) -> a -> b
    $ Layout -> Maybe Layout -> Layout
    forall a. a -> Maybe a -> a
    fromMaybe Layout
    lo (Maybe Layout -> Layout) -> Maybe Layout -> Layout
    forall a b. (a -> b) -> a -> b
    $ [a] -> Maybe Layout
    forall a. Located a => [a] -> Maybe Layout
    lineLayoutList [a]
    a) FmtM b
    m
        Layout
    SingleLine -> FmtM b
    m

    -- | This function uses the location of @a@ and prepends comments if
    -- the comments location is less than the location of @a@. It format
    -- @b@ in accordance with if @a@ is singleline or multiline using
    -- 'localLayout'. It currently does not handle trailing comment
    -- perfectly. See tests/fmt/traillingComments*.fut.
    addComments :: (Located a) => a -> Fmt -> Fmt
    addComments :: forall a. Located a => a -> Fmt -> Fmt
    addComments a
    a Fmt
    b = a -> Fmt -> Fmt
    forall a b. Located a => a -> FmtM b -> FmtM b
    localLayout a
    a (Fmt -> Fmt) -> Fmt -> Fmt
    forall a b. (a -> b) -> a -> b
    $ do
      Doc AnsiStyle
    c <- a -> Fmt
    forall a. Located a => a -> Fmt
    fmtComments a
    a
      Doc AnsiStyle
    f <- Fmt
    b
      Doc AnsiStyle -> Fmt
    forall a. a -> ReaderT Layout (State FmtState) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Doc AnsiStyle -> Fmt) -> Doc AnsiStyle -> Fmt
    forall a b. (a -> b) -> a -> b
    $ Doc AnsiStyle
    c Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> Doc AnsiStyle
    f

    prependComments :: (a -> Loc) -> (a -> Fmt) -> a -> Fmt
    prependComments :: forall a. (a -> Loc) -> (a -> Fmt) -> a -> Fmt
    prependComments a -> Loc
    floc a -> Fmt
    fmt a
    a = do
      Maybe (Doc AnsiStyle)
    fmcs <- ReaderT Layout (State FmtState) (Maybe (Doc AnsiStyle))
    fcs
      Doc AnsiStyle
    f <- a -> Fmt
    fmt a
    a
      Doc AnsiStyle -> Fmt
    forall a. a -> ReaderT Layout (State FmtState) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Doc AnsiStyle -> Fmt) -> Doc AnsiStyle -> Fmt
    forall a b. (a -> b) -> a -> b
    $ Doc AnsiStyle -> Maybe (Doc AnsiStyle) -> Doc AnsiStyle
    forall a. a -> Maybe a -> a
    fromMaybe Doc AnsiStyle
    forall a. Monoid a => a
    mempty Maybe (Doc AnsiStyle)
    fmcs Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> Doc AnsiStyle
    f
      where
        fcs :: ReaderT Layout (State FmtState) (Maybe (Doc AnsiStyle))
    fcs = do
          FmtState
    s <- ReaderT Layout (State FmtState) FmtState
    forall s (m :: * -> *). MonadState s m => m s
    get
          case FmtState -> [Comment]
    comments FmtState
    s of
            Comment
    c : [Comment]
    cs | a -> Loc
    floc a
    a Loc -> Loc -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Loc
    NoLoc Bool -> Bool -> Bool
    && a -> Loc
    floc a
    a Loc -> Loc -> Bool
    forall a. Ord a => a -> a -> Bool
    > Comment -> Loc
    forall a. Located a => a -> Loc
    locOf Comment
    c -> do
              FmtState -> ReaderT Layout (State FmtState) ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put (FmtState -> ReaderT Layout (State FmtState) ())
    -> FmtState -> ReaderT Layout (State FmtState) ()
    forall a b. (a -> b) -> a -> b
    $ FmtState
    s {comments = cs}
              Maybe (Doc AnsiStyle)
    mcs <- ReaderT Layout (State FmtState) (Maybe (Doc AnsiStyle))
    fcs
              Doc AnsiStyle
    pre' <- Fmt
    pre
              Maybe (Doc AnsiStyle)
    -> ReaderT Layout (State FmtState) (Maybe (Doc AnsiStyle))
    forall a. a -> ReaderT Layout (State FmtState) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe (Doc AnsiStyle)
     -> ReaderT Layout (State FmtState) (Maybe (Doc AnsiStyle)))
    -> Maybe (Doc AnsiStyle)
    -> ReaderT Layout (State FmtState) (Maybe (Doc AnsiStyle))
    forall a b. (a -> b) -> a -> b
    $ Doc AnsiStyle -> Maybe (Doc AnsiStyle)
    forall a. a -> Maybe a
    Just (Doc AnsiStyle -> Maybe (Doc AnsiStyle))
    -> Doc AnsiStyle -> Maybe (Doc AnsiStyle)
    forall a b. (a -> b) -> a -> b
    $ Doc AnsiStyle
    pre' Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> Comment -> Doc AnsiStyle
    forall {ann}. Comment -> Doc ann
    fmtNoLine Comment
    c Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> Doc AnsiStyle
    -> (Doc AnsiStyle -> Doc AnsiStyle)
    -> Maybe (Doc AnsiStyle)
    -> Doc AnsiStyle
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Doc AnsiStyle
    forall a. Monoid a => a
    mempty (Doc AnsiStyle
    forall ann. Doc ann
    P.line <>) Maybe (Doc AnsiStyle)
    mcs
            [Comment]
    _any -> Maybe (Doc AnsiStyle)
    -> ReaderT Layout (State FmtState) (Maybe (Doc AnsiStyle))
    forall a. a -> ReaderT Layout (State FmtState) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (Doc AnsiStyle)
    forall a. Maybe a
    Nothing
        fmtNoLine :: Comment -> Doc ann
    fmtNoLine = Text -> Doc ann
    forall ann. Text -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    P.pretty (Text -> Doc ann) -> (Comment -> Text) -> Comment -> Doc ann
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Comment -> Text
    commentText
        pre :: Fmt
    pre = do
          Maybe LastOutput
    lastO <- (FmtState -> Maybe LastOutput)
    -> ReaderT Layout (State FmtState) (Maybe LastOutput)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets FmtState -> Maybe LastOutput
    lastOutput
          case Maybe LastOutput
    lastO of
            Maybe LastOutput
    Nothing -> Fmt
    nil
            Just LastOutput
    Line -> Fmt
    nil
            Just LastOutput
    _ -> (FmtState -> FmtState) -> ReaderT Layout (State FmtState) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\FmtState
    s -> FmtState
    s {lastOutput = Just Line}) ReaderT Layout (State FmtState) () -> Fmt -> Fmt
    forall a b.
    ReaderT Layout (State FmtState) a
    -> ReaderT Layout (State FmtState) b
    -> ReaderT Layout (State FmtState) b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Fmt
    hardline

    -- | The internal state of the formatter monad 'FmtM'.
    data FmtState = FmtState
      { -- | The comments that will be inserted, ordered by increasing order in regards to location.
        FmtState -> [Comment]
    comments :: [Comment],
        -- | The original source file that is being formatted.
        FmtState -> ByteString
    file :: BS.ByteString,
        -- | Keeps track of what type the last output was.
        FmtState -> Maybe LastOutput
    lastOutput :: !(Maybe LastOutput)
      }
      deriving (Int -> FmtState -> ShowS
    [FmtState] -> ShowS
    FmtState -> String
    (Int -> FmtState -> ShowS)
    -> (FmtState -> String) -> ([FmtState] -> ShowS) -> Show FmtState
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> FmtState -> ShowS
    showsPrec :: Int -> FmtState -> ShowS
    $cshow :: FmtState -> String
    show :: FmtState -> String
    $cshowList :: [FmtState] -> ShowS
    showList :: [FmtState] -> ShowS
    Show, FmtState -> FmtState -> Bool
    (FmtState -> FmtState -> Bool)
    -> (FmtState -> FmtState -> Bool) -> Eq FmtState
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: FmtState -> FmtState -> Bool
    == :: FmtState -> FmtState -> Bool
    $c/= :: FmtState -> FmtState -> Bool
    /= :: FmtState -> FmtState -> Bool
    Eq, Eq FmtState
    Eq FmtState =>
    (FmtState -> FmtState -> Ordering)
    -> (FmtState -> FmtState -> Bool)
    -> (FmtState -> FmtState -> Bool)
    -> (FmtState -> FmtState -> Bool)
    -> (FmtState -> FmtState -> Bool)
    -> (FmtState -> FmtState -> FmtState)
    -> (FmtState -> FmtState -> FmtState)
    -> Ord FmtState
    FmtState -> FmtState -> Bool
    FmtState -> FmtState -> Ordering
    FmtState -> FmtState -> FmtState
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: FmtState -> FmtState -> Ordering
    compare :: FmtState -> FmtState -> Ordering
    $c< :: FmtState -> FmtState -> Bool
    < :: FmtState -> FmtState -> Bool
    $c<= :: FmtState -> FmtState -> Bool
    <= :: FmtState -> FmtState -> Bool
    $c> :: FmtState -> FmtState -> Bool
    > :: FmtState -> FmtState -> Bool
    $c>= :: FmtState -> FmtState -> Bool
    >= :: FmtState -> FmtState -> Bool
    $cmax :: FmtState -> FmtState -> FmtState
    max :: FmtState -> FmtState -> FmtState
    $cmin :: FmtState -> FmtState -> FmtState
    min :: FmtState -> FmtState -> FmtState
    Ord)

    -- | A data type to describe the last output used during formatting.
    data LastOutput = Line | Space | Text | Comm deriving (Int -> LastOutput -> ShowS
    [LastOutput] -> ShowS
    LastOutput -> String
    (Int -> LastOutput -> ShowS)
    -> (LastOutput -> String)
    -> ([LastOutput] -> ShowS)
    -> Show LastOutput
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> LastOutput -> ShowS
    showsPrec :: Int -> LastOutput -> ShowS
    $cshow :: LastOutput -> String
    show :: LastOutput -> String
    $cshowList :: [LastOutput] -> ShowS
    showList :: [LastOutput] -> ShowS
    Show, LastOutput -> LastOutput -> Bool
    (LastOutput -> LastOutput -> Bool)
    -> (LastOutput -> LastOutput -> Bool) -> Eq LastOutput
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: LastOutput -> LastOutput -> Bool
    == :: LastOutput -> LastOutput -> Bool
    $c/= :: LastOutput -> LastOutput -> Bool
    /= :: LastOutput -> LastOutput -> Bool
    Eq, Eq LastOutput
    Eq LastOutput =>
    (LastOutput -> LastOutput -> Ordering)
    -> (LastOutput -> LastOutput -> Bool)
    -> (LastOutput -> LastOutput -> Bool)
    -> (LastOutput -> LastOutput -> Bool)
    -> (LastOutput -> LastOutput -> Bool)
    -> (LastOutput -> LastOutput -> LastOutput)
    -> (LastOutput -> LastOutput -> LastOutput)
    -> Ord LastOutput
    LastOutput -> LastOutput -> Bool
    LastOutput -> LastOutput -> Ordering
    LastOutput -> LastOutput -> LastOutput
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: LastOutput -> LastOutput -> Ordering
    compare :: LastOutput -> LastOutput -> Ordering
    $c< :: LastOutput -> LastOutput -> Bool
    < :: LastOutput -> LastOutput -> Bool
    $c<= :: LastOutput -> LastOutput -> Bool
    <= :: LastOutput -> LastOutput -> Bool
    $c> :: LastOutput -> LastOutput -> Bool
    > :: LastOutput -> LastOutput -> Bool
    $c>= :: LastOutput -> LastOutput -> Bool
    >= :: LastOutput -> LastOutput -> Bool
    $cmax :: LastOutput -> LastOutput -> LastOutput
    max :: LastOutput -> LastOutput -> LastOutput
    $cmin :: LastOutput -> LastOutput -> LastOutput
    min :: LastOutput -> LastOutput -> LastOutput
    Ord)

    -- | A data type to describe the layout the formatter is using currently.
    data Layout = MultiLine | SingleLine deriving (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
    $cshowsPrec :: Int -> Layout -> ShowS
    showsPrec :: Int -> Layout -> ShowS
    $cshow :: Layout -> String
    show :: Layout -> String
    $cshowList :: [Layout] -> ShowS
    showList :: [Layout] -> ShowS
    Show, Layout -> Layout -> Bool
    (Layout -> Layout -> Bool)
    -> (Layout -> Layout -> Bool) -> Eq Layout
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Layout -> Layout -> Bool
    == :: Layout -> Layout -> Bool
    $c/= :: Layout -> Layout -> Bool
    /= :: Layout -> Layout -> Bool
    Eq)

    -- | The format monad used to keep track of comments and layout. It is a a
    -- combincation of a reader and state monad. The comments and reading from the
    -- input file are the state monads job to deal with. While the reader monad
    -- deals with the propagating the current layout.
    type FmtM a = ReaderT Layout (State FmtState) a

    fmtComment :: Comment -> Fmt
    fmtComment :: Comment -> Fmt
    fmtComment Comment
    c = Text -> Fmt
    comment (Text -> Fmt) -> Text -> Fmt
    forall a b. (a -> b) -> a -> b
    $ Comment -> Text
    commentText Comment
    c

    fmtCommentList :: [Comment] -> Fmt
    fmtCommentList :: [Comment] -> Fmt
    fmtCommentList [] = Fmt
    nil
    fmtCommentList (Comment
    c : [Comment]
    cs) =
      (Fmt, Loc) -> Fmt
    forall a b. (a, b) -> a
    fst ((Fmt, Loc) -> Fmt) -> (Fmt, Loc) -> Fmt
    forall a b. (a -> b) -> a -> b
    $ ((Fmt, Loc) -> Comment -> (Fmt, Loc))
    -> (Fmt, Loc) -> [Comment] -> (Fmt, Loc)
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (Fmt, Loc) -> Comment -> (Fmt, Loc)
    f (Comment -> Fmt
    fmtComment Comment
    c, Comment -> Loc
    forall a. Located a => a -> Loc
    locOf Comment
    c) [Comment]
    cs
      where
        f :: (Fmt, Loc) -> Comment -> (Fmt, Loc)
    f (Fmt
    acc, Loc
    loc) Comment
    c' =
          if Loc -> Loc -> Bool
    consecutive Loc
    loc (Comment -> Loc
    forall a. Located a => a -> Loc
    locOf Comment
    c')
            then (Fmt
    acc Fmt -> Fmt -> Fmt
    forall a. Semigroup a => a -> a -> a
    <> Comment -> Fmt
    fmtComment Comment
    c', Comment -> Loc
    forall a. Located a => a -> Loc
    locOf Comment
    c')
            else (Fmt
    acc Fmt -> Fmt -> Fmt
    forall a. Semigroup a => a -> a -> a
    <> Fmt
    hardline Fmt -> Fmt -> Fmt
    forall a. Semigroup a => a -> a -> a
    <> Comment -> Fmt
    fmtComment Comment
    c', Comment -> Loc
    forall a. Located a => a -> Loc
    locOf Comment
    c')

    hasComment :: (Located a) => a -> FmtM Bool
    hasComment :: forall a. Located a => a -> FmtM Bool
    hasComment a
    a =
      (FmtState -> Bool) -> FmtM Bool
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets ((FmtState -> Bool) -> FmtM Bool)
    -> (FmtState -> Bool) -> FmtM Bool
    forall a b. (a -> b) -> a -> b
    $ Bool -> Bool
    not (Bool -> Bool) -> (FmtState -> Bool) -> FmtState -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Comment] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([Comment] -> Bool) -> (FmtState -> [Comment]) -> FmtState -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Comment -> Bool) -> [Comment] -> [Comment]
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile Comment -> Bool
    forall {a}. Located a => a -> Bool
    relevant ([Comment] -> [Comment])
    -> (FmtState -> [Comment]) -> FmtState -> [Comment]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FmtState -> [Comment]
    comments
      where
        relevant :: a -> Bool
    relevant a
    c = a -> Loc
    forall a. Located a => a -> Loc
    locOf a
    a Loc -> Loc -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Loc
    NoLoc Bool -> Bool -> Bool
    && a -> Loc
    forall a. Located a => a -> Loc
    locOf a
    a Loc -> Loc -> Bool
    forall a. Ord a => a -> a -> Bool
    > a -> Loc
    forall a. Located a => a -> Loc
    locOf a
    c

    -- | Prepends comments.
    fmtComments :: (Located a) => a -> Fmt
    fmtComments :: forall a. Located a => a -> Fmt
    fmtComments a
    a = do
      ([Comment]
    here, [Comment]
    later) <- (FmtState -> ([Comment], [Comment]))
    -> ReaderT Layout (State FmtState) ([Comment], [Comment])
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets ((FmtState -> ([Comment], [Comment]))
     -> ReaderT Layout (State FmtState) ([Comment], [Comment]))
    -> (FmtState -> ([Comment], [Comment]))
    -> ReaderT Layout (State FmtState) ([Comment], [Comment])
    forall a b. (a -> b) -> a -> b
    $ (Comment -> Bool) -> [Comment] -> ([Comment], [Comment])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span Comment -> Bool
    forall {a}. Located a => a -> Bool
    relevant ([Comment] -> ([Comment], [Comment]))
    -> (FmtState -> [Comment]) -> FmtState -> ([Comment], [Comment])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FmtState -> [Comment]
    comments
      if [Comment] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Comment]
    here
        then Doc AnsiStyle -> Fmt
    forall a. a -> ReaderT Layout (State FmtState) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Doc AnsiStyle
    forall a. Monoid a => a
    mempty
        else do
          (FmtState -> FmtState) -> ReaderT Layout (State FmtState) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((FmtState -> FmtState) -> ReaderT Layout (State FmtState) ())
    -> (FmtState -> FmtState) -> ReaderT Layout (State FmtState) ()
    forall a b. (a -> b) -> a -> b
    $ \FmtState
    s -> FmtState
    s {comments = later}
          [Comment] -> Fmt
    fmtCommentList [Comment]
    here
            Fmt -> Fmt -> Fmt
    forall a. Semigroup a => a -> a -> a
    <> if Loc -> Loc -> Bool
    consecutive ([Comment] -> Loc
    forall a. Located a => a -> Loc
    locOf [Comment]
    here) (a -> Loc
    forall a. Located a => a -> Loc
    locOf a
    a) then Fmt
    nil else Fmt
    hardline
      where
        relevant :: a -> Bool
    relevant a
    c = a -> Loc
    forall a. Located a => a -> Loc
    locOf a
    a Loc -> Loc -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Loc
    NoLoc Bool -> Bool -> Bool
    && a -> Loc
    forall a. Located a => a -> Loc
    locOf a
    a Loc -> Loc -> Bool
    forall a. Ord a => a -> a -> Bool
    > a -> Loc
    forall a. Located a => a -> Loc
    locOf a
    c

    -- | Determines the layout of @a@ by checking if it spans a single line or two
    -- or more lines.
    lineLayout :: (Located a) => a -> Maybe Layout
    lineLayout :: forall a. Located a => a -> Maybe Layout
    lineLayout a
    a =
      case a -> Loc
    forall a. Located a => a -> Loc
    locOf a
    a of
        Loc Pos
    start Pos
    end ->
          if Pos -> Int
    posLine Pos
    start Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Pos -> Int
    posLine Pos
    end
            then Layout -> Maybe Layout
    forall a. a -> Maybe a
    Just Layout
    SingleLine
            else Layout -> Maybe Layout
    forall a. a -> Maybe a
    Just Layout
    MultiLine
        Loc
    NoLoc -> Maybe Layout
    forall a. Maybe a
    Nothing -- error "Formatting term without location."

    -- | Determines the layout of @[a]@ by checking if it spans a single line or two
    -- or more lines.
    lineLayoutList :: (Located a) => [a] -> Maybe Layout
    lineLayoutList :: forall a. Located a => [a] -> Maybe Layout
    lineLayoutList [a]
    as =
      case (a -> [Int]) -> [a] -> [Int]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap a -> [Int]
    forall {a}. Located a => a -> [Int]
    auxiliary [a]
    as of
        [] -> Maybe Layout
    forall a. Maybe a
    Nothing
        (Int
    t : [Int]
    ts) | (Int -> Bool) -> [Int] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    t) [Int]
    ts -> Layout -> Maybe Layout
    forall a. a -> Maybe a
    Just Layout
    MultiLine
        [Int]
    _ -> Layout -> Maybe Layout
    forall a. a -> Maybe a
    Just Layout
    SingleLine
      where
        auxiliary :: a -> [Int]
    auxiliary a
    a =
          case a -> Loc
    forall a. Located a => a -> Loc
    locOf a
    a of
            Loc Pos
    start Pos
    end -> [Pos -> Int
    posLine Pos
    start, Pos -> Int
    posLine Pos
    end]
            Loc
    NoLoc -> [] -- error "Formatting term without location"

    -- | Retrieves the last comments from the monad and concatenates them together.
    popComments :: Fmt
    popComments :: Fmt
    popComments = do
      [Comment]
    cs <- (FmtState -> [Comment])
    -> ReaderT Layout (State FmtState) [Comment]
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets FmtState -> [Comment]
    comments
      (FmtState -> FmtState) -> ReaderT Layout (State FmtState) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\FmtState
    s -> FmtState
    s {comments = []})
      Maybe LastOutput
    lastO <- (FmtState -> Maybe LastOutput)
    -> ReaderT Layout (State FmtState) (Maybe LastOutput)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets FmtState -> Maybe LastOutput
    lastOutput
      case Maybe LastOutput
    lastO of
        Maybe LastOutput
    Nothing ->
          [Comment] -> Fmt
    fmtCommentList [Comment]
    cs -- Happens when file has only comments.
        Maybe LastOutput
    _
          | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ [Comment] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Comment]
    cs -> Fmt
    hardline Fmt -> Fmt -> Fmt
    forall a. Semigroup a => a -> a -> a
    <> [Comment] -> Fmt
    fmtCommentList [Comment]
    cs
          | Bool
    otherwise -> Fmt
    nil

    -- | Using the location of @a@ get the segment of text in the original file to
    -- create a @Fmt@.
    fmtCopyLoc :: (Located a) => AnsiStyle -> a -> Fmt
    fmtCopyLoc :: forall a. Located a => AnsiStyle -> a -> Fmt
    fmtCopyLoc AnsiStyle
    style a
    a = do
      ByteString
    f <- (FmtState -> ByteString)
    -> ReaderT Layout (State FmtState) ByteString
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets FmtState -> ByteString
    file
      case a -> Loc
    forall a. Located a => a -> Loc
    locOf a
    a of
        Loc Pos
    sPos Pos
    ePos ->
          let sOff :: Int
    sOff = Pos -> Int
    posCoff Pos
    sPos
              eOff :: Int
    eOff = Pos -> Int
    posCoff Pos
    ePos
           in case ByteString -> Either UnicodeException Text
    T.decodeUtf8' (ByteString -> Either UnicodeException Text)
    -> ByteString -> Either UnicodeException Text
    forall a b. (a -> b) -> a -> b
    $ Int -> ByteString -> ByteString
    BS.take (Int
    eOff Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    sOff) (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Int -> ByteString -> ByteString
    BS.drop Int
    sOff ByteString
    f of
                Left UnicodeException
    err -> String -> Fmt
    forall a. HasCallStack => String -> a
    error (String -> Fmt) -> String -> Fmt
    forall a b. (a -> b) -> a -> b
    $ UnicodeException -> String
    forall a. Show a => a -> String
    show UnicodeException
    err
                Right Text
    lit -> AnsiStyle -> Text -> Fmt
    text AnsiStyle
    style Text
    lit
        Loc
    NoLoc -> String -> Fmt
    forall a. HasCallStack => String -> a
    error String
    "Formatting term without location"

    -- | Given a formatter @FmtM a@, a sequence of comments ordered in increasing
    -- order by location, and the original text files content. Run the formatter and
    -- create @a@.
    runFormat :: FmtM a -> [Comment] -> T.Text -> a
    runFormat :: forall a. FmtM a -> [Comment] -> Text -> a
    runFormat FmtM a
    format [Comment]
    cs Text
    file = State FmtState a -> FmtState -> a
    forall s a. State s a -> s -> a
    evalState (FmtM a -> Layout -> State FmtState a
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT FmtM a
    format Layout
    e) FmtState
    s
      where
        s :: FmtState
    s =
          FmtState
            { comments :: [Comment]
    comments = [Comment]
    cs,
              file :: ByteString
    file = Text -> ByteString
    T.encodeUtf8 Text
    file,
              lastOutput :: Maybe LastOutput
    lastOutput = Maybe LastOutput
    forall a. Maybe a
    Nothing
            }
        e :: Layout
    e = Layout
    MultiLine

    -- | An empty input.
    nil :: Fmt
    nil :: Fmt
    nil = Doc AnsiStyle -> Fmt
    forall a. a -> ReaderT Layout (State FmtState) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Doc AnsiStyle
    forall a. Monoid a => a
    mempty

    -- | Indents everything after a line occurs if in multiline and if in singleline
    -- then indent.
    nest :: Int -> Fmt -> Fmt
    nest :: Int -> Fmt -> Fmt
    nest Int
    i Fmt
    a = Fmt
    a Fmt -> Fmt -> Fmt
    <|> (Int -> Doc AnsiStyle -> Doc AnsiStyle
    forall ann. Int -> Doc ann -> Doc ann
    P.nest Int
    i (Doc AnsiStyle -> Doc AnsiStyle) -> Fmt -> Fmt
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Fmt
    a)

    -- | A space.
    space :: Fmt
    space :: Fmt
    space = (FmtState -> FmtState) -> ReaderT Layout (State FmtState) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\FmtState
    s -> FmtState
    s {lastOutput = Just Space}) ReaderT Layout (State FmtState) () -> Fmt -> Fmt
    forall a b.
    ReaderT Layout (State FmtState) a
    -> ReaderT Layout (State FmtState) b
    -> ReaderT Layout (State FmtState) b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Doc AnsiStyle -> Fmt
    forall a. a -> ReaderT Layout (State FmtState) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Doc AnsiStyle
    forall ann. Doc ann
    P.space

    -- | Forces a line to be used regardless of layout, this should
    -- ideally not be used.
    hardline :: Fmt
    hardline :: Fmt
    hardline = do
      (FmtState -> FmtState) -> ReaderT Layout (State FmtState) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((FmtState -> FmtState) -> ReaderT Layout (State FmtState) ())
    -> (FmtState -> FmtState) -> ReaderT Layout (State FmtState) ()
    forall a b. (a -> b) -> a -> b
    $ \FmtState
    s -> FmtState
    s {lastOutput = Just Line}
      Doc AnsiStyle -> Fmt
    forall a. a -> ReaderT Layout (State FmtState) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Doc AnsiStyle
    forall ann. Doc ann
    P.line

    -- | A line or a space depending on layout.
    line :: Fmt
    line :: Fmt
    line = Fmt
    space Fmt -> Fmt -> Fmt
    <|> Fmt
    hardline

    -- | Seperates element by a @s@ followed by a space in singleline layout and
    -- seperates by a line followed by a @s@ in multine layout.
    sepLine :: Fmt -> [Fmt] -> Fmt
    sepLine :: Fmt -> [Fmt] -> Fmt
    sepLine Fmt
    s = Fmt -> [Fmt] -> Fmt
    sep (Fmt
    s Fmt -> Fmt -> Fmt
    forall a. Semigroup a => a -> a -> a
    <> Fmt
    space Fmt -> Fmt -> Fmt
    <|> Fmt
    hardline Fmt -> Fmt -> Fmt
    forall a. Semigroup a => a -> a -> a
    <> Fmt
    s)

    -- | A comment.
    comment :: T.Text -> Fmt
    comment :: Text -> Fmt
    comment Text
    c = do
      (FmtState -> FmtState) -> ReaderT Layout (State FmtState) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\FmtState
    s -> FmtState
    s {lastOutput = Just Line})
      Doc AnsiStyle -> Fmt
    forall a. a -> ReaderT Layout (State FmtState) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Doc AnsiStyle -> Fmt) -> Doc AnsiStyle -> Fmt
    forall a b. (a -> b) -> a -> b
    $ AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall ann. ann -> Doc ann -> Doc ann
    P.annotate AnsiStyle
    commentStyle (Text -> Doc AnsiStyle
    forall ann. Text -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    P.pretty (Text -> Text
    T.stripEnd Text
    c)) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall a. Semigroup a => a -> a -> a
    <> Doc AnsiStyle
    forall ann. Doc ann
    P.line

    sep :: Fmt -> [Fmt] -> Fmt
    sep :: Fmt -> [Fmt] -> Fmt
    sep Fmt
    _ [] = Fmt
    nil
    sep Fmt
    s (Fmt
    a : [Fmt]
    as) = Fmt -> [Fmt] -> Fmt
    auxiliary Fmt
    a [Fmt]
    as
      where
        auxiliary :: Fmt -> [Fmt] -> Fmt
    auxiliary Fmt
    acc [] = Fmt
    acc
        auxiliary Fmt
    acc (Fmt
    x : [Fmt]
    xs) = Fmt -> [Fmt] -> Fmt
    auxiliary (Fmt
    acc Fmt -> Fmt -> Fmt
    forall a. Semigroup a => a -> a -> a
    <> Fmt
    s Fmt -> Fmt -> Fmt
    forall a. Semigroup a => a -> a -> a
    <> Fmt
    x) [Fmt]
    xs

    sepComments :: (a -> Loc) -> (a -> Fmt) -> Fmt -> [a] -> Fmt
    sepComments :: forall a. (a -> Loc) -> (a -> Fmt) -> Fmt -> [a] -> Fmt
    sepComments a -> Loc
    _ a -> Fmt
    _ Fmt
    _ [] = Fmt
    nil
    sepComments a -> Loc
    floc a -> Fmt
    fmt Fmt
    s (a
    a : [a]
    as) = Fmt -> [a] -> Fmt
    auxiliary (a -> Fmt
    fmt a
    a) [a]
    as
      where
        auxiliary :: Fmt -> [a] -> Fmt
    auxiliary Fmt
    acc [] = Fmt
    acc
        auxiliary Fmt
    acc (a
    x : [a]
    xs) =
          Fmt -> [a] -> Fmt
    auxiliary (Fmt
    acc Fmt -> Fmt -> Fmt
    forall a. Semigroup a => a -> a -> a
    <> (a -> Loc) -> (a -> Fmt) -> a -> Fmt
    forall a. (a -> Loc) -> (a -> Fmt) -> a -> Fmt
    prependComments a -> Loc
    floc (\a
    y -> Fmt
    s Fmt -> Fmt -> Fmt
    forall a. Semigroup a => a -> a -> a
    <> a -> Fmt
    fmt a
    y) a
    x) [a]
    xs

    sepLineComments :: (a -> Loc) -> (a -> Fmt) -> Fmt -> [a] -> Fmt
    sepLineComments :: forall a. (a -> Loc) -> (a -> Fmt) -> Fmt -> [a] -> Fmt
    sepLineComments a -> Loc
    floc a -> Fmt
    fmt Fmt
    s =
      (a -> Loc) -> (a -> Fmt) -> Fmt -> [a] -> Fmt
    forall a. (a -> Loc) -> (a -> Fmt) -> Fmt -> [a] -> Fmt
    sepComments a -> Loc
    floc a -> Fmt
    fmt (Fmt
    s Fmt -> Fmt -> Fmt
    forall a. Semigroup a => a -> a -> a
    <> Fmt
    space Fmt -> Fmt -> Fmt
    <|> Fmt
    hardline Fmt -> Fmt -> Fmt
    forall a. Semigroup a => a -> a -> a
    <> Fmt
    s)

    -- | This is used for function arguments. It seperates multiline
    -- arguments by lines and singleline arguments by spaces. We specially
    -- handle the case where all the arguments are on a single line except
    -- for the last one, which may continue to the next line.
    sepArgs :: (Located a) => (a -> Fmt) -> NE.NonEmpty a -> Fmt
    sepArgs :: forall a. Located a => (a -> Fmt) -> NonEmpty a -> Fmt
    sepArgs a -> Fmt
    fmt NonEmpty a
    ls =
      [Loc] -> Fmt -> Fmt
    forall a b. Located a => a -> FmtM b -> FmtM b
    localLayout [Loc]
    locs (Fmt -> Fmt) -> Fmt -> Fmt
    forall a b. (a -> b) -> a -> b
    $ Fmt -> Fmt
    align' (Fmt -> Fmt) -> Fmt -> Fmt
    forall a b. (a -> b) -> a -> b
    $ Fmt -> [Fmt] -> Fmt
    sep Fmt
    line ([Fmt] -> Fmt) -> [Fmt] -> Fmt
    forall a b. (a -> b) -> a -> b
    $ (a -> Fmt) -> [a] -> [Fmt]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> Fmt
    fmtArg [a]
    ls'
      where
        locs :: [Loc]
    locs = (a -> Loc) -> [a] -> [Loc]
    forall a b. (a -> b) -> [a] -> [b]
    map (Loc -> Loc
    locStart (Loc -> Loc) -> (a -> Loc) -> a -> Loc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Loc
    forall a. Located a => a -> Loc
    locOf) [a]
    ls'
        align' :: Fmt -> Fmt
    align' = case [Loc] -> Maybe Layout
    forall a. Located a => a -> Maybe Layout
    lineLayout [Loc]
    locs of
          Just Layout
    SingleLine -> Fmt -> Fmt
    forall a. a -> a
    id
          Maybe Layout
    _ -> Fmt -> Fmt
    align
        fmtArg :: a -> Fmt
    fmtArg a
    x = a -> Fmt -> Fmt
    forall a b. Located a => a -> FmtM b -> FmtM b
    localLayout a
    x (Fmt -> Fmt) -> Fmt -> Fmt
    forall a b. (a -> b) -> a -> b
    $ a -> Fmt
    fmt a
    x
        ls' :: [a]
    ls' = NonEmpty a -> [a]
    forall a. NonEmpty a -> [a]
    NE.toList NonEmpty a
    ls

    -- | Nest but with the standard value of two spaces.
    stdNest :: Fmt -> Fmt
    stdNest :: Fmt -> Fmt
    stdNest = Int -> Fmt -> Fmt
    nest Int
    2

    -- | Aligns line by line.
    align :: Fmt -> Fmt
    align :: Fmt -> Fmt
    align Fmt
    a = do
      (FmtState -> FmtState) -> ReaderT Layout (State FmtState) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\FmtState
    s -> FmtState
    s {lastOutput = Just Line}) -- XXX?
      Doc AnsiStyle -> Doc AnsiStyle
    forall ann. Doc ann -> Doc ann
    P.align (Doc AnsiStyle -> Doc AnsiStyle) -> Fmt -> Fmt
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Fmt
    a

    -- | Indents everything by @i@, should never be used.
    hardIndent :: Int -> Fmt -> Fmt
    hardIndent :: Int -> Fmt -> Fmt
    hardIndent Int
    i Fmt
    a = Int -> Doc AnsiStyle -> Doc AnsiStyle
    forall ann. Int -> Doc ann -> Doc ann
    P.indent Int
    i (Doc AnsiStyle -> Doc AnsiStyle) -> Fmt -> Fmt
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Fmt
    a

    -- | Indents if in multiline by @i@ if in singleline it does not indent.
    indent :: Int -> Fmt -> Fmt
    indent :: Int -> Fmt -> Fmt
    indent Int
    i Fmt
    a = Fmt
    a Fmt -> Fmt -> Fmt
    <|> Int -> Fmt -> Fmt
    hardIndent Int
    i Fmt
    a

    -- | Hard indents with the standard size of two.
    hardStdIndent :: Fmt -> Fmt
    hardStdIndent :: Fmt -> Fmt
    hardStdIndent = Int -> Fmt -> Fmt
    hardIndent Int
    2

    -- | Idents with the standard size of two.
    stdIndent :: Fmt -> Fmt
    stdIndent :: Fmt -> Fmt
    stdIndent = Int -> Fmt -> Fmt
    indent Int
    2

    -- | Creates a piece of text, it should not contain any new lines.
    text :: AnsiStyle -> T.Text -> Fmt
    text :: AnsiStyle -> Text -> Fmt
    text AnsiStyle
    style Text
    t = do
      (FmtState -> FmtState) -> ReaderT Layout (State FmtState) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\FmtState
    s -> FmtState
    s {lastOutput = Just Text})
      Doc AnsiStyle -> Fmt
    forall a. a -> ReaderT Layout (State FmtState) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Doc AnsiStyle -> Fmt) -> Doc AnsiStyle -> Fmt
    forall a b. (a -> b) -> a -> b
    $ AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
    forall ann. ann -> Doc ann -> Doc ann
    P.annotate AnsiStyle
    style (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
    forall a b. (a -> b) -> a -> b
    $ Text -> Doc AnsiStyle
    forall ann. Text -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    P.pretty Text
    t

    -- | Adds brackets.
    brackets :: Fmt -> Fmt
    brackets :: Fmt -> Fmt
    brackets Fmt
    a = Fmt
    "[" Fmt -> Fmt -> Fmt
    forall a. Semigroup a => a -> a -> a
    <> Fmt
    a Fmt -> Fmt -> Fmt
    forall a. Semigroup a => a -> a -> a
    <> Fmt
    "]"

    -- | Adds braces.
    braces :: Fmt -> Fmt
    braces :: Fmt -> Fmt
    braces Fmt
    a = Fmt
    "{" Fmt -> Fmt -> Fmt
    forall a. Semigroup a => a -> a -> a
    <> Fmt
    a Fmt -> Fmt -> Fmt
    forall a. Semigroup a => a -> a -> a
    <> Fmt
    "}"

    -- | Add parenthesis.
    parens :: Fmt -> Fmt
    parens :: Fmt -> Fmt
    parens Fmt
    a = Fmt
    "(" Fmt -> Fmt -> Fmt
    forall a. Semigroup a => a -> a -> a
    <> Fmt
    a Fmt -> Fmt -> Fmt
    forall a. Semigroup a => a -> a -> a
    <> Fmt
    ")"

    -- | If in a singleline layout then concatenate with 'nil' and in multiline
    -- concatenate by a line.
    (<:/>) :: Fmt -> Fmt -> Fmt
    Fmt
    a <:/> :: Fmt -> Fmt -> Fmt
    <:/> Fmt
    b = Fmt
    a Fmt -> Fmt -> Fmt
    forall a. Semigroup a => a -> a -> a
    <> (Fmt
    nil Fmt -> Fmt -> Fmt
    <|> Fmt
    hardline) Fmt -> Fmt -> Fmt
    forall a. Semigroup a => a -> a -> a
    <> Fmt
    b

    -- | Concatenate with a space between.
    (<+>) :: Fmt -> Fmt -> Fmt
    Fmt
    a <+> :: Fmt -> Fmt -> Fmt
    <+> Fmt
    b = Fmt
    a Fmt -> Fmt -> Fmt
    forall a. Semigroup a => a -> a -> a
    <> Fmt
    space Fmt -> Fmt -> Fmt
    forall a. Semigroup a => a -> a -> a
    <> Fmt
    b

    -- | Concatenate with a space if in singleline layout and concatenate by a
    -- line in multiline.
    (</>) :: Fmt -> Fmt -> Fmt
    Fmt
    a </> :: Fmt -> Fmt -> Fmt
    </> Fmt
    b = Fmt
    a Fmt -> Fmt -> Fmt
    forall a. Semigroup a => a -> a -> a
    <> Fmt
    line Fmt -> Fmt -> Fmt
    forall a. Semigroup a => a -> a -> a
    <> Fmt
    b

    -- | If in a singleline layout then choose @a@, if in a multiline layout choose
    -- @b@.
    (<|>) :: Fmt -> Fmt -> Fmt
    Fmt
    a <|> :: Fmt -> Fmt -> Fmt
    <|> Fmt
    b = do
      Layout
    lo <- ReaderT Layout (State FmtState) Layout
    forall r (m :: * -> *). MonadReader r m => m r
    ask
      if Layout
    lo Layout -> Layout -> Bool
    forall a. Eq a => a -> a -> Bool
    == Layout
    SingleLine
        then Fmt
    a
        else Fmt
    b

    -- | Are these locations on consecutive lines?
    consecutive :: Loc -> Loc -> Bool
    consecutive :: Loc -> Loc -> Bool
    consecutive (Loc Pos
    _ Pos
    end) (Loc Pos
    beg Pos
    _) = Pos -> Int
    posLine Pos
    end Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Pos -> Int
    posLine Pos
    beg
    consecutive Loc
    _ Loc
    _ = Bool
    False

    -- | If in singleline layout seperate by spaces. In a multiline layout seperate
    -- by a single line if two neighbouring elements are singleline. Otherwise
    -- sepereate by two lines.
    sepDecs :: (Located a) => (a -> Fmt) -> [a] -> Fmt
    sepDecs :: forall a. Located a => (a -> Fmt) -> [a] -> Fmt
    sepDecs a -> Fmt
    _ [] = Fmt
    nil
    sepDecs a -> Fmt
    fmt decs :: [a]
    decs@(a
    x : [a]
    xs) =
      Fmt -> [Fmt] -> Fmt
    sep Fmt
    space ((a -> Fmt) -> [a] -> [Fmt]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> Fmt
    fmt [a]
    decs) Fmt -> Fmt -> Fmt
    <|> (a -> Fmt
    fmt a
    x Fmt -> Fmt -> Fmt
    forall a. Semigroup a => a -> a -> a
    <> a -> [a] -> Fmt
    auxiliary a
    x [a]
    xs)
      where
        auxiliary :: a -> [a] -> Fmt
    auxiliary a
    _ [] = Fmt
    nil
        auxiliary a
    prev (a
    y : [a]
    ys) = Fmt
    p Fmt -> Fmt -> Fmt
    forall a. Semigroup a => a -> a -> a
    <> a -> Fmt
    fmt a
    y Fmt -> Fmt -> Fmt
    forall a. Semigroup a => a -> a -> a
    <> a -> [a] -> Fmt
    auxiliary a
    y [a]
    ys
          where
            p :: Fmt
    p = do
              Bool
    commented <- a -> FmtM Bool
    forall a. Located a => a -> FmtM Bool
    hasComment a
    y
              case (Bool
    commented, a -> Maybe Layout
    forall a. Located a => a -> Maybe Layout
    lineLayout a
    y, a -> Maybe Layout
    forall a. Located a => a -> Maybe Layout
    lineLayout a
    prev) of
                (Bool
    False, Just Layout
    SingleLine, Just Layout
    SingleLine)
                  | Loc -> Loc -> Bool
    consecutive (a -> Loc
    forall a. Located a => a -> Loc
    locOf a
    prev) (a -> Loc
    forall a. Located a => a -> Loc
    locOf a
    y) -> Fmt
    hardline
                (Bool, Maybe Layout, Maybe Layout)
    _any -> Fmt
    hardline Fmt -> Fmt -> Fmt
    forall a. Semigroup a => a -> a -> a
    <> Fmt
    hardline