{-# LANGUAGE DataKinds #-}

module Language.Haskell.Brittany.Internal
  ( parsePrintModule
  , parsePrintModuleTests
  , pPrintModule
  , pPrintModuleAndCheck
   -- re-export from utils:
  , parseModule
  , parseModuleFromString
  , extractCommentConfigs
  , getTopLevelDeclNameMap
  )
where



#include "prelude.inc"

-- brittany { lconfig_importAsColumn: 60, lconfig_importColumn: 60 }
import qualified Language.Haskell.GHC.ExactPrint         as ExactPrint
import qualified Language.Haskell.GHC.ExactPrint.Types   as ExactPrint
import qualified Language.Haskell.GHC.ExactPrint.Parsers as ExactPrint.Parsers

import           Data.Data
import           Control.Monad.Trans.Except
import           Data.HList.HList
import qualified Data.Yaml
import qualified Data.ByteString.Char8
import           Data.CZipWith
import qualified UI.Butcher.Monadic                      as Butcher

import qualified Data.Text.Lazy.Builder                  as Text.Builder

import           Language.Haskell.Brittany.Internal.Types
import           Language.Haskell.Brittany.Internal.Config.Types
import           Language.Haskell.Brittany.Internal.Config
import           Language.Haskell.Brittany.Internal.LayouterBasics

import           Language.Haskell.Brittany.Internal.Layouters.Type
import           Language.Haskell.Brittany.Internal.Layouters.Decl
import           Language.Haskell.Brittany.Internal.Layouters.Module
import           Language.Haskell.Brittany.Internal.Utils
import           Language.Haskell.Brittany.Internal.Backend
import           Language.Haskell.Brittany.Internal.BackendUtils
import           Language.Haskell.Brittany.Internal.ExactPrintUtils

import           Language.Haskell.Brittany.Internal.Transformations.Alt
import           Language.Haskell.Brittany.Internal.Transformations.Floating
import           Language.Haskell.Brittany.Internal.Transformations.Par
import           Language.Haskell.Brittany.Internal.Transformations.Columns
import           Language.Haskell.Brittany.Internal.Transformations.Indent

import qualified GHC                           as GHC
                                                   hiding ( parseModule )
import           ApiAnnotation                            ( AnnKeywordId(..) )
import           GHC                                      ( Located
                                                          , runGhc
                                                          , GenLocated(L)
                                                          , moduleNameString
                                                          )
import           RdrName                                  ( RdrName(..) )
import           SrcLoc                                   ( SrcSpan )
#if MIN_VERSION_ghc(8,10,1)   /* ghc-8.10.1 */
import           GHC.Hs
import           Bag
#else
import           HsSyn
#endif
import qualified DynFlags                                as GHC
import qualified GHC.LanguageExtensions.Type             as GHC

import           Data.Char                                ( isSpace )



data InlineConfigTarget
    = InlineConfigTargetModule
    | InlineConfigTargetNextDecl    -- really only next in module
    | InlineConfigTargetNextBinding -- by name
    | InlineConfigTargetBinding String

extractCommentConfigs
  :: ExactPrint.Anns
  -> TopLevelDeclNameMap
  -> Either (String, String) (CConfig Option, PerItemConfig)
extractCommentConfigs :: Anns
-> TopLevelDeclNameMap
-> Either (String, String) (CConfig Option, PerItemConfig)
extractCommentConfigs Anns
anns (TopLevelDeclNameMap Map AnnKey String
declNameMap) = do
  let
    commentLiness :: [(AnnKey, [String])]
commentLiness =
      [ ( AnnKey
k
        , [ String
x
          | (ExactPrint.Comment String
x AnnSpan
_ Maybe AnnKeywordId
_, DeltaPos
_) <-
            (  Annotation -> [(Comment, DeltaPos)]
ExactPrint.annPriorComments Annotation
ann
            [(Comment, DeltaPos)]
-> [(Comment, DeltaPos)] -> [(Comment, DeltaPos)]
forall a. [a] -> [a] -> [a]
++ Annotation -> [(Comment, DeltaPos)]
ExactPrint.annFollowingComments Annotation
ann
            )
          ]
          [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
x
             | (ExactPrint.AnnComment (ExactPrint.Comment String
x AnnSpan
_ Maybe AnnKeywordId
_), DeltaPos
_) <-
               Annotation -> [(KeywordId, DeltaPos)]
ExactPrint.annsDP Annotation
ann
             ]
        )
      | (AnnKey
k, Annotation
ann) <- Anns -> [(AnnKey, Annotation)]
forall k a. Map k a -> [(k, a)]
Map.toList Anns
anns
      ]
  let configLiness :: [(AnnKey, [String])]
configLiness = [(AnnKey, [String])]
commentLiness [(AnnKey, [String])]
-> ((AnnKey, [String]) -> (AnnKey, [String]))
-> [(AnnKey, [String])]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ([String] -> [String]) -> (AnnKey, [String]) -> (AnnKey, [String])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second
        ((String -> Maybe String) -> [String] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
Data.Maybe.mapMaybe ((String -> Maybe String) -> [String] -> [String])
-> (String -> Maybe String) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ \String
line -> do
          String
l1 <-
            String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
List.stripPrefix String
"-- BRITTANY" String
line
            Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
List.stripPrefix String
"--BRITTANY" String
line
            Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
List.stripPrefix String
"-- brittany" String
line
            Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
List.stripPrefix String
"--brittany" String
line
            Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
List.stripPrefix String
"{- BRITTANY" String
line Maybe String -> (String -> Maybe String) -> Maybe String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripSuffix String
"-}")
          let l2 :: String
l2 = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
l1
          Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard
            (  (String
"@" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
l2)
            Bool -> Bool -> Bool
|| (String
"-disable" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
l2)
            Bool -> Bool -> Bool
|| (String
"-next" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
l2)
            Bool -> Bool -> Bool
|| (String
"{" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
l2)
            Bool -> Bool -> Bool
|| (String
"--" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
l2)
            )
          String -> Maybe String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
l2
        )
  let
    configParser :: CmdParser Identity out (CConfig Option)
configParser = [(String, String -> Bool, CmdParser Identity out (CConfig Option))]
-> CmdParser Identity out (CConfig Option)
forall p (f :: * -> *) out.
Typeable p =>
[(String, String -> Bool, CmdParser f out p)] -> CmdParser f out p
Butcher.addAlternatives
      [ ( String
"commandline-config"
        , \String
s -> String
"-" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') String
s
        , CmdParser Identity out (CConfig Option)
forall out. CmdParser Identity out (CConfig Option)
cmdlineConfigParser
        )
      , ( String
"yaml-config-document"
        , \String
s -> String
"{" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') String
s
        , PartDesc
-> (String -> Maybe (CConfig Option, String))
-> CmdParser Identity out (CConfig Option)
forall (f :: * -> *) p out.
(Applicative f, Typeable p) =>
PartDesc -> (String -> Maybe (p, String)) -> CmdParser f out p
Butcher.addCmdPart (String -> PartDesc
Butcher.varPartDesc String
"yaml-config-document")
        ((String -> Maybe (CConfig Option, String))
 -> CmdParser Identity out (CConfig Option))
-> (String -> Maybe (CConfig Option, String))
-> CmdParser Identity out (CConfig Option)
forall a b. (a -> b) -> a -> b
$ (CLayoutConfig Option -> (CConfig Option, String))
-> Maybe (CLayoutConfig Option) -> Maybe (CConfig Option, String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\CLayoutConfig Option
lconf -> (CConfig Option
forall a. Monoid a => a
mempty { _conf_layout :: CLayoutConfig Option
_conf_layout = CLayoutConfig Option
lconf }, String
""))
        (Maybe (CLayoutConfig Option) -> Maybe (CConfig Option, String))
-> (String -> Maybe (CLayoutConfig Option))
-> String
-> Maybe (CConfig Option, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParseException -> Maybe (CLayoutConfig Option))
-> (CLayoutConfig Option -> Maybe (CLayoutConfig Option))
-> Either ParseException (CLayoutConfig Option)
-> Maybe (CLayoutConfig Option)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ParseException
_ -> Maybe (CLayoutConfig Option)
forall a. Maybe a
Nothing) CLayoutConfig Option -> Maybe (CLayoutConfig Option)
forall a. a -> Maybe a
Just
        (Either ParseException (CLayoutConfig Option)
 -> Maybe (CLayoutConfig Option))
-> (String -> Either ParseException (CLayoutConfig Option))
-> String
-> Maybe (CLayoutConfig Option)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either ParseException (CLayoutConfig Option)
forall a. FromJSON a => ByteString -> Either ParseException a
Data.Yaml.decodeEither'
        (ByteString -> Either ParseException (CLayoutConfig Option))
-> (String -> ByteString)
-> String
-> Either ParseException (CLayoutConfig Option)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
Data.ByteString.Char8.pack
          -- TODO: use some proper utf8 encoder instead?
        )
      ]
    parser :: Free (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
parser = do -- we will (mis?)use butcher here to parse the inline config
                -- line.
      let nextDecl :: Free (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
nextDecl = do
            CConfig Option
conf <- CmdParser
  Identity (InlineConfigTarget, CConfig Option) (CConfig Option)
forall out. CmdParser Identity out (CConfig Option)
configParser
            (InlineConfigTarget, CConfig Option)
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
forall out (f :: * -> *). out -> CmdParser f out ()
Butcher.addCmdImpl (InlineConfigTarget
InlineConfigTargetNextDecl, CConfig Option
conf)
      String
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
forall (f :: * -> *) out.
Applicative f =>
String -> CmdParser f out () -> CmdParser f out ()
Butcher.addCmd String
"-next-declaration" Free (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
nextDecl
      String
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
forall (f :: * -> *) out.
Applicative f =>
String -> CmdParser f out () -> CmdParser f out ()
Butcher.addCmd String
"-Next-Declaration" Free (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
nextDecl
      String
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
forall (f :: * -> *) out.
Applicative f =>
String -> CmdParser f out () -> CmdParser f out ()
Butcher.addCmd String
"-NEXT-DECLARATION" Free (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
nextDecl
      let nextBinding :: Free (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
nextBinding = do
            CConfig Option
conf <- CmdParser
  Identity (InlineConfigTarget, CConfig Option) (CConfig Option)
forall out. CmdParser Identity out (CConfig Option)
configParser
            (InlineConfigTarget, CConfig Option)
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
forall out (f :: * -> *). out -> CmdParser f out ()
Butcher.addCmdImpl (InlineConfigTarget
InlineConfigTargetNextBinding, CConfig Option
conf)
      String
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
forall (f :: * -> *) out.
Applicative f =>
String -> CmdParser f out () -> CmdParser f out ()
Butcher.addCmd String
"-next-binding" Free (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
nextBinding
      String
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
forall (f :: * -> *) out.
Applicative f =>
String -> CmdParser f out () -> CmdParser f out ()
Butcher.addCmd String
"-Next-Binding" Free (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
nextBinding
      String
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
forall (f :: * -> *) out.
Applicative f =>
String -> CmdParser f out () -> CmdParser f out ()
Butcher.addCmd String
"-NEXT-BINDING" Free (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
nextBinding
      let disableNextBinding :: CmdParser f (InlineConfigTarget, CConfig Option) ()
disableNextBinding = do
            (InlineConfigTarget, CConfig Option)
-> CmdParser f (InlineConfigTarget, CConfig Option) ()
forall out (f :: * -> *). out -> CmdParser f out ()
Butcher.addCmdImpl
              ( InlineConfigTarget
InlineConfigTargetNextBinding
              , CConfig Option
forall a. Monoid a => a
mempty { _conf_roundtrip_exactprint_only :: Option (Last Bool)
_conf_roundtrip_exactprint_only = Last Bool -> Option (Last Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Last Bool -> Option (Last Bool))
-> Last Bool -> Option (Last Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Last Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True }
              )
      String
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
forall (f :: * -> *) out.
Applicative f =>
String -> CmdParser f out () -> CmdParser f out ()
Butcher.addCmd String
"-disable-next-binding" Free (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
forall (f :: * -> *).
CmdParser f (InlineConfigTarget, CConfig Option) ()
disableNextBinding
      String
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
forall (f :: * -> *) out.
Applicative f =>
String -> CmdParser f out () -> CmdParser f out ()
Butcher.addCmd String
"-Disable-Next-Binding" Free (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
forall (f :: * -> *).
CmdParser f (InlineConfigTarget, CConfig Option) ()
disableNextBinding
      String
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
forall (f :: * -> *) out.
Applicative f =>
String -> CmdParser f out () -> CmdParser f out ()
Butcher.addCmd String
"-DISABLE-NEXT-BINDING" Free (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
forall (f :: * -> *).
CmdParser f (InlineConfigTarget, CConfig Option) ()
disableNextBinding
      let disableNextDecl :: CmdParser f (InlineConfigTarget, CConfig Option) ()
disableNextDecl = do
            (InlineConfigTarget, CConfig Option)
-> CmdParser f (InlineConfigTarget, CConfig Option) ()
forall out (f :: * -> *). out -> CmdParser f out ()
Butcher.addCmdImpl
              ( InlineConfigTarget
InlineConfigTargetNextDecl
              , CConfig Option
forall a. Monoid a => a
mempty { _conf_roundtrip_exactprint_only :: Option (Last Bool)
_conf_roundtrip_exactprint_only = Last Bool -> Option (Last Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Last Bool -> Option (Last Bool))
-> Last Bool -> Option (Last Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Last Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True }
              )
      String
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
forall (f :: * -> *) out.
Applicative f =>
String -> CmdParser f out () -> CmdParser f out ()
Butcher.addCmd String
"-disable-next-declaration" Free (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
forall (f :: * -> *).
CmdParser f (InlineConfigTarget, CConfig Option) ()
disableNextDecl
      String
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
forall (f :: * -> *) out.
Applicative f =>
String -> CmdParser f out () -> CmdParser f out ()
Butcher.addCmd String
"-Disable-Next-Declaration" Free (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
forall (f :: * -> *).
CmdParser f (InlineConfigTarget, CConfig Option) ()
disableNextDecl
      String
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
forall (f :: * -> *) out.
Applicative f =>
String -> CmdParser f out () -> CmdParser f out ()
Butcher.addCmd String
"-DISABLE-NEXT-DECLARATION" Free (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
forall (f :: * -> *).
CmdParser f (InlineConfigTarget, CConfig Option) ()
disableNextDecl
      let disableFormatting :: CmdParser f (InlineConfigTarget, CConfig Option) ()
disableFormatting = do
            (InlineConfigTarget, CConfig Option)
-> CmdParser f (InlineConfigTarget, CConfig Option) ()
forall out (f :: * -> *). out -> CmdParser f out ()
Butcher.addCmdImpl
              ( InlineConfigTarget
InlineConfigTargetModule
              , CConfig Option
forall a. Monoid a => a
mempty { _conf_disable_formatting :: Option (Last Bool)
_conf_disable_formatting = Last Bool -> Option (Last Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Last Bool -> Option (Last Bool))
-> Last Bool -> Option (Last Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Last Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True }
              )
      String
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
forall (f :: * -> *) out.
Applicative f =>
String -> CmdParser f out () -> CmdParser f out ()
Butcher.addCmd String
"-disable" Free (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
forall (f :: * -> *).
CmdParser f (InlineConfigTarget, CConfig Option) ()
disableFormatting
      String
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
forall (f :: * -> *) out.
Applicative f =>
String -> CmdParser f out () -> CmdParser f out ()
Butcher.addCmd String
"@" (Free (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
 -> Free
      (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ())
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
forall a b. (a -> b) -> a -> b
$ do
        -- Butcher.addCmd "module" $ do
        --   conf <- configParser
        --   Butcher.addCmdImpl (InlineConfigTargetModule, conf)
        Free (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
forall (f :: * -> *) out.
Applicative f =>
CmdParser f out () -> CmdParser f out ()
Butcher.addNullCmd (Free (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
 -> Free
      (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ())
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
forall a b. (a -> b) -> a -> b
$ do
          String
bindingName <- String
-> Param String
-> CmdParser Identity (InlineConfigTarget, CConfig Option) String
forall (f :: * -> *) out.
Applicative f =>
String -> Param String -> CmdParser f out String
Butcher.addParamString String
"BINDING" Param String
forall a. Monoid a => a
mempty
          CConfig Option
conf        <- CmdParser
  Identity (InlineConfigTarget, CConfig Option) (CConfig Option)
forall out. CmdParser Identity out (CConfig Option)
configParser
          (InlineConfigTarget, CConfig Option)
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
forall out (f :: * -> *). out -> CmdParser f out ()
Butcher.addCmdImpl (String -> InlineConfigTarget
InlineConfigTargetBinding String
bindingName, CConfig Option
conf)
      CConfig Option
conf <- CmdParser
  Identity (InlineConfigTarget, CConfig Option) (CConfig Option)
forall out. CmdParser Identity out (CConfig Option)
configParser
      (InlineConfigTarget, CConfig Option)
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
forall out (f :: * -> *). out -> CmdParser f out ()
Butcher.addCmdImpl (InlineConfigTarget
InlineConfigTargetModule, CConfig Option
conf)
  [(AnnKey, [(InlineConfigTarget, CConfig Option)])]
lineConfigss <- [(AnnKey, [String])]
configLiness [(AnnKey, [String])]
-> ((AnnKey, [String])
    -> Either
         (String, String) (AnnKey, [(InlineConfigTarget, CConfig Option)]))
-> Either
     (String, String) [(AnnKey, [(InlineConfigTarget, CConfig Option)])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
`forM` \(AnnKey
k, [String]
ss) -> do
    [(InlineConfigTarget, CConfig Option)]
r <- [String]
ss [String]
-> (String
    -> Either (String, String) (InlineConfigTarget, CConfig Option))
-> Either (String, String) [(InlineConfigTarget, CConfig Option)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
`forM` \String
s -> case String
-> Free
     (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
-> Either String (InlineConfigTarget, CConfig Option)
forall out.
String -> CmdParser Identity out () -> Either String out
Butcher.runCmdParserSimple String
s Free (CmdParserF Identity (InlineConfigTarget, CConfig Option)) ()
parser of
      Left  String
err -> (String, String)
-> Either (String, String) (InlineConfigTarget, CConfig Option)
forall a b. a -> Either a b
Left ((String, String)
 -> Either (String, String) (InlineConfigTarget, CConfig Option))
-> (String, String)
-> Either (String, String) (InlineConfigTarget, CConfig Option)
forall a b. (a -> b) -> a -> b
$ (String
err, String
s)
      Right (InlineConfigTarget, CConfig Option)
c   -> (InlineConfigTarget, CConfig Option)
-> Either (String, String) (InlineConfigTarget, CConfig Option)
forall a b. b -> Either a b
Right ((InlineConfigTarget, CConfig Option)
 -> Either (String, String) (InlineConfigTarget, CConfig Option))
-> (InlineConfigTarget, CConfig Option)
-> Either (String, String) (InlineConfigTarget, CConfig Option)
forall a b. (a -> b) -> a -> b
$ (InlineConfigTarget, CConfig Option)
c
    (AnnKey, [(InlineConfigTarget, CConfig Option)])
-> Either
     (String, String) (AnnKey, [(InlineConfigTarget, CConfig Option)])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnKey
k, [(InlineConfigTarget, CConfig Option)]
r)

  let perModule :: CConfig Option
perModule = (CConfig Option -> CConfig Option -> CConfig Option)
-> CConfig Option -> [CConfig Option] -> CConfig Option
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
        CConfig Option -> CConfig Option -> CConfig Option
forall a. Semigroup a => a -> a -> a
(<>)
        CConfig Option
forall a. Monoid a => a
mempty
        [ CConfig Option
conf
        | (AnnKey
_                       , [(InlineConfigTarget, CConfig Option)]
lineConfigs) <- [(AnnKey, [(InlineConfigTarget, CConfig Option)])]
lineConfigss
        , (InlineConfigTarget
InlineConfigTargetModule, CConfig Option
conf       ) <- [(InlineConfigTarget, CConfig Option)]
lineConfigs
        ]
  let
    perBinding :: Map String (CConfig Option)
perBinding = (CConfig Option -> CConfig Option -> CConfig Option)
-> [(String, CConfig Option)] -> Map String (CConfig Option)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith
      CConfig Option -> CConfig Option -> CConfig Option
forall a. Semigroup a => a -> a -> a
(<>)
      [ (String
n, CConfig Option
conf)
      | (AnnKey
k     , [(InlineConfigTarget, CConfig Option)]
lineConfigs) <- [(AnnKey, [(InlineConfigTarget, CConfig Option)])]
lineConfigss
      , (InlineConfigTarget
target, CConfig Option
conf       ) <- [(InlineConfigTarget, CConfig Option)]
lineConfigs
      , String
n                     <- case InlineConfigTarget
target of
        InlineConfigTargetBinding String
s -> [String
s]
        InlineConfigTarget
InlineConfigTargetNextBinding | Just String
name <- AnnKey -> Map AnnKey String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AnnKey
k Map AnnKey String
declNameMap ->
          [String
name]
        InlineConfigTarget
_ -> []
      ]
  let
    perKey :: Map AnnKey (CConfig Option)
perKey = (CConfig Option -> CConfig Option -> CConfig Option)
-> [(AnnKey, CConfig Option)] -> Map AnnKey (CConfig Option)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith
      CConfig Option -> CConfig Option -> CConfig Option
forall a. Semigroup a => a -> a -> a
(<>)
      [ (AnnKey
k, CConfig Option
conf)
      | (AnnKey
k     , [(InlineConfigTarget, CConfig Option)]
lineConfigs) <- [(AnnKey, [(InlineConfigTarget, CConfig Option)])]
lineConfigss
      , (InlineConfigTarget
target, CConfig Option
conf       ) <- [(InlineConfigTarget, CConfig Option)]
lineConfigs
      , case InlineConfigTarget
target of
        InlineConfigTarget
InlineConfigTargetNextDecl -> Bool
True
        InlineConfigTarget
InlineConfigTargetNextBinding | Maybe String
Nothing <- AnnKey -> Map AnnKey String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AnnKey
k Map AnnKey String
declNameMap ->
          Bool
True
        InlineConfigTarget
_ -> Bool
False
      ]

  (CConfig Option, PerItemConfig)
-> Either (String, String) (CConfig Option, PerItemConfig)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ((CConfig Option, PerItemConfig)
 -> Either (String, String) (CConfig Option, PerItemConfig))
-> (CConfig Option, PerItemConfig)
-> Either (String, String) (CConfig Option, PerItemConfig)
forall a b. (a -> b) -> a -> b
$ ( CConfig Option
perModule
      , PerItemConfig :: Map String (CConfig Option)
-> Map AnnKey (CConfig Option) -> PerItemConfig
PerItemConfig { _icd_perBinding :: Map String (CConfig Option)
_icd_perBinding = Map String (CConfig Option)
perBinding, _icd_perKey :: Map AnnKey (CConfig Option)
_icd_perKey = Map AnnKey (CConfig Option)
perKey }
      )


getTopLevelDeclNameMap :: GHC.ParsedSource -> TopLevelDeclNameMap
getTopLevelDeclNameMap :: ParsedSource -> TopLevelDeclNameMap
getTopLevelDeclNameMap (L AnnSpan
_ (HsModule Maybe (Located ModuleName)
_name Maybe (Located [LIE GhcPs])
_exports [LImportDecl GhcPs]
_ [LHsDecl GhcPs]
decls Maybe (Located WarningTxt)
_ Maybe LHsDocString
_)) =
  Map AnnKey String -> TopLevelDeclNameMap
TopLevelDeclNameMap (Map AnnKey String -> TopLevelDeclNameMap)
-> Map AnnKey String -> TopLevelDeclNameMap
forall a b. (a -> b) -> a -> b
$ [(AnnKey, String)] -> Map AnnKey String
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [ (LHsDecl GhcPs -> AnnKey
forall a. Constraints a => a -> AnnKey
ExactPrint.mkAnnKey LHsDecl GhcPs
decl, String
name)
    | LHsDecl GhcPs
decl       <- [LHsDecl GhcPs]
decls
    , (String
name : [String]
_) <- [LHsDecl GhcPs -> [String]
getDeclBindingNames LHsDecl GhcPs
decl]
    ]


-- | Exposes the transformation in an pseudo-pure fashion. The signature
-- contains `IO` due to the GHC API not exposing a pure parsing function, but
-- there should be no observable effects.
--
-- Note that this function ignores/resets all config values regarding
-- debugging, i.e. it will never use `trace`/write to stderr.
--
-- Note that the ghc parsing function used internally currently is wrapped in
-- `mask_`, so cannot be killed easily. If you don't control the input, you
-- may wish to put some proper upper bound on the input's size as a timeout
-- won't do.
parsePrintModule :: Config -> Text -> IO (Either [BrittanyError] Text)
parsePrintModule :: Config -> Text -> IO (Either [BrittanyError] Text)
parsePrintModule Config
configWithDebugs Text
inputText = ExceptT [BrittanyError] IO Text -> IO (Either [BrittanyError] Text)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT [BrittanyError] IO Text
 -> IO (Either [BrittanyError] Text))
-> ExceptT [BrittanyError] IO Text
-> IO (Either [BrittanyError] Text)
forall a b. (a -> b) -> a -> b
$ do
  let config :: Config
config =
        Config
configWithDebugs { _conf_debug :: CDebugConfig Identity
_conf_debug = Config -> CDebugConfig Identity
forall (f :: * -> *). CConfig f -> CDebugConfig f
_conf_debug Config
staticDefaultConfig }
  let ghcOptions :: [String]
ghcOptions         = Config
config Config
-> (Config -> CForwardOptions Identity) -> CForwardOptions Identity
forall a b. a -> (a -> b) -> b
& Config -> CForwardOptions Identity
forall (f :: * -> *). CConfig f -> CForwardOptions f
_conf_forward CForwardOptions Identity
-> (CForwardOptions Identity -> Identity [String])
-> Identity [String]
forall a b. a -> (a -> b) -> b
& CForwardOptions Identity -> Identity [String]
forall (f :: * -> *). CForwardOptions f -> f [String]
_options_ghc Identity [String] -> (Identity [String] -> [String]) -> [String]
forall a b. a -> (a -> b) -> b
& Identity [String] -> [String]
forall a. Identity a -> a
runIdentity
  let config_pp :: CPreProcessorConfig Identity
config_pp          = Config
config Config
-> (Config -> CPreProcessorConfig Identity)
-> CPreProcessorConfig Identity
forall a b. a -> (a -> b) -> b
& Config -> CPreProcessorConfig Identity
forall (f :: * -> *). CConfig f -> CPreProcessorConfig f
_conf_preprocessor
  let cppMode :: CPPMode
cppMode            = CPreProcessorConfig Identity
config_pp CPreProcessorConfig Identity
-> (CPreProcessorConfig Identity -> Identity (Last CPPMode))
-> Identity (Last CPPMode)
forall a b. a -> (a -> b) -> b
& CPreProcessorConfig Identity -> Identity (Last CPPMode)
forall (f :: * -> *). CPreProcessorConfig f -> f (Last CPPMode)
_ppconf_CPPMode Identity (Last CPPMode)
-> (Identity (Last CPPMode) -> CPPMode) -> CPPMode
forall a b. a -> (a -> b) -> b
& Identity (Last CPPMode) -> CPPMode
forall a b. Coercible a b => Identity a -> b
confUnpack
  let hackAroundIncludes :: Bool
hackAroundIncludes = CPreProcessorConfig Identity
config_pp CPreProcessorConfig Identity
-> (CPreProcessorConfig Identity -> Identity (Last Bool))
-> Identity (Last Bool)
forall a b. a -> (a -> b) -> b
& CPreProcessorConfig Identity -> Identity (Last Bool)
forall (f :: * -> *). CPreProcessorConfig f -> f (Last Bool)
_ppconf_hackAroundIncludes Identity (Last Bool) -> (Identity (Last Bool) -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
& Identity (Last Bool) -> Bool
forall a b. Coercible a b => Identity a -> b
confUnpack
  (Anns
anns, ParsedSource
parsedSource, Bool
hasCPP) <- do
    let hackF :: String -> String
hackF String
s = if String
"#include" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s
          then String
"-- BRITANY_INCLUDE_HACK " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
          else String
s
    let hackTransform :: String -> String
hackTransform = if Bool
hackAroundIncludes
          then String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
"\n" ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> String
hackF ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines'
          else String -> String
forall a. a -> a
id
    let cppCheckFunc :: DynFlags -> IO (Either String Bool)
cppCheckFunc DynFlags
dynFlags = if Extension -> DynFlags -> Bool
GHC.xopt Extension
GHC.Cpp DynFlags
dynFlags
          then case CPPMode
cppMode of
            CPPMode
CPPModeAbort  -> Either String Bool -> IO (Either String Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Bool -> IO (Either String Bool))
-> Either String Bool -> IO (Either String Bool)
forall a b. (a -> b) -> a -> b
$ String -> Either String Bool
forall a b. a -> Either a b
Left String
"Encountered -XCPP. Aborting."
            CPPMode
CPPModeWarn   -> Either String Bool -> IO (Either String Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Bool -> IO (Either String Bool))
-> Either String Bool -> IO (Either String Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
True
            CPPMode
CPPModeNowarn -> Either String Bool -> IO (Either String Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Bool -> IO (Either String Bool))
-> Either String Bool -> IO (Either String Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
True
          else Either String Bool -> IO (Either String Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Bool -> IO (Either String Bool))
-> Either String Bool -> IO (Either String Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
False
    Either String (Anns, ParsedSource, Bool)
parseResult <- IO (Either String (Anns, ParsedSource, Bool))
-> ExceptT
     [BrittanyError] IO (Either String (Anns, ParsedSource, Bool))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Either String (Anns, ParsedSource, Bool))
 -> ExceptT
      [BrittanyError] IO (Either String (Anns, ParsedSource, Bool)))
-> IO (Either String (Anns, ParsedSource, Bool))
-> ExceptT
     [BrittanyError] IO (Either String (Anns, ParsedSource, Bool))
forall a b. (a -> b) -> a -> b
$ [String]
-> String
-> (DynFlags -> IO (Either String Bool))
-> String
-> IO (Either String (Anns, ParsedSource, Bool))
forall a.
[String]
-> String
-> (DynFlags -> IO (Either String a))
-> String
-> IO (Either String (Anns, ParsedSource, a))
parseModuleFromString
      [String]
ghcOptions
      String
"stdin"
      DynFlags -> IO (Either String Bool)
cppCheckFunc
      (String -> String
hackTransform (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
inputText)
    case Either String (Anns, ParsedSource, Bool)
parseResult of
      Left  String
err -> [BrittanyError]
-> ExceptT [BrittanyError] IO (Anns, ParsedSource, Bool)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE [String -> BrittanyError
ErrorInput String
err]
      Right (Anns, ParsedSource, Bool)
x   -> (Anns, ParsedSource, Bool)
-> ExceptT [BrittanyError] IO (Anns, ParsedSource, Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Anns, ParsedSource, Bool)
x
  (CConfig Option
inlineConf, PerItemConfig
perItemConf) <-
    ((String, String)
 -> ExceptT [BrittanyError] IO (CConfig Option, PerItemConfig))
-> ((CConfig Option, PerItemConfig)
    -> ExceptT [BrittanyError] IO (CConfig Option, PerItemConfig))
-> Either (String, String) (CConfig Option, PerItemConfig)
-> ExceptT [BrittanyError] IO (CConfig Option, PerItemConfig)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([BrittanyError]
-> ExceptT [BrittanyError] IO (CConfig Option, PerItemConfig)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ([BrittanyError]
 -> ExceptT [BrittanyError] IO (CConfig Option, PerItemConfig))
-> ((String, String) -> [BrittanyError])
-> (String, String)
-> ExceptT [BrittanyError] IO (CConfig Option, PerItemConfig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BrittanyError -> [BrittanyError] -> [BrittanyError]
forall a. a -> [a] -> [a]
: []) (BrittanyError -> [BrittanyError])
-> ((String, String) -> BrittanyError)
-> (String, String)
-> [BrittanyError]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> BrittanyError)
-> (String, String) -> BrittanyError
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> BrittanyError
ErrorMacroConfig) (CConfig Option, PerItemConfig)
-> ExceptT [BrittanyError] IO (CConfig Option, PerItemConfig)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (Either (String, String) (CConfig Option, PerItemConfig)
 -> ExceptT [BrittanyError] IO (CConfig Option, PerItemConfig))
-> Either (String, String) (CConfig Option, PerItemConfig)
-> ExceptT [BrittanyError] IO (CConfig Option, PerItemConfig)
forall a b. (a -> b) -> a -> b
$ Anns
-> TopLevelDeclNameMap
-> Either (String, String) (CConfig Option, PerItemConfig)
extractCommentConfigs Anns
anns (ParsedSource -> TopLevelDeclNameMap
getTopLevelDeclNameMap ParsedSource
parsedSource)
  let moduleConfig :: Config
moduleConfig      = (forall a. Identity a -> Option a -> Identity a)
-> Config -> CConfig Option -> Config
forall (k :: (* -> *) -> *) (g :: * -> *) (h :: * -> *)
       (i :: * -> *).
CZipWith k =>
(forall a. g a -> h a -> i a) -> k g -> k h -> k i
cZipWith forall a. Identity a -> Option a -> Identity a
fromOptionIdentity Config
config CConfig Option
inlineConf
  let disableFormatting :: Bool
disableFormatting = Config
moduleConfig Config -> (Config -> Identity (Last Bool)) -> Identity (Last Bool)
forall a b. a -> (a -> b) -> b
& Config -> Identity (Last Bool)
forall (f :: * -> *). CConfig f -> f (Last Bool)
_conf_disable_formatting Identity (Last Bool) -> (Identity (Last Bool) -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
& Identity (Last Bool) -> Bool
forall a b. Coercible a b => Identity a -> b
confUnpack
  if Bool
disableFormatting
    then do
      Text -> ExceptT [BrittanyError] IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
inputText
    else do
      ([BrittanyError]
errsWarns, Text
outputTextL) <- do
        let omitCheck :: Bool
omitCheck =
              Config
moduleConfig
                Config
-> (Config -> CErrorHandlingConfig Identity)
-> CErrorHandlingConfig Identity
forall a b. a -> (a -> b) -> b
& Config -> CErrorHandlingConfig Identity
forall (f :: * -> *). CConfig f -> CErrorHandlingConfig f
_conf_errorHandling
                CErrorHandlingConfig Identity
-> (CErrorHandlingConfig Identity -> Identity (Last Bool))
-> Identity (Last Bool)
forall a b. a -> (a -> b) -> b
& CErrorHandlingConfig Identity -> Identity (Last Bool)
forall (f :: * -> *). CErrorHandlingConfig f -> f (Last Bool)
_econf_omit_output_valid_check
                Identity (Last Bool) -> (Identity (Last Bool) -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
& Identity (Last Bool) -> Bool
forall a b. Coercible a b => Identity a -> b
confUnpack
        ([BrittanyError]
ews, Text
outRaw) <- if Bool
hasCPP Bool -> Bool -> Bool
|| Bool
omitCheck
          then ([BrittanyError], Text)
-> ExceptT [BrittanyError] IO ([BrittanyError], Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (([BrittanyError], Text)
 -> ExceptT [BrittanyError] IO ([BrittanyError], Text))
-> ([BrittanyError], Text)
-> ExceptT [BrittanyError] IO ([BrittanyError], Text)
forall a b. (a -> b) -> a -> b
$ Config
-> PerItemConfig -> Anns -> ParsedSource -> ([BrittanyError], Text)
pPrintModule Config
moduleConfig PerItemConfig
perItemConf Anns
anns ParsedSource
parsedSource
          else IO ([BrittanyError], Text)
-> ExceptT [BrittanyError] IO ([BrittanyError], Text)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
            (IO ([BrittanyError], Text)
 -> ExceptT [BrittanyError] IO ([BrittanyError], Text))
-> IO ([BrittanyError], Text)
-> ExceptT [BrittanyError] IO ([BrittanyError], Text)
forall a b. (a -> b) -> a -> b
$ Config
-> PerItemConfig
-> Anns
-> ParsedSource
-> IO ([BrittanyError], Text)
pPrintModuleAndCheck Config
moduleConfig PerItemConfig
perItemConf Anns
anns ParsedSource
parsedSource
        let hackF :: Text -> Text
hackF Text
s = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
s
              (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
TextL.stripPrefix (String -> Text
TextL.pack String
"-- BRITANY_INCLUDE_HACK ") Text
s
        ([BrittanyError], Text)
-> ExceptT [BrittanyError] IO ([BrittanyError], Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([BrittanyError], Text)
 -> ExceptT [BrittanyError] IO ([BrittanyError], Text))
-> ([BrittanyError], Text)
-> ExceptT [BrittanyError] IO ([BrittanyError], Text)
forall a b. (a -> b) -> a -> b
$ if Bool
hackAroundIncludes
          then
            ( [BrittanyError]
ews
            , Text -> [Text] -> Text
TextL.intercalate (String -> Text
TextL.pack String
"\n") ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
hackF ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
TextL.splitOn
              (String -> Text
TextL.pack String
"\n")
              Text
outRaw
            )
          else ([BrittanyError]
ews, Text
outRaw)
      let customErrOrder :: BrittanyError -> Int
customErrOrder ErrorInput{}         = Int
4
          customErrOrder LayoutWarning{}      = Int
0 :: Int
          customErrOrder ErrorOutputCheck{}   = Int
1
          customErrOrder ErrorUnusedComment{} = Int
2
          customErrOrder ErrorUnknownNode{}   = Int
3
          customErrOrder ErrorMacroConfig{}   = Int
5
      let hasErrors :: Bool
hasErrors =
            case
                Config
moduleConfig Config
-> (Config -> CErrorHandlingConfig Identity)
-> CErrorHandlingConfig Identity
forall a b. a -> (a -> b) -> b
& Config -> CErrorHandlingConfig Identity
forall (f :: * -> *). CConfig f -> CErrorHandlingConfig f
_conf_errorHandling CErrorHandlingConfig Identity
-> (CErrorHandlingConfig Identity -> Identity (Last Bool))
-> Identity (Last Bool)
forall a b. a -> (a -> b) -> b
& CErrorHandlingConfig Identity -> Identity (Last Bool)
forall (f :: * -> *). CErrorHandlingConfig f -> f (Last Bool)
_econf_Werror Identity (Last Bool) -> (Identity (Last Bool) -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
& Identity (Last Bool) -> Bool
forall a b. Coercible a b => Identity a -> b
confUnpack
              of
                Bool
False -> Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (-Int
1 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (BrittanyError -> Int) -> [BrittanyError] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BrittanyError -> Int
customErrOrder [BrittanyError]
errsWarns)
                Bool
True  -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [BrittanyError] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [BrittanyError]
errsWarns
      if Bool
hasErrors
        then [BrittanyError] -> ExceptT [BrittanyError] IO Text
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ([BrittanyError] -> ExceptT [BrittanyError] IO Text)
-> [BrittanyError] -> ExceptT [BrittanyError] IO Text
forall a b. (a -> b) -> a -> b
$ [BrittanyError]
errsWarns
        else Text -> ExceptT [BrittanyError] IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ExceptT [BrittanyError] IO Text)
-> Text -> ExceptT [BrittanyError] IO Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
TextL.toStrict Text
outputTextL



-- BrittanyErrors can be non-fatal warnings, thus both are returned instead
-- of an Either.
-- This should be cleaned up once it is clear what kinds of errors really
-- can occur.
pPrintModule
  :: Config
  -> PerItemConfig
  -> ExactPrint.Anns
  -> GHC.ParsedSource
  -> ([BrittanyError], TextL.Text)
pPrintModule :: Config
-> PerItemConfig -> Anns -> ParsedSource -> ([BrittanyError], Text)
pPrintModule Config
conf PerItemConfig
inlineConf Anns
anns ParsedSource
parsedModule =
  let ((Builder
out, [BrittanyError]
errs), Seq String
debugStrings) =
        Identity ((Builder, [BrittanyError]), Seq String)
-> ((Builder, [BrittanyError]), Seq String)
forall a. Identity a -> a
runIdentity
          (Identity ((Builder, [BrittanyError]), Seq String)
 -> ((Builder, [BrittanyError]), Seq String))
-> Identity ((Builder, [BrittanyError]), Seq String)
-> ((Builder, [BrittanyError]), Seq String)
forall a b. (a -> b) -> a -> b
$ MultiRWST
  '[] '[] '[] Identity ((Builder, [BrittanyError]), Seq String)
-> Identity ((Builder, [BrittanyError]), Seq String)
forall (m :: * -> *) a. Monad m => MultiRWST '[] '[] '[] m a -> m a
MultiRWSS.runMultiRWSTNil
          (MultiRWST
   '[] '[] '[] Identity ((Builder, [BrittanyError]), Seq String)
 -> Identity ((Builder, [BrittanyError]), Seq String))
-> MultiRWST
     '[] '[] '[] Identity ((Builder, [BrittanyError]), Seq String)
-> Identity ((Builder, [BrittanyError]), Seq String)
forall a b. (a -> b) -> a -> b
$ MultiRWST '[] '[Seq String] '[] Identity (Builder, [BrittanyError])
-> MultiRWST
     '[] '[] '[] Identity ((Builder, [BrittanyError]), Seq String)
forall w (m :: * -> *) (r :: [*]) (ws :: [*]) (s :: [*]) a.
(Monoid w, Monad m) =>
MultiRWST r (w : ws) s m a -> MultiRWST r ws s m (a, w)
MultiRWSS.withMultiWriterAW
          (MultiRWST
   '[] '[Seq String] '[] Identity (Builder, [BrittanyError])
 -> MultiRWST
      '[] '[] '[] Identity ((Builder, [BrittanyError]), Seq String))
-> MultiRWST
     '[] '[Seq String] '[] Identity (Builder, [BrittanyError])
-> MultiRWST
     '[] '[] '[] Identity ((Builder, [BrittanyError]), Seq String)
forall a b. (a -> b) -> a -> b
$ MultiRWST '[] '[[BrittanyError], Seq String] '[] Identity Builder
-> MultiRWST
     '[] '[Seq String] '[] Identity (Builder, [BrittanyError])
forall w (m :: * -> *) (r :: [*]) (ws :: [*]) (s :: [*]) a.
(Monoid w, Monad m) =>
MultiRWST r (w : ws) s m a -> MultiRWST r ws s m (a, w)
MultiRWSS.withMultiWriterAW
          (MultiRWST '[] '[[BrittanyError], Seq String] '[] Identity Builder
 -> MultiRWST
      '[] '[Seq String] '[] Identity (Builder, [BrittanyError]))
-> MultiRWST
     '[] '[[BrittanyError], Seq String] '[] Identity Builder
-> MultiRWST
     '[] '[Seq String] '[] Identity (Builder, [BrittanyError])
forall a b. (a -> b) -> a -> b
$ MultiRWST
  '[] '[Builder, [BrittanyError], Seq String] '[] Identity ()
-> MultiRWST
     '[] '[[BrittanyError], Seq String] '[] Identity Builder
forall w (m :: * -> *) (r :: [*]) (ws :: [*]) (s :: [*]) a.
(Monoid w, Monad m) =>
MultiRWST r (w : ws) s m a -> MultiRWST r ws s m w
MultiRWSS.withMultiWriterW
          (MultiRWST
   '[] '[Builder, [BrittanyError], Seq String] '[] Identity ()
 -> MultiRWST
      '[] '[[BrittanyError], Seq String] '[] Identity Builder)
-> MultiRWST
     '[] '[Builder, [BrittanyError], Seq String] '[] Identity ()
-> MultiRWST
     '[] '[[BrittanyError], Seq String] '[] Identity Builder
forall a b. (a -> b) -> a -> b
$ Anns
-> MultiRWST
     '[Anns] '[Builder, [BrittanyError], Seq String] '[] Identity ()
-> MultiRWST
     '[] '[Builder, [BrittanyError], Seq String] '[] Identity ()
forall (m :: * -> *) r (rs :: [*]) (w :: [*]) (s :: [*]) a.
Monad m =>
r -> MultiRWST (r : rs) w s m a -> MultiRWST rs w s m a
MultiRWSS.withMultiReader Anns
anns
          (MultiRWST
   '[Anns] '[Builder, [BrittanyError], Seq String] '[] Identity ()
 -> MultiRWST
      '[] '[Builder, [BrittanyError], Seq String] '[] Identity ())
-> MultiRWST
     '[Anns] '[Builder, [BrittanyError], Seq String] '[] Identity ()
-> MultiRWST
     '[] '[Builder, [BrittanyError], Seq String] '[] Identity ()
forall a b. (a -> b) -> a -> b
$ Config
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
-> MultiRWST
     '[Anns] '[Builder, [BrittanyError], Seq String] '[] Identity ()
forall (m :: * -> *) r (rs :: [*]) (w :: [*]) (s :: [*]) a.
Monad m =>
r -> MultiRWST (r : rs) w s m a -> MultiRWST rs w s m a
MultiRWSS.withMultiReader Config
conf
          (MultiRWST
   '[Config, Anns]
   '[Builder, [BrittanyError], Seq String]
   '[]
   Identity
   ()
 -> MultiRWST
      '[Anns] '[Builder, [BrittanyError], Seq String] '[] Identity ())
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
-> MultiRWST
     '[Anns] '[Builder, [BrittanyError], Seq String] '[] Identity ()
forall a b. (a -> b) -> a -> b
$ PerItemConfig
-> MultiRWST
     '[PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall (m :: * -> *) r (rs :: [*]) (w :: [*]) (s :: [*]) a.
Monad m =>
r -> MultiRWST (r : rs) w s m a -> MultiRWST rs w s m a
MultiRWSS.withMultiReader PerItemConfig
inlineConf
          (MultiRWST
   '[PerItemConfig, Config, Anns]
   '[Builder, [BrittanyError], Seq String]
   '[]
   Identity
   ()
 -> MultiRWST
      '[Config, Anns]
      '[Builder, [BrittanyError], Seq String]
      '[]
      Identity
      ())
-> MultiRWST
     '[PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall a b. (a -> b) -> a -> b
$ Map AnnKey Anns
-> MultiRWST
     '[Map AnnKey Anns, PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
-> MultiRWST
     '[PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall (m :: * -> *) r (rs :: [*]) (w :: [*]) (s :: [*]) a.
Monad m =>
r -> MultiRWST (r : rs) w s m a -> MultiRWST rs w s m a
MultiRWSS.withMultiReader (ParsedSource -> Anns -> Map AnnKey Anns
extractToplevelAnns ParsedSource
parsedModule Anns
anns)
          (MultiRWST
   '[Map AnnKey Anns, PerItemConfig, Config, Anns]
   '[Builder, [BrittanyError], Seq String]
   '[]
   Identity
   ()
 -> MultiRWST
      '[PerItemConfig, Config, Anns]
      '[Builder, [BrittanyError], Seq String]
      '[]
      Identity
      ())
-> MultiRWST
     '[Map AnnKey Anns, PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
-> MultiRWST
     '[PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall a b. (a -> b) -> a -> b
$ do
              String
-> (CDebugConfig Identity -> Identity (Last Bool))
-> Doc
-> MultiRWST
     '[Map AnnKey Anns, PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall (m :: * -> *) a.
(MonadMultiReader Config m, Show a) =>
String
-> (CDebugConfig Identity -> Identity (Last Bool)) -> a -> m ()
traceIfDumpConf String
"bridoc annotations raw" CDebugConfig Identity -> Identity (Last Bool)
forall (f :: * -> *). CDebugConfig f -> f (Last Bool)
_dconf_dump_annotations
                (Doc
 -> MultiRWST
      '[Map AnnKey Anns, PerItemConfig, Config, Anns]
      '[Builder, [BrittanyError], Seq String]
      '[]
      Identity
      ())
-> Doc
-> MultiRWST
     '[Map AnnKey Anns, PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall a b. (a -> b) -> a -> b
$ Anns -> Doc
annsDoc Anns
anns
              ParsedSource
-> MultiRWST
     '[Map AnnKey Anns, PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
ppModule ParsedSource
parsedModule
      tracer :: ([BrittanyError], Text) -> ([BrittanyError], Text)
tracer = if Seq String -> Bool
forall a. Seq a -> Bool
Seq.null Seq String
debugStrings
        then ([BrittanyError], Text) -> ([BrittanyError], Text)
forall a. a -> a
id
        else
          String -> ([BrittanyError], Text) -> ([BrittanyError], Text)
forall a. String -> a -> a
trace (String
"---- DEBUGMESSAGES ---- ")
            (([BrittanyError], Text) -> ([BrittanyError], Text))
-> (([BrittanyError], Text) -> ([BrittanyError], Text))
-> ([BrittanyError], Text)
-> ([BrittanyError], Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
 -> (([BrittanyError], Text) -> ([BrittanyError], Text))
 -> ([BrittanyError], Text)
 -> ([BrittanyError], Text))
-> (([BrittanyError], Text) -> ([BrittanyError], Text))
-> Seq String
-> ([BrittanyError], Text)
-> ([BrittanyError], Text)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (String
-> (([BrittanyError], Text) -> ([BrittanyError], Text))
-> ([BrittanyError], Text)
-> ([BrittanyError], Text)
seq (String
 -> (([BrittanyError], Text) -> ([BrittanyError], Text))
 -> ([BrittanyError], Text)
 -> ([BrittanyError], Text))
-> (String -> String)
-> String
-> (([BrittanyError], Text) -> ([BrittanyError], Text))
-> ([BrittanyError], Text)
-> ([BrittanyError], Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String) -> String -> String
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join String -> String -> String
forall a. String -> a -> a
trace) ([BrittanyError], Text) -> ([BrittanyError], Text)
forall a. a -> a
id Seq String
debugStrings
  in  ([BrittanyError], Text) -> ([BrittanyError], Text)
tracer (([BrittanyError], Text) -> ([BrittanyError], Text))
-> ([BrittanyError], Text) -> ([BrittanyError], Text)
forall a b. (a -> b) -> a -> b
$ ([BrittanyError]
errs, Builder -> Text
Text.Builder.toLazyText Builder
out)
  -- unless () $ do
  --
  --   debugStrings `forM_` \s ->
  --     trace s $ return ()

-- | Additionally checks that the output compiles again, appending an error
-- if it does not.
pPrintModuleAndCheck
  :: Config
  -> PerItemConfig
  -> ExactPrint.Anns
  -> GHC.ParsedSource
  -> IO ([BrittanyError], TextL.Text)
pPrintModuleAndCheck :: Config
-> PerItemConfig
-> Anns
-> ParsedSource
-> IO ([BrittanyError], Text)
pPrintModuleAndCheck Config
conf PerItemConfig
inlineConf Anns
anns ParsedSource
parsedModule = do
  let ghcOptions :: [String]
ghcOptions     = Config
conf Config
-> (Config -> CForwardOptions Identity) -> CForwardOptions Identity
forall a b. a -> (a -> b) -> b
& Config -> CForwardOptions Identity
forall (f :: * -> *). CConfig f -> CForwardOptions f
_conf_forward CForwardOptions Identity
-> (CForwardOptions Identity -> Identity [String])
-> Identity [String]
forall a b. a -> (a -> b) -> b
& CForwardOptions Identity -> Identity [String]
forall (f :: * -> *). CForwardOptions f -> f [String]
_options_ghc Identity [String] -> (Identity [String] -> [String]) -> [String]
forall a b. a -> (a -> b) -> b
& Identity [String] -> [String]
forall a. Identity a -> a
runIdentity
  let ([BrittanyError]
errs, Text
output) = Config
-> PerItemConfig -> Anns -> ParsedSource -> ([BrittanyError], Text)
pPrintModule Config
conf PerItemConfig
inlineConf Anns
anns ParsedSource
parsedModule
  Either String (Anns, ParsedSource, ())
parseResult <- [String]
-> String
-> (DynFlags -> IO (Either String ()))
-> String
-> IO (Either String (Anns, ParsedSource, ()))
forall a.
[String]
-> String
-> (DynFlags -> IO (Either String a))
-> String
-> IO (Either String (Anns, ParsedSource, a))
parseModuleFromString [String]
ghcOptions
                                       String
"output"
                                       (\DynFlags
_ -> Either String () -> IO (Either String ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String () -> IO (Either String ()))
-> Either String () -> IO (Either String ())
forall a b. (a -> b) -> a -> b
$ () -> Either String ()
forall a b. b -> Either a b
Right ())
                                       (Text -> String
TextL.unpack Text
output)
  let errs' :: [BrittanyError]
errs' = [BrittanyError]
errs [BrittanyError] -> [BrittanyError] -> [BrittanyError]
forall a. [a] -> [a] -> [a]
++ case Either String (Anns, ParsedSource, ())
parseResult of
        Left{}  -> [BrittanyError
ErrorOutputCheck]
        Right{} -> []
  ([BrittanyError], Text) -> IO ([BrittanyError], Text)
forall (m :: * -> *) a. Monad m => a -> m a
return ([BrittanyError]
errs', Text
output)


-- used for testing mostly, currently.
-- TODO: use parsePrintModule instead and remove this function.
parsePrintModuleTests :: Config -> String -> Text -> IO (Either String Text)
parsePrintModuleTests :: Config -> String -> Text -> IO (Either String Text)
parsePrintModuleTests Config
conf String
filename Text
input = do
  let inputStr :: String
inputStr = Text -> String
Text.unpack Text
input
  ParseResult ParsedSource
parseResult <- String -> String -> IO (ParseResult ParsedSource)
ExactPrint.Parsers.parseModuleFromString String
filename String
inputStr
  case ParseResult ParsedSource
parseResult of
#if MIN_VERSION_ghc(8,10,1)   /* ghc-8.10.1 */
    Left  ErrorMessages
err                  -> Either String Text -> IO (Either String Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Text -> IO (Either String Text))
-> Either String Text -> IO (Either String Text)
forall a b. (a -> b) -> a -> b
$ String -> Either String Text
forall a b. a -> Either a b
Left (String -> Either String Text) -> String -> Either String Text
forall a b. (a -> b) -> a -> b
$ String
"parsing error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show (Bag String -> [String]
forall a. Bag a -> [a]
bagToList (ErrMsg -> String
forall a. Show a => a -> String
show (ErrMsg -> String) -> ErrorMessages -> Bag String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ErrorMessages
err))
#else
    Left  (_   , s           ) -> return $ Left $ "parsing error: " ++ s
#endif
    Right (Anns
anns, ParsedSource
parsedModule) -> ExceptT String IO Text -> IO (Either String Text)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String IO Text -> IO (Either String Text))
-> ExceptT String IO Text -> IO (Either String Text)
forall a b. (a -> b) -> a -> b
$ do
      (CConfig Option
inlineConf, PerItemConfig
perItemConf) <-
        case Anns
-> TopLevelDeclNameMap
-> Either (String, String) (CConfig Option, PerItemConfig)
extractCommentConfigs Anns
anns (ParsedSource -> TopLevelDeclNameMap
getTopLevelDeclNameMap ParsedSource
parsedModule) of
          Left  (String, String)
err -> String -> ExceptT String IO (CConfig Option, PerItemConfig)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (String -> ExceptT String IO (CConfig Option, PerItemConfig))
-> String -> ExceptT String IO (CConfig Option, PerItemConfig)
forall a b. (a -> b) -> a -> b
$ String
"error in inline config: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String, String) -> String
forall a. Show a => a -> String
show (String, String)
err
          Right (CConfig Option, PerItemConfig)
x   -> (CConfig Option, PerItemConfig)
-> ExceptT String IO (CConfig Option, PerItemConfig)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CConfig Option, PerItemConfig)
x
      let moduleConf :: Config
moduleConf = (forall a. Identity a -> Option a -> Identity a)
-> Config -> CConfig Option -> Config
forall (k :: (* -> *) -> *) (g :: * -> *) (h :: * -> *)
       (i :: * -> *).
CZipWith k =>
(forall a. g a -> h a -> i a) -> k g -> k h -> k i
cZipWith forall a. Identity a -> Option a -> Identity a
fromOptionIdentity Config
conf CConfig Option
inlineConf
      let omitCheck :: Bool
omitCheck =
            Config
conf
              Config -> (Config -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
&  Config -> CErrorHandlingConfig Identity
forall (f :: * -> *). CConfig f -> CErrorHandlingConfig f
_conf_errorHandling
              (Config -> CErrorHandlingConfig Identity)
-> (CErrorHandlingConfig Identity -> Identity (Last Bool))
-> Config
-> Identity (Last Bool)
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> CErrorHandlingConfig Identity -> Identity (Last Bool)
forall (f :: * -> *). CErrorHandlingConfig f -> f (Last Bool)
_econf_omit_output_valid_check
              (Config -> Identity (Last Bool))
-> (Identity (Last Bool) -> Bool) -> Config -> Bool
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> Identity (Last Bool) -> Bool
forall a b. Coercible a b => Identity a -> b
confUnpack
      ([BrittanyError]
errs, Text
ltext) <- if Bool
omitCheck
        then ([BrittanyError], Text)
-> ExceptT String IO ([BrittanyError], Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (([BrittanyError], Text)
 -> ExceptT String IO ([BrittanyError], Text))
-> ([BrittanyError], Text)
-> ExceptT String IO ([BrittanyError], Text)
forall a b. (a -> b) -> a -> b
$ Config
-> PerItemConfig -> Anns -> ParsedSource -> ([BrittanyError], Text)
pPrintModule Config
moduleConf PerItemConfig
perItemConf Anns
anns ParsedSource
parsedModule
        else IO ([BrittanyError], Text)
-> ExceptT String IO ([BrittanyError], Text)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
          (IO ([BrittanyError], Text)
 -> ExceptT String IO ([BrittanyError], Text))
-> IO ([BrittanyError], Text)
-> ExceptT String IO ([BrittanyError], Text)
forall a b. (a -> b) -> a -> b
$ Config
-> PerItemConfig
-> Anns
-> ParsedSource
-> IO ([BrittanyError], Text)
pPrintModuleAndCheck Config
moduleConf PerItemConfig
perItemConf Anns
anns ParsedSource
parsedModule
      if [BrittanyError] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [BrittanyError]
errs
        then Text -> ExceptT String IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ExceptT String IO Text) -> Text -> ExceptT String IO Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
TextL.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
ltext
        else
          let
            errStrs :: [String]
errStrs = [BrittanyError]
errs [BrittanyError] -> (BrittanyError -> String) -> [String]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
              ErrorInput         String
str -> String
str
              ErrorUnusedComment String
str -> String
str
              LayoutWarning      String
str -> String
str
              ErrorUnknownNode String
str GenLocated AnnSpan ast
_ -> String
str
              ErrorMacroConfig String
str String
_ -> String
"when parsing inline config: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str
              BrittanyError
ErrorOutputCheck       -> String
"Output is not syntactically valid."
          in  String -> ExceptT String IO Text
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (String -> ExceptT String IO Text)
-> String -> ExceptT String IO Text
forall a b. (a -> b) -> a -> b
$ String
"pretty printing error(s):\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
List.unlines [String]
errStrs


-- this approach would for if there was a pure GHC.parseDynamicFilePragma.
-- Unfortunately that does not exist yet, so we cannot provide a nominally
-- pure interface.

-- parsePrintModuleTests :: Text -> Either String Text
-- parsePrintModuleTests input = do
--   let dflags = GHC.unsafeGlobalDynFlags
--   let fakeFileName = "SomeTestFakeFileName.hs"
--   let pragmaInfo = GHC.getOptions
--         dflags
--         (GHC.stringToStringBuffer $ Text.unpack input)
--         fakeFileName
--   (dflags1, _, _) <- GHC.parseDynamicFilePragma dflags pragmaInfo
--   let parseResult = ExactPrint.Parsers.parseWith
--         dflags1
--         fakeFileName
--         GHC.parseModule
--         inputStr
--   case parseResult of
--     Left (_, s) -> Left $ "parsing error: " ++ s
--     Right (anns, parsedModule) -> do
--       let (out, errs) = runIdentity
--                       $ runMultiRWSTNil
--                       $ Control.Monad.Trans.MultiRWS.Lazy.withMultiWriterAW
--                       $ Control.Monad.Trans.MultiRWS.Lazy.withMultiWriterW
--                       $ Control.Monad.Trans.MultiRWS.Lazy.withMultiReader anns
--                       $ ppModule parsedModule
--       if (not $ null errs)
--         then do
--           let errStrs = errs <&> \case
--                 ErrorUnusedComment str -> str
--           Left $ "pretty printing error(s):\n" ++ List.unlines errStrs
--         else return $ TextL.toStrict $ Text.Builder.toLazyText out

toLocal :: Config -> ExactPrint.Anns -> PPMLocal a -> PPM a
toLocal :: Config -> Anns -> PPMLocal a -> PPM a
toLocal Config
conf Anns
anns PPMLocal a
m = do
  (a
x, HList '[Builder, [BrittanyError], Seq String]
write) <-
    Identity (a, HList '[Builder, [BrittanyError], Seq String])
-> MultiRWST
     '[Map AnnKey Anns, PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     (a, HList '[Builder, [BrittanyError], Seq String])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Identity (a, HList '[Builder, [BrittanyError], Seq String])
 -> MultiRWST
      '[Map AnnKey Anns, PerItemConfig, Config, Anns]
      '[Builder, [BrittanyError], Seq String]
      '[]
      Identity
      (a, HList '[Builder, [BrittanyError], Seq String]))
-> Identity (a, HList '[Builder, [BrittanyError], Seq String])
-> MultiRWST
     '[Map AnnKey Anns, PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     (a, HList '[Builder, [BrittanyError], Seq String])
forall a b. (a -> b) -> a -> b
$ HList '[Config, Anns]
-> HList '[]
-> PPMLocal a
-> Identity (a, HList '[Builder, [BrittanyError], Seq String])
forall (m :: * -> *) (w :: [*]) (r :: [*]) (s :: [*]) a.
(Monad m, Monoid (HList w)) =>
HList r -> HList s -> MultiRWST r w s m a -> m (a, HList w)
MultiRWSS.runMultiRWSTAW (Config
conf Config -> HList '[Anns] -> HList '[Config, Anns]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
:+: Anns
anns Anns -> HList '[] -> HList '[Anns]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
:+: HList '[]
HNil) HList '[]
HNil (PPMLocal a
 -> Identity (a, HList '[Builder, [BrittanyError], Seq String]))
-> PPMLocal a
-> Identity (a, HList '[Builder, [BrittanyError], Seq String])
forall a b. (a -> b) -> a -> b
$ PPMLocal a
m
  MultiRWST
  '[Map AnnKey Anns, PerItemConfig, Config, Anns]
  '[Builder, [BrittanyError], Seq String]
  '[]
  Identity
  (HList '[Builder, [BrittanyError], Seq String])
forall (m :: * -> *) (r :: [*]) (w :: [*]) (s :: [*]).
Monad m =>
MultiRWST r w s m (HList w)
MultiRWSS.mGetRawW MultiRWST
  '[Map AnnKey Anns, PerItemConfig, Config, Anns]
  '[Builder, [BrittanyError], Seq String]
  '[]
  Identity
  (HList '[Builder, [BrittanyError], Seq String])
-> (HList '[Builder, [BrittanyError], Seq String]
    -> MultiRWST
         '[Map AnnKey Anns, PerItemConfig, Config, Anns]
         '[Builder, [BrittanyError], Seq String]
         '[]
         Identity
         ())
-> MultiRWST
     '[Map AnnKey Anns, PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \HList '[Builder, [BrittanyError], Seq String]
w -> HList '[Builder, [BrittanyError], Seq String]
-> MultiRWST
     '[Map AnnKey Anns, PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall (m :: * -> *) (w :: [*]) (r :: [*]) (s :: [*]).
Monad m =>
HList w -> MultiRWST r w s m ()
MultiRWSS.mPutRawW (HList '[Builder, [BrittanyError], Seq String]
w HList '[Builder, [BrittanyError], Seq String]
-> HList '[Builder, [BrittanyError], Seq String]
-> HList '[Builder, [BrittanyError], Seq String]
forall a. Monoid a => a -> a -> a
`mappend` HList '[Builder, [BrittanyError], Seq String]
write)
  a -> PPM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

ppModule :: GenLocated SrcSpan (HsModule GhcPs) -> PPM ()
ppModule :: ParsedSource
-> MultiRWST
     '[Map AnnKey Anns, PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
ppModule lmod :: ParsedSource
lmod@(L AnnSpan
_loc _m :: HsModule GhcPs
_m@(HsModule Maybe (Located ModuleName)
_name Maybe (Located [LIE GhcPs])
_exports [LImportDecl GhcPs]
_ [LHsDecl GhcPs]
decls Maybe (Located WarningTxt)
_ Maybe LHsDocString
_)) = do
  [(KeywordId, DeltaPos)]
post <- ParsedSource -> PPM [(KeywordId, DeltaPos)]
ppPreamble ParsedSource
lmod
  [LHsDecl GhcPs]
decls [LHsDecl GhcPs]
-> (LHsDecl GhcPs
    -> MultiRWST
         '[Map AnnKey Anns, PerItemConfig, Config, Anns]
         '[Builder, [BrittanyError], Seq String]
         '[]
         Identity
         ())
-> MultiRWST
     '[Map AnnKey Anns, PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
`forM_` \LHsDecl GhcPs
decl -> do
    let declAnnKey :: AnnKey
declAnnKey       = LHsDecl GhcPs -> AnnKey
forall a. Constraints a => a -> AnnKey
ExactPrint.mkAnnKey LHsDecl GhcPs
decl
    let declBindingNames :: [String]
declBindingNames = LHsDecl GhcPs -> [String]
getDeclBindingNames LHsDecl GhcPs
decl
    PerItemConfig
inlineConf <- MultiRWST
  '[Map AnnKey Anns, PerItemConfig, Config, Anns]
  '[Builder, [BrittanyError], Seq String]
  '[]
  Identity
  PerItemConfig
forall a (m :: * -> *). MonadMultiReader a m => m a
mAsk
    let mDeclConf :: Maybe (CConfig Option)
mDeclConf = AnnKey -> Map AnnKey (CConfig Option) -> Maybe (CConfig Option)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AnnKey
declAnnKey (Map AnnKey (CConfig Option) -> Maybe (CConfig Option))
-> Map AnnKey (CConfig Option) -> Maybe (CConfig Option)
forall a b. (a -> b) -> a -> b
$ PerItemConfig -> Map AnnKey (CConfig Option)
_icd_perKey PerItemConfig
inlineConf
    let mBindingConfs :: [Maybe (CConfig Option)]
mBindingConfs =
          [String]
declBindingNames [String]
-> (String -> Maybe (CConfig Option)) -> [Maybe (CConfig Option)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \String
n -> String -> Map String (CConfig Option) -> Maybe (CConfig Option)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
n (Map String (CConfig Option) -> Maybe (CConfig Option))
-> Map String (CConfig Option) -> Maybe (CConfig Option)
forall a b. (a -> b) -> a -> b
$ PerItemConfig -> Map String (CConfig Option)
_icd_perBinding PerItemConfig
inlineConf
    Anns
filteredAnns <- MultiRWST
  '[Map AnnKey Anns, PerItemConfig, Config, Anns]
  '[Builder, [BrittanyError], Seq String]
  '[]
  Identity
  (Map AnnKey Anns)
forall a (m :: * -> *). MonadMultiReader a m => m a
mAsk
      MultiRWST
  '[Map AnnKey Anns, PerItemConfig, Config, Anns]
  '[Builder, [BrittanyError], Seq String]
  '[]
  Identity
  (Map AnnKey Anns)
-> (Map AnnKey Anns -> Anns)
-> MultiRWST
     '[Map AnnKey Anns, PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     Anns
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Map AnnKey Anns
annMap -> Anns -> AnnKey -> Map AnnKey Anns -> Anns
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Anns
forall k a. Map k a
Map.empty AnnKey
declAnnKey Map AnnKey Anns
annMap

    String
-> (CDebugConfig Identity -> Identity (Last Bool))
-> Doc
-> MultiRWST
     '[Map AnnKey Anns, PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall (m :: * -> *) a.
(MonadMultiReader Config m, Show a) =>
String
-> (CDebugConfig Identity -> Identity (Last Bool)) -> a -> m ()
traceIfDumpConf String
"bridoc annotations filtered/transformed"
                    CDebugConfig Identity -> Identity (Last Bool)
forall (f :: * -> *). CDebugConfig f -> f (Last Bool)
_dconf_dump_annotations
      (Doc
 -> MultiRWST
      '[Map AnnKey Anns, PerItemConfig, Config, Anns]
      '[Builder, [BrittanyError], Seq String]
      '[]
      Identity
      ())
-> Doc
-> MultiRWST
     '[Map AnnKey Anns, PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall a b. (a -> b) -> a -> b
$ Anns -> Doc
annsDoc Anns
filteredAnns

    Config
config <- MultiRWST
  '[Map AnnKey Anns, PerItemConfig, Config, Anns]
  '[Builder, [BrittanyError], Seq String]
  '[]
  Identity
  Config
forall a (m :: * -> *). MonadMultiReader a m => m a
mAsk

    let config' :: Config
config' = (forall a. Identity a -> Option a -> Identity a)
-> Config -> CConfig Option -> Config
forall (k :: (* -> *) -> *) (g :: * -> *) (h :: * -> *)
       (i :: * -> *).
CZipWith k =>
(forall a. g a -> h a -> i a) -> k g -> k h -> k i
cZipWith forall a. Identity a -> Option a -> Identity a
fromOptionIdentity Config
config
          (CConfig Option -> Config) -> CConfig Option -> Config
forall a b. (a -> b) -> a -> b
$ [CConfig Option] -> CConfig Option
forall a. Monoid a => [a] -> a
mconcat ([Maybe (CConfig Option)] -> [CConfig Option]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (CConfig Option)]
mBindingConfs [Maybe (CConfig Option)]
-> [Maybe (CConfig Option)] -> [Maybe (CConfig Option)]
forall a. [a] -> [a] -> [a]
++ [Maybe (CConfig Option)
mDeclConf]))

    let exactprintOnly :: Bool
exactprintOnly = Config
config' Config -> (Config -> Identity (Last Bool)) -> Identity (Last Bool)
forall a b. a -> (a -> b) -> b
& Config -> Identity (Last Bool)
forall (f :: * -> *). CConfig f -> f (Last Bool)
_conf_roundtrip_exactprint_only Identity (Last Bool) -> (Identity (Last Bool) -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
& Identity (Last Bool) -> Bool
forall a b. Coercible a b => Identity a -> b
confUnpack
    Config
-> Anns
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
-> MultiRWST
     '[Map AnnKey Anns, PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall a. Config -> Anns -> PPMLocal a -> PPM a
toLocal Config
config' Anns
filteredAnns (MultiRWST
   '[Config, Anns]
   '[Builder, [BrittanyError], Seq String]
   '[]
   Identity
   ()
 -> MultiRWST
      '[Map AnnKey Anns, PerItemConfig, Config, Anns]
      '[Builder, [BrittanyError], Seq String]
      '[]
      Identity
      ())
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
-> MultiRWST
     '[Map AnnKey Anns, PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall a b. (a -> b) -> a -> b
$ do
      BriDocNumbered
bd <- if Bool
exactprintOnly
        then ToBriDocM BriDocNumbered -> PPMLocal BriDocNumbered
forall a. ToBriDocM a -> PPMLocal a
briDocMToPPM (ToBriDocM BriDocNumbered -> PPMLocal BriDocNumbered)
-> ToBriDocM BriDocNumbered -> PPMLocal BriDocNumbered
forall a b. (a -> b) -> a -> b
$ LHsDecl GhcPs -> ToBriDocM BriDocNumbered
forall ast. Annotate ast => Located ast -> ToBriDocM BriDocNumbered
briDocByExactNoComment LHsDecl GhcPs
decl
        else do
          (BriDocNumbered
r, [BrittanyError]
errs, Seq String
debugs) <- ToBriDocM BriDocNumbered
-> PPMLocal (BriDocNumbered, [BrittanyError], Seq String)
forall a. ToBriDocM a -> PPMLocal (a, [BrittanyError], Seq String)
briDocMToPPMInner (ToBriDocM BriDocNumbered
 -> PPMLocal (BriDocNumbered, [BrittanyError], Seq String))
-> ToBriDocM BriDocNumbered
-> PPMLocal (BriDocNumbered, [BrittanyError], Seq String)
forall a b. (a -> b) -> a -> b
$ LHsDecl GhcPs -> ToBriDocM BriDocNumbered
layoutDecl LHsDecl GhcPs
decl
          Seq String
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall a (m :: * -> *). MonadMultiWriter a m => a -> m ()
mTell Seq String
debugs
          [BrittanyError]
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall a (m :: * -> *). MonadMultiWriter a m => a -> m ()
mTell [BrittanyError]
errs
          if [BrittanyError] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [BrittanyError]
errs
            then BriDocNumbered -> PPMLocal BriDocNumbered
forall (f :: * -> *) a. Applicative f => a -> f a
pure BriDocNumbered
r
            else ToBriDocM BriDocNumbered -> PPMLocal BriDocNumbered
forall a. ToBriDocM a -> PPMLocal a
briDocMToPPM (ToBriDocM BriDocNumbered -> PPMLocal BriDocNumbered)
-> ToBriDocM BriDocNumbered -> PPMLocal BriDocNumbered
forall a b. (a -> b) -> a -> b
$ LHsDecl GhcPs -> ToBriDocM BriDocNumbered
forall ast. Annotate ast => Located ast -> ToBriDocM BriDocNumbered
briDocByExactNoComment LHsDecl GhcPs
decl
      BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
layoutBriDoc BriDocNumbered
bd

  let finalComments :: [(KeywordId, DeltaPos)]
finalComments = ((KeywordId, DeltaPos) -> Bool)
-> [(KeywordId, DeltaPos)] -> [(KeywordId, DeltaPos)]
forall a. (a -> Bool) -> [a] -> [a]
filter
        ((KeywordId, DeltaPos) -> KeywordId
forall a b. (a, b) -> a
fst ((KeywordId, DeltaPos) -> KeywordId)
-> (KeywordId -> Bool) -> (KeywordId, DeltaPos) -> Bool
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> \case
          ExactPrint.AnnComment{} -> Bool
True
          KeywordId
_                       -> Bool
False
        )
        [(KeywordId, DeltaPos)]
post
  [(KeywordId, DeltaPos)]
post [(KeywordId, DeltaPos)]
-> ((KeywordId, DeltaPos)
    -> MultiRWST
         '[Map AnnKey Anns, PerItemConfig, Config, Anns]
         '[Builder, [BrittanyError], Seq String]
         '[]
         Identity
         ())
-> MultiRWST
     '[Map AnnKey Anns, PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
`forM_` \case
    (ExactPrint.AnnComment (ExactPrint.Comment String
cmStr AnnSpan
_ Maybe AnnKeywordId
_), DeltaPos
l) -> do
      DeltaPos
-> MultiRWST
     '[Map AnnKey Anns, PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall (m :: * -> *).
MonadMultiWriter Builder m =>
DeltaPos -> m ()
ppmMoveToExactLoc DeltaPos
l
      Builder
-> MultiRWST
     '[Map AnnKey Anns, PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall a (m :: * -> *). MonadMultiWriter a m => a -> m ()
mTell (Builder
 -> MultiRWST
      '[Map AnnKey Anns, PerItemConfig, Config, Anns]
      '[Builder, [BrittanyError], Seq String]
      '[]
      Identity
      ())
-> Builder
-> MultiRWST
     '[Map AnnKey Anns, PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall a b. (a -> b) -> a -> b
$ String -> Builder
Text.Builder.fromString String
cmStr
    (ExactPrint.G AnnKeywordId
AnnEofPos, (ExactPrint.DP (Int
eofZ, Int
eofX))) ->
      let folder :: (Int, b) -> (KeywordId, DeltaPos) -> (Int, Int)
folder (Int
acc, b
_) (KeywordId
kw, ExactPrint.DP (Int
y, Int
x)) = case KeywordId
kw of
            ExactPrint.AnnComment Comment
cm
              | GHC.RealSrcSpan RealSrcSpan
span <- Comment -> AnnSpan
ExactPrint.commentIdentifier Comment
cm
              -> ( Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ RealSrcSpan -> Int
GHC.srcSpanEndLine RealSrcSpan
span Int -> Int -> Int
forall a. Num a => a -> a -> a
- RealSrcSpan -> Int
GHC.srcSpanStartLine RealSrcSpan
span
                 , Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ RealSrcSpan -> Int
GHC.srcSpanEndCol RealSrcSpan
span Int -> Int -> Int
forall a. Num a => a -> a -> a
- RealSrcSpan -> Int
GHC.srcSpanStartCol RealSrcSpan
span
                 )
            KeywordId
_ -> (Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y, Int
x)
          (Int
cmY, Int
cmX) = ((Int, Int) -> (KeywordId, DeltaPos) -> (Int, Int))
-> (Int, Int) -> [(KeywordId, DeltaPos)] -> (Int, Int)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int, Int) -> (KeywordId, DeltaPos) -> (Int, Int)
forall b. (Int, b) -> (KeywordId, DeltaPos) -> (Int, Int)
folder (Int
0, Int
0) [(KeywordId, DeltaPos)]
finalComments
      in  DeltaPos
-> MultiRWST
     '[Map AnnKey Anns, PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall (m :: * -> *).
MonadMultiWriter Builder m =>
DeltaPos -> m ()
ppmMoveToExactLoc (DeltaPos
 -> MultiRWST
      '[Map AnnKey Anns, PerItemConfig, Config, Anns]
      '[Builder, [BrittanyError], Seq String]
      '[]
      Identity
      ())
-> DeltaPos
-> MultiRWST
     '[Map AnnKey Anns, PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> DeltaPos
ExactPrint.DP (Int
eofZ Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
cmY, Int
eofX Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
cmX)
    (KeywordId, DeltaPos)
_ -> ()
-> MultiRWST
     '[Map AnnKey Anns, PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

getDeclBindingNames :: LHsDecl GhcPs -> [String]
getDeclBindingNames :: LHsDecl GhcPs -> [String]
getDeclBindingNames (L AnnSpan
_ HsDecl GhcPs
decl) = case HsDecl GhcPs
decl of
  SigD XSigD GhcPs
_ (TypeSig XTypeSig GhcPs
_ [Located (IdP GhcPs)]
ns LHsSigWcType GhcPs
_) -> [Located (IdP GhcPs)]
[GenLocated AnnSpan RdrName]
ns [GenLocated AnnSpan RdrName]
-> (GenLocated AnnSpan RdrName -> String) -> [String]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(L AnnSpan
_ RdrName
n) -> Text -> String
Text.unpack (RdrName -> Text
rdrNameToText RdrName
n)
  ValD XValD GhcPs
_ (FunBind XFunBind GhcPs GhcPs
_ (L AnnSpan
_ IdP GhcPs
n) MatchGroup GhcPs (LHsExpr GhcPs)
_ HsWrapper
_ [Tickish Id]
_) -> [Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ RdrName -> Text
rdrNameToText IdP GhcPs
RdrName
n]
  HsDecl GhcPs
_                              -> []


-- Prints the information associated with the module annotation
-- This includes the imports
ppPreamble
  :: GenLocated SrcSpan (HsModule GhcPs)
  -> PPM [(ExactPrint.KeywordId, ExactPrint.DeltaPos)]
ppPreamble :: ParsedSource -> PPM [(KeywordId, DeltaPos)]
ppPreamble lmod :: ParsedSource
lmod@(L AnnSpan
loc m :: HsModule GhcPs
m@(HsModule Maybe (Located ModuleName)
_ Maybe (Located [LIE GhcPs])
_ [LImportDecl GhcPs]
_ [LHsDecl GhcPs]
_ Maybe (Located WarningTxt)
_ Maybe LHsDocString
_)) = do
  Anns
filteredAnns <- MultiRWST
  '[Map AnnKey Anns, PerItemConfig, Config, Anns]
  '[Builder, [BrittanyError], Seq String]
  '[]
  Identity
  (Map AnnKey Anns)
forall a (m :: * -> *). MonadMultiReader a m => m a
mAsk MultiRWST
  '[Map AnnKey Anns, PerItemConfig, Config, Anns]
  '[Builder, [BrittanyError], Seq String]
  '[]
  Identity
  (Map AnnKey Anns)
-> (Map AnnKey Anns -> Anns)
-> MultiRWST
     '[Map AnnKey Anns, PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     Anns
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Map AnnKey Anns
annMap ->
    Anns -> AnnKey -> Map AnnKey Anns -> Anns
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Anns
forall k a. Map k a
Map.empty (ParsedSource -> AnnKey
forall a. Constraints a => a -> AnnKey
ExactPrint.mkAnnKey ParsedSource
lmod) Map AnnKey Anns
annMap
    -- Since ghc-exactprint adds annotations following (implicit)
    -- modules to both HsModule and the elements in the module
    -- this can cause duplication of comments. So strip
    -- attached annotations that come after the module's where
    -- from the module node
  Config
config <- MultiRWST
  '[Map AnnKey Anns, PerItemConfig, Config, Anns]
  '[Builder, [BrittanyError], Seq String]
  '[]
  Identity
  Config
forall a (m :: * -> *). MonadMultiReader a m => m a
mAsk
  let shouldReformatPreamble :: Bool
shouldReformatPreamble =
        Config
config Config
-> (Config -> CLayoutConfig Identity) -> CLayoutConfig Identity
forall a b. a -> (a -> b) -> b
& Config -> CLayoutConfig Identity
forall (f :: * -> *). CConfig f -> CLayoutConfig f
_conf_layout CLayoutConfig Identity
-> (CLayoutConfig Identity -> Identity (Last Bool))
-> Identity (Last Bool)
forall a b. a -> (a -> b) -> b
& CLayoutConfig Identity -> Identity (Last Bool)
forall (f :: * -> *). CLayoutConfig f -> f (Last Bool)
_lconfig_reformatModulePreamble Identity (Last Bool) -> (Identity (Last Bool) -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
& Identity (Last Bool) -> Bool
forall a b. Coercible a b => Identity a -> b
confUnpack

  let
    (Anns
filteredAnns', [(KeywordId, DeltaPos)]
post) =
      case AnnKey -> Anns -> Maybe Annotation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (ParsedSource -> AnnKey
forall a. Constraints a => a -> AnnKey
ExactPrint.mkAnnKey ParsedSource
lmod) Anns
filteredAnns of
        Maybe Annotation
Nothing -> (Anns
filteredAnns, [])
        Just Annotation
mAnn ->
          let
            modAnnsDp :: [(KeywordId, DeltaPos)]
modAnnsDp = Annotation -> [(KeywordId, DeltaPos)]
ExactPrint.annsDP Annotation
mAnn
            isWhere :: KeywordId -> Bool
isWhere (ExactPrint.G AnnKeywordId
AnnWhere) = Bool
True
            isWhere KeywordId
_                       = Bool
False
            isEof :: KeywordId -> Bool
isEof (ExactPrint.G AnnKeywordId
AnnEofPos) = Bool
True
            isEof KeywordId
_                        = Bool
False
            whereInd :: Maybe Int
whereInd     = ((KeywordId, DeltaPos) -> Bool)
-> [(KeywordId, DeltaPos)] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
List.findIndex (KeywordId -> Bool
isWhere (KeywordId -> Bool)
-> ((KeywordId, DeltaPos) -> KeywordId)
-> (KeywordId, DeltaPos)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeywordId, DeltaPos) -> KeywordId
forall a b. (a, b) -> a
fst) [(KeywordId, DeltaPos)]
modAnnsDp
            eofInd :: Maybe Int
eofInd       = ((KeywordId, DeltaPos) -> Bool)
-> [(KeywordId, DeltaPos)] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
List.findIndex (KeywordId -> Bool
isEof (KeywordId -> Bool)
-> ((KeywordId, DeltaPos) -> KeywordId)
-> (KeywordId, DeltaPos)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeywordId, DeltaPos) -> KeywordId
forall a b. (a, b) -> a
fst) [(KeywordId, DeltaPos)]
modAnnsDp
            ([(KeywordId, DeltaPos)]
pre, [(KeywordId, DeltaPos)]
post') = case (Maybe Int
whereInd, Maybe Int
eofInd) of
              (Maybe Int
Nothing, Maybe Int
Nothing) -> ([], [(KeywordId, DeltaPos)]
modAnnsDp)
              (Just Int
i , Maybe Int
Nothing) -> Int
-> [(KeywordId, DeltaPos)]
-> ([(KeywordId, DeltaPos)], [(KeywordId, DeltaPos)])
forall a. Int -> [a] -> ([a], [a])
List.splitAt (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [(KeywordId, DeltaPos)]
modAnnsDp
              (Maybe Int
Nothing, Just Int
_i) -> ([], [(KeywordId, DeltaPos)]
modAnnsDp)
              (Just Int
i , Just Int
j ) -> Int
-> [(KeywordId, DeltaPos)]
-> ([(KeywordId, DeltaPos)], [(KeywordId, DeltaPos)])
forall a. Int -> [a] -> ([a], [a])
List.splitAt (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
j) [(KeywordId, DeltaPos)]
modAnnsDp
            mAnn' :: Annotation
mAnn' = Annotation
mAnn { annsDP :: [(KeywordId, DeltaPos)]
ExactPrint.annsDP = [(KeywordId, DeltaPos)]
pre }
            filteredAnns'' :: Anns
filteredAnns'' =
              AnnKey -> Annotation -> Anns -> Anns
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (ParsedSource -> AnnKey
forall a. Constraints a => a -> AnnKey
ExactPrint.mkAnnKey ParsedSource
lmod) Annotation
mAnn' Anns
filteredAnns
          in
            (Anns
filteredAnns'', [(KeywordId, DeltaPos)]
post')
  String
-> (CDebugConfig Identity -> Identity (Last Bool))
-> Doc
-> MultiRWST
     '[Map AnnKey Anns, PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall (m :: * -> *) a.
(MonadMultiReader Config m, Show a) =>
String
-> (CDebugConfig Identity -> Identity (Last Bool)) -> a -> m ()
traceIfDumpConf String
"bridoc annotations filtered/transformed"
                  CDebugConfig Identity -> Identity (Last Bool)
forall (f :: * -> *). CDebugConfig f -> f (Last Bool)
_dconf_dump_annotations
    (Doc
 -> MultiRWST
      '[Map AnnKey Anns, PerItemConfig, Config, Anns]
      '[Builder, [BrittanyError], Seq String]
      '[]
      Identity
      ())
-> Doc
-> MultiRWST
     '[Map AnnKey Anns, PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall a b. (a -> b) -> a -> b
$ Anns -> Doc
annsDoc Anns
filteredAnns'

  if Bool
shouldReformatPreamble
    then Config
-> Anns
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
-> MultiRWST
     '[Map AnnKey Anns, PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall a. Config -> Anns -> PPMLocal a -> PPM a
toLocal Config
config Anns
filteredAnns' (MultiRWST
   '[Config, Anns]
   '[Builder, [BrittanyError], Seq String]
   '[]
   Identity
   ()
 -> MultiRWST
      '[Map AnnKey Anns, PerItemConfig, Config, Anns]
      '[Builder, [BrittanyError], Seq String]
      '[]
      Identity
      ())
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
-> MultiRWST
     '[Map AnnKey Anns, PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall a b. (a -> b) -> a -> b
$ ParsedSource
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall ast (w :: [*]) (s :: [*]) a.
Data ast =>
ast
-> MultiRWS '[Config, Anns] w s a -> MultiRWS '[Config, Anns] w s a
withTransformedAnns ParsedSource
lmod (MultiRWST
   '[Config, Anns]
   '[Builder, [BrittanyError], Seq String]
   '[]
   Identity
   ()
 -> MultiRWST
      '[Config, Anns]
      '[Builder, [BrittanyError], Seq String]
      '[]
      Identity
      ())
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall a b. (a -> b) -> a -> b
$ do
      BriDocNumbered
briDoc <- ToBriDocM BriDocNumbered -> PPMLocal BriDocNumbered
forall a. ToBriDocM a -> PPMLocal a
briDocMToPPM (ToBriDocM BriDocNumbered -> PPMLocal BriDocNumbered)
-> ToBriDocM BriDocNumbered -> PPMLocal BriDocNumbered
forall a b. (a -> b) -> a -> b
$ ToBriDoc HsModule
layoutModule ParsedSource
lmod
      BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
layoutBriDoc BriDocNumbered
briDoc
    else
      let emptyModule :: ParsedSource
emptyModule = AnnSpan -> HsModule GhcPs -> ParsedSource
forall l e. l -> e -> GenLocated l e
L AnnSpan
loc HsModule GhcPs
m { hsmodDecls :: [LHsDecl GhcPs]
hsmodDecls = [] }
      in  Anns
-> MultiRWST
     '[Anns, Map AnnKey Anns, PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
-> MultiRWST
     '[Map AnnKey Anns, PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall (m :: * -> *) r (rs :: [*]) (w :: [*]) (s :: [*]) a.
Monad m =>
r -> MultiRWST (r : rs) w s m a -> MultiRWST rs w s m a
MultiRWSS.withMultiReader Anns
filteredAnns' (MultiRWST
   '[Anns, Map AnnKey Anns, PerItemConfig, Config, Anns]
   '[Builder, [BrittanyError], Seq String]
   '[]
   Identity
   ()
 -> MultiRWST
      '[Map AnnKey Anns, PerItemConfig, Config, Anns]
      '[Builder, [BrittanyError], Seq String]
      '[]
      Identity
      ())
-> MultiRWST
     '[Anns, Map AnnKey Anns, PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
-> MultiRWST
     '[Map AnnKey Anns, PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall a b. (a -> b) -> a -> b
$ ParsedSource
-> MultiRWST
     '[Anns, Map AnnKey Anns, PerItemConfig, Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall ast (m :: * -> *).
(Annotate ast, MonadMultiWriter Builder m,
 MonadMultiReader Anns m) =>
Located ast -> m ()
processDefault ParsedSource
emptyModule
  [(KeywordId, DeltaPos)] -> PPM [(KeywordId, DeltaPos)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(KeywordId, DeltaPos)]
post

_sigHead :: Sig GhcPs -> String
_sigHead :: Sig GhcPs -> String
_sigHead = \case
  TypeSig XTypeSig GhcPs
_ [Located (IdP GhcPs)]
names LHsSigWcType GhcPs
_ ->
    String
"TypeSig " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," (Text -> String
Text.unpack (Text -> String)
-> (GenLocated AnnSpan RdrName -> Text)
-> GenLocated AnnSpan RdrName
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated AnnSpan RdrName -> Text
forall l. GenLocated l RdrName -> Text
lrdrNameToText (GenLocated AnnSpan RdrName -> String)
-> [GenLocated AnnSpan RdrName] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Located (IdP GhcPs)]
[GenLocated AnnSpan RdrName]
names)
  Sig GhcPs
_ -> String
"unknown sig"

_bindHead :: HsBind GhcPs -> String
_bindHead :: HsBindLR GhcPs GhcPs -> String
_bindHead = \case
  FunBind XFunBind GhcPs GhcPs
_ Located (IdP GhcPs)
fId MatchGroup GhcPs (LHsExpr GhcPs)
_ HsWrapper
_ [] -> String
"FunBind " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ GenLocated AnnSpan RdrName -> Text
forall l. GenLocated l RdrName -> Text
lrdrNameToText (GenLocated AnnSpan RdrName -> Text)
-> GenLocated AnnSpan RdrName -> Text
forall a b. (a -> b) -> a -> b
$ Located (IdP GhcPs)
GenLocated AnnSpan RdrName
fId)
  PatBind XPatBind GhcPs GhcPs
_ LPat GhcPs
_pat GRHSs GhcPs (LHsExpr GhcPs)
_ ([], []) -> String
"PatBind smth"
  HsBindLR GhcPs GhcPs
_                           -> String
"unknown bind"



layoutBriDoc :: BriDocNumbered -> PPMLocal ()
layoutBriDoc :: BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
layoutBriDoc BriDocNumbered
briDoc = do
  -- first step: transform the briDoc.
  BriDoc
briDoc' <- BriDoc
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     BriDoc
forall (m :: * -> *) s (r :: [*]) (w :: [*]) (ss :: [*]) a.
Monad m =>
s -> MultiRWST r w (s : ss) m a -> MultiRWST r w ss m s
MultiRWSS.withMultiStateS BriDoc
BDEmpty (MultiRWST
   '[Config, Anns]
   '[Builder, [BrittanyError], Seq String]
   '[BriDoc]
   Identity
   ()
 -> MultiRWST
      '[Config, Anns]
      '[Builder, [BrittanyError], Seq String]
      '[]
      Identity
      BriDoc)
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     BriDoc
forall a b. (a -> b) -> a -> b
$ do
    -- Note that briDoc is BriDocNumbered, but state type is BriDoc.
    -- That's why the alt-transform looks a bit special here.
    String
-> (CDebugConfig Identity -> Identity (Last Bool))
-> Doc
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall (m :: * -> *) a.
(MonadMultiReader Config m, Show a) =>
String
-> (CDebugConfig Identity -> Identity (Last Bool)) -> a -> m ()
traceIfDumpConf String
"bridoc raw" CDebugConfig Identity -> Identity (Last Bool)
forall (f :: * -> *). CDebugConfig f -> f (Last Bool)
_dconf_dump_bridoc_raw
      (Doc
 -> MultiRWST
      '[Config, Anns]
      '[Builder, [BrittanyError], Seq String]
      '[BriDoc]
      Identity
      ())
-> Doc
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall a b. (a -> b) -> a -> b
$ BriDoc -> Doc
briDocToDoc
      (BriDoc -> Doc) -> BriDoc -> Doc
forall a b. (a -> b) -> a -> b
$ BriDocNumbered -> BriDoc
unwrapBriDocNumbered
      (BriDocNumbered -> BriDoc) -> BriDocNumbered -> BriDoc
forall a b. (a -> b) -> a -> b
$ BriDocNumbered
briDoc
    -- bridoc transformation: remove alts
    BriDocNumbered
-> MultiRWS
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     BriDoc
forall (r :: [*]) (w :: [*]) (s :: [*]).
(ContainsType Config r, ContainsType (Seq String) w) =>
BriDocNumbered -> MultiRWS r w s BriDoc
transformAlts BriDocNumbered
briDoc MultiRWS
  '[Config, Anns]
  '[Builder, [BrittanyError], Seq String]
  '[BriDoc]
  BriDoc
-> (BriDoc
    -> MultiRWST
         '[Config, Anns]
         '[Builder, [BrittanyError], Seq String]
         '[BriDoc]
         Identity
         ())
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BriDoc
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet
    MultiRWS
  '[Config, Anns]
  '[Builder, [BrittanyError], Seq String]
  '[BriDoc]
  BriDoc
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
      MultiRWS
  '[Config, Anns]
  '[Builder, [BrittanyError], Seq String]
  '[BriDoc]
  BriDoc
-> (BriDoc
    -> MultiRWST
         '[Config, Anns]
         '[Builder, [BrittanyError], Seq String]
         '[BriDoc]
         Identity
         ())
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BriDoc -> Doc
briDocToDoc
      (BriDoc -> Doc)
-> (Doc
    -> MultiRWST
         '[Config, Anns]
         '[Builder, [BrittanyError], Seq String]
         '[BriDoc]
         Identity
         ())
-> BriDoc
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall a b c. (a -> b) -> (b -> c) -> a -> c
.>  String
-> (CDebugConfig Identity -> Identity (Last Bool))
-> Doc
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall (m :: * -> *) a.
(MonadMultiReader Config m, Show a) =>
String
-> (CDebugConfig Identity -> Identity (Last Bool)) -> a -> m ()
traceIfDumpConf String
"bridoc post-alt" CDebugConfig Identity -> Identity (Last Bool)
forall (f :: * -> *). CDebugConfig f -> f (Last Bool)
_dconf_dump_bridoc_simpl_alt
    -- bridoc transformation: float stuff in
    MultiRWS
  '[Config, Anns]
  '[Builder, [BrittanyError], Seq String]
  '[BriDoc]
  BriDoc
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet MultiRWS
  '[Config, Anns]
  '[Builder, [BrittanyError], Seq String]
  '[BriDoc]
  BriDoc
-> (BriDoc
    -> MultiRWST
         '[Config, Anns]
         '[Builder, [BrittanyError], Seq String]
         '[BriDoc]
         Identity
         ())
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BriDoc -> BriDoc
transformSimplifyFloating (BriDoc -> BriDoc)
-> (BriDoc
    -> MultiRWST
         '[Config, Anns]
         '[Builder, [BrittanyError], Seq String]
         '[BriDoc]
         Identity
         ())
-> BriDoc
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> BriDoc
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet
    MultiRWS
  '[Config, Anns]
  '[Builder, [BrittanyError], Seq String]
  '[BriDoc]
  BriDoc
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
      MultiRWS
  '[Config, Anns]
  '[Builder, [BrittanyError], Seq String]
  '[BriDoc]
  BriDoc
-> (BriDoc
    -> MultiRWST
         '[Config, Anns]
         '[Builder, [BrittanyError], Seq String]
         '[BriDoc]
         Identity
         ())
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BriDoc -> Doc
briDocToDoc
      (BriDoc -> Doc)
-> (Doc
    -> MultiRWST
         '[Config, Anns]
         '[Builder, [BrittanyError], Seq String]
         '[BriDoc]
         Identity
         ())
-> BriDoc
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall a b c. (a -> b) -> (b -> c) -> a -> c
.>  String
-> (CDebugConfig Identity -> Identity (Last Bool))
-> Doc
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall (m :: * -> *) a.
(MonadMultiReader Config m, Show a) =>
String
-> (CDebugConfig Identity -> Identity (Last Bool)) -> a -> m ()
traceIfDumpConf String
"bridoc post-floating"
                          CDebugConfig Identity -> Identity (Last Bool)
forall (f :: * -> *). CDebugConfig f -> f (Last Bool)
_dconf_dump_bridoc_simpl_floating
    -- bridoc transformation: par removal
    MultiRWS
  '[Config, Anns]
  '[Builder, [BrittanyError], Seq String]
  '[BriDoc]
  BriDoc
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet MultiRWS
  '[Config, Anns]
  '[Builder, [BrittanyError], Seq String]
  '[BriDoc]
  BriDoc
-> (BriDoc
    -> MultiRWST
         '[Config, Anns]
         '[Builder, [BrittanyError], Seq String]
         '[BriDoc]
         Identity
         ())
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BriDoc -> BriDoc
transformSimplifyPar (BriDoc -> BriDoc)
-> (BriDoc
    -> MultiRWST
         '[Config, Anns]
         '[Builder, [BrittanyError], Seq String]
         '[BriDoc]
         Identity
         ())
-> BriDoc
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> BriDoc
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet
    MultiRWS
  '[Config, Anns]
  '[Builder, [BrittanyError], Seq String]
  '[BriDoc]
  BriDoc
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
      MultiRWS
  '[Config, Anns]
  '[Builder, [BrittanyError], Seq String]
  '[BriDoc]
  BriDoc
-> (BriDoc
    -> MultiRWST
         '[Config, Anns]
         '[Builder, [BrittanyError], Seq String]
         '[BriDoc]
         Identity
         ())
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BriDoc -> Doc
briDocToDoc
      (BriDoc -> Doc)
-> (Doc
    -> MultiRWST
         '[Config, Anns]
         '[Builder, [BrittanyError], Seq String]
         '[BriDoc]
         Identity
         ())
-> BriDoc
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall a b c. (a -> b) -> (b -> c) -> a -> c
.>  String
-> (CDebugConfig Identity -> Identity (Last Bool))
-> Doc
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall (m :: * -> *) a.
(MonadMultiReader Config m, Show a) =>
String
-> (CDebugConfig Identity -> Identity (Last Bool)) -> a -> m ()
traceIfDumpConf String
"bridoc post-par" CDebugConfig Identity -> Identity (Last Bool)
forall (f :: * -> *). CDebugConfig f -> f (Last Bool)
_dconf_dump_bridoc_simpl_par
    -- bridoc transformation: float stuff in
    MultiRWS
  '[Config, Anns]
  '[Builder, [BrittanyError], Seq String]
  '[BriDoc]
  BriDoc
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet MultiRWS
  '[Config, Anns]
  '[Builder, [BrittanyError], Seq String]
  '[BriDoc]
  BriDoc
-> (BriDoc
    -> MultiRWST
         '[Config, Anns]
         '[Builder, [BrittanyError], Seq String]
         '[BriDoc]
         Identity
         ())
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BriDoc -> BriDoc
transformSimplifyColumns (BriDoc -> BriDoc)
-> (BriDoc
    -> MultiRWST
         '[Config, Anns]
         '[Builder, [BrittanyError], Seq String]
         '[BriDoc]
         Identity
         ())
-> BriDoc
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> BriDoc
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet
    MultiRWS
  '[Config, Anns]
  '[Builder, [BrittanyError], Seq String]
  '[BriDoc]
  BriDoc
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
      MultiRWS
  '[Config, Anns]
  '[Builder, [BrittanyError], Seq String]
  '[BriDoc]
  BriDoc
-> (BriDoc
    -> MultiRWST
         '[Config, Anns]
         '[Builder, [BrittanyError], Seq String]
         '[BriDoc]
         Identity
         ())
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BriDoc -> Doc
briDocToDoc
      (BriDoc -> Doc)
-> (Doc
    -> MultiRWST
         '[Config, Anns]
         '[Builder, [BrittanyError], Seq String]
         '[BriDoc]
         Identity
         ())
-> BriDoc
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall a b c. (a -> b) -> (b -> c) -> a -> c
.>  String
-> (CDebugConfig Identity -> Identity (Last Bool))
-> Doc
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall (m :: * -> *) a.
(MonadMultiReader Config m, Show a) =>
String
-> (CDebugConfig Identity -> Identity (Last Bool)) -> a -> m ()
traceIfDumpConf String
"bridoc post-columns" CDebugConfig Identity -> Identity (Last Bool)
forall (f :: * -> *). CDebugConfig f -> f (Last Bool)
_dconf_dump_bridoc_simpl_columns
    -- bridoc transformation: indent
    MultiRWS
  '[Config, Anns]
  '[Builder, [BrittanyError], Seq String]
  '[BriDoc]
  BriDoc
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet MultiRWS
  '[Config, Anns]
  '[Builder, [BrittanyError], Seq String]
  '[BriDoc]
  BriDoc
-> (BriDoc
    -> MultiRWST
         '[Config, Anns]
         '[Builder, [BrittanyError], Seq String]
         '[BriDoc]
         Identity
         ())
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BriDoc -> BriDoc
transformSimplifyIndent (BriDoc -> BriDoc)
-> (BriDoc
    -> MultiRWST
         '[Config, Anns]
         '[Builder, [BrittanyError], Seq String]
         '[BriDoc]
         Identity
         ())
-> BriDoc
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> BriDoc
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet
    MultiRWS
  '[Config, Anns]
  '[Builder, [BrittanyError], Seq String]
  '[BriDoc]
  BriDoc
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
      MultiRWS
  '[Config, Anns]
  '[Builder, [BrittanyError], Seq String]
  '[BriDoc]
  BriDoc
-> (BriDoc
    -> MultiRWST
         '[Config, Anns]
         '[Builder, [BrittanyError], Seq String]
         '[BriDoc]
         Identity
         ())
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BriDoc -> Doc
briDocToDoc
      (BriDoc -> Doc)
-> (Doc
    -> MultiRWST
         '[Config, Anns]
         '[Builder, [BrittanyError], Seq String]
         '[BriDoc]
         Identity
         ())
-> BriDoc
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall a b c. (a -> b) -> (b -> c) -> a -> c
.>  String
-> (CDebugConfig Identity -> Identity (Last Bool))
-> Doc
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall (m :: * -> *) a.
(MonadMultiReader Config m, Show a) =>
String
-> (CDebugConfig Identity -> Identity (Last Bool)) -> a -> m ()
traceIfDumpConf String
"bridoc post-indent" CDebugConfig Identity -> Identity (Last Bool)
forall (f :: * -> *). CDebugConfig f -> f (Last Bool)
_dconf_dump_bridoc_simpl_indent
    MultiRWS
  '[Config, Anns]
  '[Builder, [BrittanyError], Seq String]
  '[BriDoc]
  BriDoc
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
      MultiRWS
  '[Config, Anns]
  '[Builder, [BrittanyError], Seq String]
  '[BriDoc]
  BriDoc
-> (BriDoc
    -> MultiRWST
         '[Config, Anns]
         '[Builder, [BrittanyError], Seq String]
         '[BriDoc]
         Identity
         ())
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BriDoc -> Doc
briDocToDoc
      (BriDoc -> Doc)
-> (Doc
    -> MultiRWST
         '[Config, Anns]
         '[Builder, [BrittanyError], Seq String]
         '[BriDoc]
         Identity
         ())
-> BriDoc
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall a b c. (a -> b) -> (b -> c) -> a -> c
.>  String
-> (CDebugConfig Identity -> Identity (Last Bool))
-> Doc
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[BriDoc]
     Identity
     ()
forall (m :: * -> *) a.
(MonadMultiReader Config m, Show a) =>
String
-> (CDebugConfig Identity -> Identity (Last Bool)) -> a -> m ()
traceIfDumpConf String
"bridoc final" CDebugConfig Identity -> Identity (Last Bool)
forall (f :: * -> *). CDebugConfig f -> f (Last Bool)
_dconf_dump_bridoc_final
    -- -- convert to Simple type
    -- simpl <- mGet <&> transformToSimple
    -- return simpl

  Anns
anns :: ExactPrint.Anns <- MultiRWST
  '[Config, Anns]
  '[Builder, [BrittanyError], Seq String]
  '[]
  Identity
  Anns
forall a (m :: * -> *). MonadMultiReader a m => m a
mAsk

  let state :: LayoutState
state = LayoutState :: [Int]
-> Either Int Int
-> [Int]
-> Int
-> Anns
-> Maybe Int
-> Maybe Int
-> Int
-> LayoutState
LayoutState { _lstate_baseYs :: [Int]
_lstate_baseYs           = [Int
0]
                          , _lstate_curYOrAddNewline :: Either Int Int
_lstate_curYOrAddNewline = Int -> Either Int Int
forall a b. b -> Either a b
Right Int
0 -- important that we dont use left
                                             -- here because moveToAnn stuff
                                             -- of the first node needs to do
                                             -- its thing properly.
                          , _lstate_indLevels :: [Int]
_lstate_indLevels        = [Int
0]
                          , _lstate_indLevelLinger :: Int
_lstate_indLevelLinger   = Int
0
                          , _lstate_comments :: Anns
_lstate_comments         = Anns
anns
                          , _lstate_commentCol :: Maybe Int
_lstate_commentCol       = Maybe Int
forall a. Maybe a
Nothing
                          , _lstate_addSepSpace :: Maybe Int
_lstate_addSepSpace      = Maybe Int
forall a. Maybe a
Nothing
                          , _lstate_commentNewlines :: Int
_lstate_commentNewlines  = Int
0
                          }

  LayoutState
state' <- LayoutState
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[LayoutState]
     Identity
     ()
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     LayoutState
forall (m :: * -> *) s (r :: [*]) (w :: [*]) (ss :: [*]) a.
Monad m =>
s -> MultiRWST r w (s : ss) m a -> MultiRWST r w ss m s
MultiRWSS.withMultiStateS LayoutState
state (MultiRWST
   '[Config, Anns]
   '[Builder, [BrittanyError], Seq String]
   '[LayoutState]
   Identity
   ()
 -> MultiRWST
      '[Config, Anns]
      '[Builder, [BrittanyError], Seq String]
      '[]
      Identity
      LayoutState)
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[LayoutState]
     Identity
     ()
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     LayoutState
forall a b. (a -> b) -> a -> b
$ BriDoc
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[LayoutState]
     Identity
     ()
forall (m :: * -> *). LayoutConstraints m => BriDoc -> m ()
layoutBriDocM BriDoc
briDoc'

  let remainingComments :: [(Comment, DeltaPos)]
remainingComments =
        [ (Comment, DeltaPos)
c
        | (ExactPrint.AnnKey AnnSpan
_ AnnConName
con, Annotation
elemAnns) <- Anns -> [(AnnKey, Annotation)]
forall k a. Map k a -> [(k, a)]
Map.toList
          (LayoutState -> Anns
_lstate_comments LayoutState
state')
          -- With the new import layouter, we manually process comments
          -- without relying on the backend to consume the comments out of
          -- the state/map. So they will end up here, and we need to ignore
          -- them.
        , AnnConName -> String
ExactPrint.unConName AnnConName
con String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"ImportDecl"
        , (Comment, DeltaPos)
c <- Annotation -> [(Comment, DeltaPos)]
extractAllComments Annotation
elemAnns
        ]
  [(Comment, DeltaPos)]
remainingComments
    [(Comment, DeltaPos)]
-> ((Comment, DeltaPos)
    -> MultiRWST
         '[Config, Anns]
         '[Builder, [BrittanyError], Seq String]
         '[]
         Identity
         ())
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
`forM_` ((Comment, DeltaPos) -> Comment
forall a b. (a, b) -> a
fst ((Comment, DeltaPos) -> Comment)
-> (Comment -> String) -> (Comment, DeltaPos) -> String
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> Comment -> String
forall a. Show a => a -> String
show ((Comment, DeltaPos) -> String)
-> (String -> BrittanyError)
-> (Comment, DeltaPos)
-> BrittanyError
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> String -> BrittanyError
ErrorUnusedComment ((Comment, DeltaPos) -> BrittanyError)
-> (BrittanyError -> [BrittanyError])
-> (Comment, DeltaPos)
-> [BrittanyError]
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> (BrittanyError -> [BrittanyError] -> [BrittanyError]
forall a. a -> [a] -> [a]
: []) ((Comment, DeltaPos) -> [BrittanyError])
-> ([BrittanyError]
    -> MultiRWST
         '[Config, Anns]
         '[Builder, [BrittanyError], Seq String]
         '[]
         Identity
         ())
-> (Comment, DeltaPos)
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> [BrittanyError]
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall a (m :: * -> *). MonadMultiWriter a m => a -> m ()
mTell)

  ()
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall (m :: * -> *) a. Monad m => a -> m a
return (()
 -> MultiRWST
      '[Config, Anns]
      '[Builder, [BrittanyError], Seq String]
      '[]
      Identity
      ())
-> ()
-> MultiRWST
     '[Config, Anns]
     '[Builder, [BrittanyError], Seq String]
     '[]
     Identity
     ()
forall a b. (a -> b) -> a -> b
$ ()