Refactor all modules: +Internal; Add public Brittany module
parent
5dbe0f2c9c
commit
f350113f7f
|
@ -45,27 +45,28 @@ library {
|
||||||
}
|
}
|
||||||
exposed-modules: {
|
exposed-modules: {
|
||||||
Language.Haskell.Brittany
|
Language.Haskell.Brittany
|
||||||
Language.Haskell.Brittany.Prelude
|
Language.Haskell.Brittany.Internal
|
||||||
Language.Haskell.Brittany.Types
|
Language.Haskell.Brittany.Internal.Prelude
|
||||||
Language.Haskell.Brittany.Utils
|
Language.Haskell.Brittany.Internal.Types
|
||||||
Language.Haskell.Brittany.Config
|
Language.Haskell.Brittany.Internal.Utils
|
||||||
Language.Haskell.Brittany.Config.Types
|
Language.Haskell.Brittany.Internal.Config
|
||||||
|
Language.Haskell.Brittany.Internal.Config.Types
|
||||||
}
|
}
|
||||||
other-modules: {
|
other-modules: {
|
||||||
Language.Haskell.Brittany.LayouterBasics
|
Language.Haskell.Brittany.Internal.LayouterBasics
|
||||||
Language.Haskell.Brittany.Backend
|
Language.Haskell.Brittany.Internal.Backend
|
||||||
Language.Haskell.Brittany.BackendUtils
|
Language.Haskell.Brittany.Internal.BackendUtils
|
||||||
Language.Haskell.Brittany.ExactPrintUtils
|
Language.Haskell.Brittany.Internal.ExactPrintUtils
|
||||||
Language.Haskell.Brittany.Layouters.Type
|
Language.Haskell.Brittany.Internal.Layouters.Type
|
||||||
Language.Haskell.Brittany.Layouters.Decl
|
Language.Haskell.Brittany.Internal.Layouters.Decl
|
||||||
Language.Haskell.Brittany.Layouters.Expr
|
Language.Haskell.Brittany.Internal.Layouters.Expr
|
||||||
Language.Haskell.Brittany.Layouters.Stmt
|
Language.Haskell.Brittany.Internal.Layouters.Stmt
|
||||||
Language.Haskell.Brittany.Layouters.Pattern
|
Language.Haskell.Brittany.Internal.Layouters.Pattern
|
||||||
Language.Haskell.Brittany.Transformations.Alt
|
Language.Haskell.Brittany.Internal.Transformations.Alt
|
||||||
Language.Haskell.Brittany.Transformations.Floating
|
Language.Haskell.Brittany.Internal.Transformations.Floating
|
||||||
Language.Haskell.Brittany.Transformations.Par
|
Language.Haskell.Brittany.Internal.Transformations.Par
|
||||||
Language.Haskell.Brittany.Transformations.Columns
|
Language.Haskell.Brittany.Internal.Transformations.Columns
|
||||||
Language.Haskell.Brittany.Transformations.Indent
|
Language.Haskell.Brittany.Internal.Transformations.Indent
|
||||||
Paths_brittany
|
Paths_brittany
|
||||||
}
|
}
|
||||||
ghc-options: {
|
ghc-options: {
|
||||||
|
|
|
@ -18,11 +18,11 @@ import Data.CZipWith
|
||||||
|
|
||||||
import qualified Debug.Trace as Trace
|
import qualified Debug.Trace as Trace
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Types
|
import Language.Haskell.Brittany.Internal.Types
|
||||||
import Language.Haskell.Brittany
|
import Language.Haskell.Brittany.Internal
|
||||||
import Language.Haskell.Brittany.Config
|
import Language.Haskell.Brittany.Internal.Config
|
||||||
import Language.Haskell.Brittany.Config.Types
|
import Language.Haskell.Brittany.Internal.Config.Types
|
||||||
import Language.Haskell.Brittany.Utils
|
import Language.Haskell.Brittany.Internal.Utils
|
||||||
|
|
||||||
import qualified Text.PrettyPrint as PP
|
import qualified Text.PrettyPrint as PP
|
||||||
|
|
||||||
|
|
|
@ -12,7 +12,7 @@
|
||||||
{-# LANGUAGE MultiWayIf #-}
|
{-# LANGUAGE MultiWayIf #-}
|
||||||
{-# LANGUAGE KindSignatures #-}
|
{-# LANGUAGE KindSignatures #-}
|
||||||
|
|
||||||
module Language.Haskell.Brittany.LayoutBasics
|
module Language.Haskell.Brittany.Internal.LayoutBasics
|
||||||
( processDefault
|
( processDefault
|
||||||
, layoutByExact
|
, layoutByExact
|
||||||
-- , layoutByExactR
|
-- , layoutByExactR
|
||||||
|
@ -84,9 +84,9 @@ import Language.Haskell.GHC.ExactPrint.Types ( AnnKey, Annotation )
|
||||||
|
|
||||||
import qualified Data.Text.Lazy.Builder as Text.Builder
|
import qualified Data.Text.Lazy.Builder as Text.Builder
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Config.Types
|
import Language.Haskell.Brittany.Internal.Config.Types
|
||||||
import Language.Haskell.Brittany.Types
|
import Language.Haskell.Brittany.Internal.Types
|
||||||
import Language.Haskell.Brittany.Utils
|
import Language.Haskell.Brittany.Internal.Utils
|
||||||
|
|
||||||
import RdrName ( RdrName(..) )
|
import RdrName ( RdrName(..) )
|
||||||
import GHC ( runGhc, GenLocated(L), moduleNameString )
|
import GHC ( runGhc, GenLocated(L), moduleNameString )
|
||||||
|
|
|
@ -16,9 +16,9 @@ import Text.Parsec.Text ( Parser )
|
||||||
import Data.Char ( isSpace )
|
import Data.Char ( isSpace )
|
||||||
import Data.List ( groupBy )
|
import Data.List ( groupBy )
|
||||||
|
|
||||||
import Language.Haskell.Brittany
|
import Language.Haskell.Brittany.Internal
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Config.Types
|
import Language.Haskell.Brittany.Internal.Config.Types
|
||||||
|
|
||||||
import Data.Coerce ( coerce )
|
import Data.Coerce ( coerce )
|
||||||
|
|
||||||
|
|
|
@ -13,7 +13,7 @@ import Test.Hspec
|
||||||
|
|
||||||
import NeatInterpolation
|
import NeatInterpolation
|
||||||
|
|
||||||
import Language.Haskell.Brittany
|
import Language.Haskell.Brittany.Internal
|
||||||
|
|
||||||
import TestUtils
|
import TestUtils
|
||||||
|
|
||||||
|
|
|
@ -10,7 +10,7 @@ import Test.Hspec
|
||||||
|
|
||||||
import NeatInterpolation
|
import NeatInterpolation
|
||||||
|
|
||||||
import Language.Haskell.Brittany
|
import Language.Haskell.Brittany.Internal
|
||||||
|
|
||||||
import AsymptoticPerfTests
|
import AsymptoticPerfTests
|
||||||
|
|
||||||
|
|
|
@ -10,9 +10,9 @@ import Test.Hspec
|
||||||
|
|
||||||
import NeatInterpolation
|
import NeatInterpolation
|
||||||
|
|
||||||
import Language.Haskell.Brittany
|
import Language.Haskell.Brittany.Internal
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Config.Types
|
import Language.Haskell.Brittany.Internal.Config.Types
|
||||||
|
|
||||||
import System.Timeout ( timeout )
|
import System.Timeout ( timeout )
|
||||||
|
|
||||||
|
|
|
@ -2,12 +2,8 @@
|
||||||
|
|
||||||
module Language.Haskell.Brittany
|
module Language.Haskell.Brittany
|
||||||
( pureModuleTransform
|
( pureModuleTransform
|
||||||
, parsePrintModule
|
, CConfig
|
||||||
, pPrintModule
|
, LayoutError(..)
|
||||||
, pPrintModuleAndCheck
|
|
||||||
-- re-export from utils:
|
|
||||||
, parseModule
|
|
||||||
, parseModuleFromString
|
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
@ -15,387 +11,7 @@ where
|
||||||
|
|
||||||
#include "prelude.inc"
|
#include "prelude.inc"
|
||||||
|
|
||||||
import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
|
import Language.Haskell.Brittany.Internal
|
||||||
import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
|
import Language.Haskell.Brittany.Internal.Types
|
||||||
import qualified Language.Haskell.GHC.ExactPrint.Parsers as ExactPrint.Parsers
|
import Language.Haskell.Brittany.Internal.Config.Types
|
||||||
|
|
||||||
import Data.Data
|
|
||||||
import Control.Monad.Trans.Either
|
|
||||||
import Data.HList.HList
|
|
||||||
import Data.CZipWith
|
|
||||||
|
|
||||||
import qualified Data.Text.Lazy.Builder as Text.Builder
|
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Types
|
|
||||||
import Language.Haskell.Brittany.Config.Types
|
|
||||||
import Language.Haskell.Brittany.LayouterBasics
|
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Layouters.Type
|
|
||||||
import Language.Haskell.Brittany.Layouters.Decl
|
|
||||||
import Language.Haskell.Brittany.Utils
|
|
||||||
import Language.Haskell.Brittany.Backend
|
|
||||||
import Language.Haskell.Brittany.BackendUtils
|
|
||||||
import Language.Haskell.Brittany.ExactPrintUtils
|
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Transformations.Alt
|
|
||||||
import Language.Haskell.Brittany.Transformations.Floating
|
|
||||||
import Language.Haskell.Brittany.Transformations.Par
|
|
||||||
import Language.Haskell.Brittany.Transformations.Columns
|
|
||||||
import Language.Haskell.Brittany.Transformations.Indent
|
|
||||||
|
|
||||||
import qualified GHC as GHC hiding (parseModule)
|
|
||||||
import ApiAnnotation ( AnnKeywordId(..) )
|
|
||||||
import RdrName ( RdrName(..) )
|
|
||||||
import GHC ( runGhc, GenLocated(L), moduleNameString )
|
|
||||||
import SrcLoc ( SrcSpan )
|
|
||||||
import HsSyn
|
|
||||||
import qualified DynFlags as GHC
|
|
||||||
import qualified GHC.LanguageExtensions.Type as GHC
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-- | 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.
|
|
||||||
pureModuleTransform :: CConfig Option -> Text -> IO (Either [LayoutError] Text)
|
|
||||||
pureModuleTransform oConfigRaw inputText = runEitherT $ do
|
|
||||||
let configRaw = cZipWith fromOptionIdentity staticDefaultConfig oConfigRaw
|
|
||||||
let config = configRaw { _conf_debug = _conf_debug staticDefaultConfig }
|
|
||||||
let ghcOptions = config & _conf_forward & _options_ghc & runIdentity
|
|
||||||
let config_pp = config & _conf_preprocessor
|
|
||||||
let cppMode = config_pp & _ppconf_CPPMode & confUnpack
|
|
||||||
let hackAroundIncludes = config_pp & _ppconf_hackAroundIncludes & confUnpack
|
|
||||||
(anns, parsedSource, hasCPP) <- do
|
|
||||||
let hackF s = if "#include" `isPrefixOf` s
|
|
||||||
then "-- BRITTANY_INCLUDE_HACK " ++ s
|
|
||||||
else s
|
|
||||||
let hackTransform = if hackAroundIncludes
|
|
||||||
then List.unlines . fmap hackF . List.lines
|
|
||||||
else id
|
|
||||||
let cppCheckFunc dynFlags = if GHC.xopt GHC.Cpp dynFlags
|
|
||||||
then case cppMode of
|
|
||||||
CPPModeAbort -> return $ Left "Encountered -XCPP. Aborting."
|
|
||||||
CPPModeWarn -> return $ Right True
|
|
||||||
CPPModeNowarn -> return $ Right True
|
|
||||||
else return $ Right False
|
|
||||||
parseResult <- lift $ parseModuleFromString
|
|
||||||
ghcOptions
|
|
||||||
"stdin"
|
|
||||||
cppCheckFunc
|
|
||||||
(hackTransform $ Text.unpack inputText)
|
|
||||||
case parseResult of
|
|
||||||
Left err -> left $ [LayoutErrorInput err]
|
|
||||||
Right x -> pure $ x
|
|
||||||
(errsWarns, outputTextL) <- do
|
|
||||||
let omitCheck =
|
|
||||||
config
|
|
||||||
& _conf_errorHandling
|
|
||||||
& _econf_omit_output_valid_check
|
|
||||||
& confUnpack
|
|
||||||
(ews, outRaw) <- if hasCPP || omitCheck
|
|
||||||
then return $ pPrintModule config anns parsedSource
|
|
||||||
else lift $ pPrintModuleAndCheck config anns parsedSource
|
|
||||||
let hackF s = fromMaybe s
|
|
||||||
$ TextL.stripPrefix (TextL.pack "-- BRITTANY_INCLUDE_HACK ") s
|
|
||||||
pure $ if hackAroundIncludes
|
|
||||||
then (ews, TextL.unlines $ fmap hackF $ TextL.lines outRaw)
|
|
||||||
else (ews, outRaw)
|
|
||||||
let customErrOrder LayoutErrorInput{} = 4
|
|
||||||
customErrOrder LayoutWarning{} = 0 :: Int
|
|
||||||
customErrOrder LayoutErrorOutputCheck{} = 1
|
|
||||||
customErrOrder LayoutErrorUnusedComment{} = 2
|
|
||||||
customErrOrder LayoutErrorUnknownNode{} = 3
|
|
||||||
let hasErrors =
|
|
||||||
case config & _conf_errorHandling & _econf_Werror & confUnpack of
|
|
||||||
False -> 0 < maximum (-1 : fmap customErrOrder errsWarns)
|
|
||||||
True -> not $ null errsWarns
|
|
||||||
if hasErrors
|
|
||||||
then left $ errsWarns
|
|
||||||
else pure $ TextL.toStrict outputTextL
|
|
||||||
|
|
||||||
|
|
||||||
-- LayoutErrors 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
|
|
||||||
-> ExactPrint.Types.Anns
|
|
||||||
-> GHC.ParsedSource
|
|
||||||
-> ([LayoutError], TextL.Text)
|
|
||||||
pPrintModule conf anns parsedModule =
|
|
||||||
let
|
|
||||||
((out, errs), debugStrings) =
|
|
||||||
runIdentity
|
|
||||||
$ MultiRWSS.runMultiRWSTNil
|
|
||||||
$ MultiRWSS.withMultiWriterAW
|
|
||||||
$ MultiRWSS.withMultiWriterAW
|
|
||||||
$ MultiRWSS.withMultiWriterW
|
|
||||||
$ MultiRWSS.withMultiReader anns
|
|
||||||
$ MultiRWSS.withMultiReader conf
|
|
||||||
$ do
|
|
||||||
traceIfDumpConf "bridoc annotations raw" _dconf_dump_annotations
|
|
||||||
$ annsDoc anns
|
|
||||||
ppModule parsedModule
|
|
||||||
tracer =
|
|
||||||
if Seq.null debugStrings
|
|
||||||
then
|
|
||||||
id
|
|
||||||
else
|
|
||||||
trace ("---- DEBUGMESSAGES ---- ")
|
|
||||||
. foldr (seq . join trace) id debugStrings
|
|
||||||
in
|
|
||||||
tracer $ (errs, Text.Builder.toLazyText 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
|
|
||||||
-> ExactPrint.Types.Anns
|
|
||||||
-> GHC.ParsedSource
|
|
||||||
-> IO ([LayoutError], TextL.Text)
|
|
||||||
pPrintModuleAndCheck conf anns parsedModule = do
|
|
||||||
let ghcOptions = conf & _conf_forward & _options_ghc & runIdentity
|
|
||||||
let (errs, output) = pPrintModule conf anns parsedModule
|
|
||||||
parseResult <- parseModuleFromString ghcOptions
|
|
||||||
"output"
|
|
||||||
(\_ -> return $ Right ())
|
|
||||||
(TextL.unpack output)
|
|
||||||
let errs' = errs ++ case parseResult of
|
|
||||||
Left{} -> [LayoutErrorOutputCheck]
|
|
||||||
Right{} -> []
|
|
||||||
return (errs', output)
|
|
||||||
|
|
||||||
|
|
||||||
-- used for testing mostly, currently.
|
|
||||||
parsePrintModule :: Config -> String -> Text -> IO (Either String Text)
|
|
||||||
parsePrintModule conf filename input = do
|
|
||||||
let inputStr = Text.unpack input
|
|
||||||
parseResult <- ExactPrint.Parsers.parseModuleFromString filename inputStr
|
|
||||||
case parseResult of
|
|
||||||
Left (_ , s ) -> return $ Left $ "parsing error: " ++ s
|
|
||||||
Right (anns, parsedModule) -> do
|
|
||||||
let omitCheck =
|
|
||||||
conf
|
|
||||||
& _conf_errorHandling
|
|
||||||
.> _econf_omit_output_valid_check
|
|
||||||
.> confUnpack
|
|
||||||
(errs, ltext) <- if omitCheck
|
|
||||||
then return $ pPrintModule conf anns parsedModule
|
|
||||||
else pPrintModuleAndCheck conf anns parsedModule
|
|
||||||
return $ if null errs
|
|
||||||
then Right $ TextL.toStrict $ ltext
|
|
||||||
else
|
|
||||||
let
|
|
||||||
errStrs = errs <&> \case
|
|
||||||
LayoutErrorInput str -> str
|
|
||||||
LayoutErrorUnusedComment str -> str
|
|
||||||
LayoutWarning str -> str
|
|
||||||
LayoutErrorUnknownNode str _ -> str
|
|
||||||
LayoutErrorOutputCheck -> "Output is not syntactically valid."
|
|
||||||
in
|
|
||||||
Left $ "pretty printing error(s):\n" ++ List.unlines errStrs
|
|
||||||
|
|
||||||
|
|
||||||
-- this approach would for with there was a pure GHC.parseDynamicFilePragma.
|
|
||||||
-- Unfortunately that does not exist yet, so we cannot provide a nominally
|
|
||||||
-- pure interface.
|
|
||||||
|
|
||||||
-- parsePrintModule :: Text -> Either String Text
|
|
||||||
-- parsePrintModule 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
|
|
||||||
-- LayoutErrorUnusedComment str -> str
|
|
||||||
-- Left $ "pretty printing error(s):\n" ++ List.unlines errStrs
|
|
||||||
-- else return $ TextL.toStrict $ Text.Builder.toLazyText out
|
|
||||||
|
|
||||||
ppModule :: GenLocated SrcSpan (HsModule RdrName) -> PPM ()
|
|
||||||
ppModule lmod@(L loc m@(HsModule _name _exports _imports decls _ _)) = do
|
|
||||||
let emptyModule = L loc m { hsmodDecls = [] }
|
|
||||||
(anns', post) <- do
|
|
||||||
anns <- mAsk
|
|
||||||
-- evil partiality. but rather unlikely.
|
|
||||||
return $ case Map.lookup (ExactPrint.Types.mkAnnKey lmod) anns of
|
|
||||||
Nothing -> (anns, [])
|
|
||||||
Just mAnn ->
|
|
||||||
let modAnnsDp = ExactPrint.Types.annsDP mAnn
|
|
||||||
isWhere (ExactPrint.Types.G AnnWhere) = True
|
|
||||||
isWhere _ = False
|
|
||||||
isEof (ExactPrint.Types.G AnnEofPos) = True
|
|
||||||
isEof _ = False
|
|
||||||
whereInd = List.findIndex (isWhere . fst) modAnnsDp
|
|
||||||
eofInd = List.findIndex (isEof . fst) modAnnsDp
|
|
||||||
(pre, post) = case (whereInd, eofInd) of
|
|
||||||
(Nothing, Nothing) -> ([], modAnnsDp)
|
|
||||||
(Just i , Nothing) -> List.splitAt (i + 1) modAnnsDp
|
|
||||||
(Nothing, Just _i) -> ([], modAnnsDp)
|
|
||||||
(Just i , Just j ) -> List.splitAt (min (i + 1) j) modAnnsDp
|
|
||||||
mAnn' = mAnn { ExactPrint.Types.annsDP = pre }
|
|
||||||
anns' = Map.insert (ExactPrint.Types.mkAnnKey lmod) mAnn' anns
|
|
||||||
in (anns', post)
|
|
||||||
MultiRWSS.withMultiReader anns' $ processDefault emptyModule
|
|
||||||
decls `forM_` ppDecl
|
|
||||||
let finalComments = filter
|
|
||||||
( fst .> \case
|
|
||||||
ExactPrint.Types.AnnComment{} -> True
|
|
||||||
_ -> False
|
|
||||||
)
|
|
||||||
post
|
|
||||||
post `forM_` \case
|
|
||||||
(ExactPrint.Types.AnnComment (ExactPrint.Types.Comment cmStr _ _), l) -> do
|
|
||||||
ppmMoveToExactLoc l
|
|
||||||
mTell $ Text.Builder.fromString cmStr
|
|
||||||
(ExactPrint.Types.G AnnEofPos, (ExactPrint.Types.DP (eofX, eofY))) ->
|
|
||||||
let
|
|
||||||
folder (acc, _) (kw, ExactPrint.Types.DP (x, y)) = case kw of
|
|
||||||
ExactPrint.Types.AnnComment cm
|
|
||||||
| GHC.RealSrcSpan span <- ExactPrint.Types.commentIdentifier cm
|
|
||||||
-> ( acc + x + GHC.srcSpanEndLine span - GHC.srcSpanStartLine span
|
|
||||||
, y + GHC.srcSpanEndCol span - GHC.srcSpanStartCol span
|
|
||||||
)
|
|
||||||
_ -> (acc + x, y)
|
|
||||||
(cmX, cmY) = foldl' folder (0, 0) finalComments
|
|
||||||
in
|
|
||||||
ppmMoveToExactLoc $ ExactPrint.Types.DP (eofX - cmX, eofY - cmY)
|
|
||||||
_ -> return ()
|
|
||||||
|
|
||||||
withTransformedAnns :: Data ast => ast -> PPM () -> PPM ()
|
|
||||||
withTransformedAnns ast m = do
|
|
||||||
-- TODO: implement `local` for MultiReader/MultiRWS
|
|
||||||
readers@(conf :+: anns :+: HNil) <- MultiRWSS.mGetRawR
|
|
||||||
MultiRWSS.mPutRawR (conf :+: f anns :+: HNil)
|
|
||||||
m
|
|
||||||
MultiRWSS.mPutRawR readers
|
|
||||||
where
|
|
||||||
f anns =
|
|
||||||
let ((), (annsBalanced, _), _) =
|
|
||||||
ExactPrint.runTransform anns (commentAnnFixTransformGlob ast)
|
|
||||||
in annsBalanced
|
|
||||||
|
|
||||||
|
|
||||||
ppDecl :: LHsDecl RdrName -> PPM ()
|
|
||||||
ppDecl d@(L loc decl) = case decl of
|
|
||||||
SigD sig -> -- trace (_sigHead sig) $
|
|
||||||
withTransformedAnns d $ do
|
|
||||||
-- runLayouter $ Old.layoutSig (L loc sig)
|
|
||||||
briDoc <- briDocMToPPM $ layoutSig (L loc sig)
|
|
||||||
layoutBriDoc d briDoc
|
|
||||||
ValD bind -> -- trace (_bindHead bind) $
|
|
||||||
withTransformedAnns d $ do
|
|
||||||
-- Old.layoutBind (L loc bind)
|
|
||||||
briDoc <- briDocMToPPM $ do
|
|
||||||
eitherNode <- layoutBind (L loc bind)
|
|
||||||
case eitherNode of
|
|
||||||
Left ns -> docLines $ return <$> ns
|
|
||||||
Right n -> return n
|
|
||||||
layoutBriDoc d briDoc
|
|
||||||
_ -> briDocMToPPM (briDocByExactNoComment d) >>= layoutBriDoc d
|
|
||||||
|
|
||||||
_sigHead :: Sig RdrName -> String
|
|
||||||
_sigHead = \case
|
|
||||||
TypeSig names _ ->
|
|
||||||
"TypeSig " ++ intercalate "," (Text.unpack . lrdrNameToText <$> names)
|
|
||||||
_ -> "unknown sig"
|
|
||||||
|
|
||||||
_bindHead :: HsBind RdrName -> String
|
|
||||||
_bindHead = \case
|
|
||||||
FunBind fId _ _ _ [] -> "FunBind " ++ (Text.unpack $ lrdrNameToText $ fId)
|
|
||||||
PatBind _pat _ _ _ ([], []) -> "PatBind smth"
|
|
||||||
_ -> "unknown bind"
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
layoutBriDoc :: Data.Data.Data ast => ast -> BriDocNumbered -> PPM ()
|
|
||||||
layoutBriDoc ast briDoc = do
|
|
||||||
-- first step: transform the briDoc.
|
|
||||||
briDoc' <- MultiRWSS.withMultiStateS BDEmpty $ do
|
|
||||||
-- Note that briDoc is BriDocNumbered, but state type is BriDoc.
|
|
||||||
-- That's why the alt-transform looks a bit special here.
|
|
||||||
traceIfDumpConf "bridoc raw" _dconf_dump_bridoc_raw
|
|
||||||
$ briDocToDoc
|
|
||||||
$ unwrapBriDocNumbered
|
|
||||||
$ briDoc
|
|
||||||
-- bridoc transformation: remove alts
|
|
||||||
transformAlts briDoc >>= mSet
|
|
||||||
mGet >>= briDocToDoc .> traceIfDumpConf "bridoc post-alt"
|
|
||||||
_dconf_dump_bridoc_simpl_alt
|
|
||||||
-- bridoc transformation: float stuff in
|
|
||||||
mGet >>= transformSimplifyFloating .> mSet
|
|
||||||
mGet >>= briDocToDoc .> traceIfDumpConf "bridoc post-floating"
|
|
||||||
_dconf_dump_bridoc_simpl_floating
|
|
||||||
-- bridoc transformation: par removal
|
|
||||||
mGet >>= transformSimplifyPar .> mSet
|
|
||||||
mGet >>= briDocToDoc .> traceIfDumpConf "bridoc post-par"
|
|
||||||
_dconf_dump_bridoc_simpl_par
|
|
||||||
-- bridoc transformation: float stuff in
|
|
||||||
mGet >>= transformSimplifyColumns .> mSet
|
|
||||||
mGet >>= briDocToDoc .> traceIfDumpConf "bridoc post-columns"
|
|
||||||
_dconf_dump_bridoc_simpl_columns
|
|
||||||
-- bridoc transformation: indent
|
|
||||||
mGet >>= transformSimplifyIndent .> mSet
|
|
||||||
mGet >>= briDocToDoc .> traceIfDumpConf "bridoc post-indent"
|
|
||||||
_dconf_dump_bridoc_simpl_indent
|
|
||||||
mGet >>= briDocToDoc .> traceIfDumpConf "bridoc final"
|
|
||||||
_dconf_dump_bridoc_final
|
|
||||||
-- -- convert to Simple type
|
|
||||||
-- simpl <- mGet <&> transformToSimple
|
|
||||||
-- return simpl
|
|
||||||
|
|
||||||
anns :: ExactPrint.Types.Anns <- mAsk
|
|
||||||
let filteredAnns = filterAnns ast anns
|
|
||||||
|
|
||||||
traceIfDumpConf "bridoc annotations filtered/transformed"
|
|
||||||
_dconf_dump_annotations
|
|
||||||
$ annsDoc filteredAnns
|
|
||||||
|
|
||||||
let state = LayoutState
|
|
||||||
{ _lstate_baseYs = [0]
|
|
||||||
, _lstate_curYOrAddNewline = Right 0 -- important that we use left here
|
|
||||||
-- because moveToAnn stuff of the
|
|
||||||
-- first node needs to do its
|
|
||||||
-- thing properly.
|
|
||||||
, _lstate_indLevels = [0]
|
|
||||||
, _lstate_indLevelLinger = 0
|
|
||||||
, _lstate_comments = filteredAnns
|
|
||||||
, _lstate_commentCol = Nothing
|
|
||||||
, _lstate_addSepSpace = Nothing
|
|
||||||
, _lstate_inhibitMTEL = False
|
|
||||||
}
|
|
||||||
|
|
||||||
state' <- MultiRWSS.withMultiStateS state $ layoutBriDocM briDoc'
|
|
||||||
|
|
||||||
let remainingComments =
|
|
||||||
extractAllComments =<< Map.elems (_lstate_comments state')
|
|
||||||
remainingComments
|
|
||||||
`forM_` (fst .> show .> LayoutErrorUnusedComment .> (:[]) .> mTell)
|
|
||||||
|
|
||||||
return $ ()
|
|
||||||
|
|
|
@ -0,0 +1,401 @@
|
||||||
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
|
||||||
|
module Language.Haskell.Brittany.Internal
|
||||||
|
( pureModuleTransform
|
||||||
|
, parsePrintModule
|
||||||
|
, pPrintModule
|
||||||
|
, pPrintModuleAndCheck
|
||||||
|
-- re-export from utils:
|
||||||
|
, parseModule
|
||||||
|
, parseModuleFromString
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
#include "prelude.inc"
|
||||||
|
|
||||||
|
import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
|
||||||
|
import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
|
||||||
|
import qualified Language.Haskell.GHC.ExactPrint.Parsers as ExactPrint.Parsers
|
||||||
|
|
||||||
|
import Data.Data
|
||||||
|
import Control.Monad.Trans.Either
|
||||||
|
import Data.HList.HList
|
||||||
|
import Data.CZipWith
|
||||||
|
|
||||||
|
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.LayouterBasics
|
||||||
|
|
||||||
|
import Language.Haskell.Brittany.Internal.Layouters.Type
|
||||||
|
import Language.Haskell.Brittany.Internal.Layouters.Decl
|
||||||
|
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 RdrName ( RdrName(..) )
|
||||||
|
import GHC ( runGhc, GenLocated(L), moduleNameString )
|
||||||
|
import SrcLoc ( SrcSpan )
|
||||||
|
import HsSyn
|
||||||
|
import qualified DynFlags as GHC
|
||||||
|
import qualified GHC.LanguageExtensions.Type as GHC
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- | 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.
|
||||||
|
pureModuleTransform :: CConfig Option -> Text -> IO (Either [LayoutError] Text)
|
||||||
|
pureModuleTransform oConfigRaw inputText = runEitherT $ do
|
||||||
|
let configRaw = cZipWith fromOptionIdentity staticDefaultConfig oConfigRaw
|
||||||
|
let config = configRaw { _conf_debug = _conf_debug staticDefaultConfig }
|
||||||
|
let ghcOptions = config & _conf_forward & _options_ghc & runIdentity
|
||||||
|
let config_pp = config & _conf_preprocessor
|
||||||
|
let cppMode = config_pp & _ppconf_CPPMode & confUnpack
|
||||||
|
let hackAroundIncludes = config_pp & _ppconf_hackAroundIncludes & confUnpack
|
||||||
|
(anns, parsedSource, hasCPP) <- do
|
||||||
|
let hackF s = if "#include" `isPrefixOf` s
|
||||||
|
then "-- BRITTANY_INCLUDE_HACK " ++ s
|
||||||
|
else s
|
||||||
|
let hackTransform = if hackAroundIncludes
|
||||||
|
then List.unlines . fmap hackF . List.lines
|
||||||
|
else id
|
||||||
|
let cppCheckFunc dynFlags = if GHC.xopt GHC.Cpp dynFlags
|
||||||
|
then case cppMode of
|
||||||
|
CPPModeAbort -> return $ Left "Encountered -XCPP. Aborting."
|
||||||
|
CPPModeWarn -> return $ Right True
|
||||||
|
CPPModeNowarn -> return $ Right True
|
||||||
|
else return $ Right False
|
||||||
|
parseResult <- lift $ parseModuleFromString
|
||||||
|
ghcOptions
|
||||||
|
"stdin"
|
||||||
|
cppCheckFunc
|
||||||
|
(hackTransform $ Text.unpack inputText)
|
||||||
|
case parseResult of
|
||||||
|
Left err -> left $ [LayoutErrorInput err]
|
||||||
|
Right x -> pure $ x
|
||||||
|
(errsWarns, outputTextL) <- do
|
||||||
|
let omitCheck =
|
||||||
|
config
|
||||||
|
& _conf_errorHandling
|
||||||
|
& _econf_omit_output_valid_check
|
||||||
|
& confUnpack
|
||||||
|
(ews, outRaw) <- if hasCPP || omitCheck
|
||||||
|
then return $ pPrintModule config anns parsedSource
|
||||||
|
else lift $ pPrintModuleAndCheck config anns parsedSource
|
||||||
|
let hackF s = fromMaybe s
|
||||||
|
$ TextL.stripPrefix (TextL.pack "-- BRITTANY_INCLUDE_HACK ") s
|
||||||
|
pure $ if hackAroundIncludes
|
||||||
|
then (ews, TextL.unlines $ fmap hackF $ TextL.lines outRaw)
|
||||||
|
else (ews, outRaw)
|
||||||
|
let customErrOrder LayoutErrorInput{} = 4
|
||||||
|
customErrOrder LayoutWarning{} = 0 :: Int
|
||||||
|
customErrOrder LayoutErrorOutputCheck{} = 1
|
||||||
|
customErrOrder LayoutErrorUnusedComment{} = 2
|
||||||
|
customErrOrder LayoutErrorUnknownNode{} = 3
|
||||||
|
let hasErrors =
|
||||||
|
case config & _conf_errorHandling & _econf_Werror & confUnpack of
|
||||||
|
False -> 0 < maximum (-1 : fmap customErrOrder errsWarns)
|
||||||
|
True -> not $ null errsWarns
|
||||||
|
if hasErrors
|
||||||
|
then left $ errsWarns
|
||||||
|
else pure $ TextL.toStrict outputTextL
|
||||||
|
|
||||||
|
|
||||||
|
-- LayoutErrors 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
|
||||||
|
-> ExactPrint.Types.Anns
|
||||||
|
-> GHC.ParsedSource
|
||||||
|
-> ([LayoutError], TextL.Text)
|
||||||
|
pPrintModule conf anns parsedModule =
|
||||||
|
let
|
||||||
|
((out, errs), debugStrings) =
|
||||||
|
runIdentity
|
||||||
|
$ MultiRWSS.runMultiRWSTNil
|
||||||
|
$ MultiRWSS.withMultiWriterAW
|
||||||
|
$ MultiRWSS.withMultiWriterAW
|
||||||
|
$ MultiRWSS.withMultiWriterW
|
||||||
|
$ MultiRWSS.withMultiReader anns
|
||||||
|
$ MultiRWSS.withMultiReader conf
|
||||||
|
$ do
|
||||||
|
traceIfDumpConf "bridoc annotations raw" _dconf_dump_annotations
|
||||||
|
$ annsDoc anns
|
||||||
|
ppModule parsedModule
|
||||||
|
tracer =
|
||||||
|
if Seq.null debugStrings
|
||||||
|
then
|
||||||
|
id
|
||||||
|
else
|
||||||
|
trace ("---- DEBUGMESSAGES ---- ")
|
||||||
|
. foldr (seq . join trace) id debugStrings
|
||||||
|
in
|
||||||
|
tracer $ (errs, Text.Builder.toLazyText 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
|
||||||
|
-> ExactPrint.Types.Anns
|
||||||
|
-> GHC.ParsedSource
|
||||||
|
-> IO ([LayoutError], TextL.Text)
|
||||||
|
pPrintModuleAndCheck conf anns parsedModule = do
|
||||||
|
let ghcOptions = conf & _conf_forward & _options_ghc & runIdentity
|
||||||
|
let (errs, output) = pPrintModule conf anns parsedModule
|
||||||
|
parseResult <- parseModuleFromString ghcOptions
|
||||||
|
"output"
|
||||||
|
(\_ -> return $ Right ())
|
||||||
|
(TextL.unpack output)
|
||||||
|
let errs' = errs ++ case parseResult of
|
||||||
|
Left{} -> [LayoutErrorOutputCheck]
|
||||||
|
Right{} -> []
|
||||||
|
return (errs', output)
|
||||||
|
|
||||||
|
|
||||||
|
-- used for testing mostly, currently.
|
||||||
|
parsePrintModule :: Config -> String -> Text -> IO (Either String Text)
|
||||||
|
parsePrintModule conf filename input = do
|
||||||
|
let inputStr = Text.unpack input
|
||||||
|
parseResult <- ExactPrint.Parsers.parseModuleFromString filename inputStr
|
||||||
|
case parseResult of
|
||||||
|
Left (_ , s ) -> return $ Left $ "parsing error: " ++ s
|
||||||
|
Right (anns, parsedModule) -> do
|
||||||
|
let omitCheck =
|
||||||
|
conf
|
||||||
|
& _conf_errorHandling
|
||||||
|
.> _econf_omit_output_valid_check
|
||||||
|
.> confUnpack
|
||||||
|
(errs, ltext) <- if omitCheck
|
||||||
|
then return $ pPrintModule conf anns parsedModule
|
||||||
|
else pPrintModuleAndCheck conf anns parsedModule
|
||||||
|
return $ if null errs
|
||||||
|
then Right $ TextL.toStrict $ ltext
|
||||||
|
else
|
||||||
|
let
|
||||||
|
errStrs = errs <&> \case
|
||||||
|
LayoutErrorInput str -> str
|
||||||
|
LayoutErrorUnusedComment str -> str
|
||||||
|
LayoutWarning str -> str
|
||||||
|
LayoutErrorUnknownNode str _ -> str
|
||||||
|
LayoutErrorOutputCheck -> "Output is not syntactically valid."
|
||||||
|
in
|
||||||
|
Left $ "pretty printing error(s):\n" ++ List.unlines errStrs
|
||||||
|
|
||||||
|
|
||||||
|
-- this approach would for with there was a pure GHC.parseDynamicFilePragma.
|
||||||
|
-- Unfortunately that does not exist yet, so we cannot provide a nominally
|
||||||
|
-- pure interface.
|
||||||
|
|
||||||
|
-- parsePrintModule :: Text -> Either String Text
|
||||||
|
-- parsePrintModule 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
|
||||||
|
-- LayoutErrorUnusedComment str -> str
|
||||||
|
-- Left $ "pretty printing error(s):\n" ++ List.unlines errStrs
|
||||||
|
-- else return $ TextL.toStrict $ Text.Builder.toLazyText out
|
||||||
|
|
||||||
|
ppModule :: GenLocated SrcSpan (HsModule RdrName) -> PPM ()
|
||||||
|
ppModule lmod@(L loc m@(HsModule _name _exports _imports decls _ _)) = do
|
||||||
|
let emptyModule = L loc m { hsmodDecls = [] }
|
||||||
|
(anns', post) <- do
|
||||||
|
anns <- mAsk
|
||||||
|
-- evil partiality. but rather unlikely.
|
||||||
|
return $ case Map.lookup (ExactPrint.Types.mkAnnKey lmod) anns of
|
||||||
|
Nothing -> (anns, [])
|
||||||
|
Just mAnn ->
|
||||||
|
let modAnnsDp = ExactPrint.Types.annsDP mAnn
|
||||||
|
isWhere (ExactPrint.Types.G AnnWhere) = True
|
||||||
|
isWhere _ = False
|
||||||
|
isEof (ExactPrint.Types.G AnnEofPos) = True
|
||||||
|
isEof _ = False
|
||||||
|
whereInd = List.findIndex (isWhere . fst) modAnnsDp
|
||||||
|
eofInd = List.findIndex (isEof . fst) modAnnsDp
|
||||||
|
(pre, post) = case (whereInd, eofInd) of
|
||||||
|
(Nothing, Nothing) -> ([], modAnnsDp)
|
||||||
|
(Just i , Nothing) -> List.splitAt (i + 1) modAnnsDp
|
||||||
|
(Nothing, Just _i) -> ([], modAnnsDp)
|
||||||
|
(Just i , Just j ) -> List.splitAt (min (i + 1) j) modAnnsDp
|
||||||
|
mAnn' = mAnn { ExactPrint.Types.annsDP = pre }
|
||||||
|
anns' = Map.insert (ExactPrint.Types.mkAnnKey lmod) mAnn' anns
|
||||||
|
in (anns', post)
|
||||||
|
MultiRWSS.withMultiReader anns' $ processDefault emptyModule
|
||||||
|
decls `forM_` ppDecl
|
||||||
|
let finalComments = filter
|
||||||
|
( fst .> \case
|
||||||
|
ExactPrint.Types.AnnComment{} -> True
|
||||||
|
_ -> False
|
||||||
|
)
|
||||||
|
post
|
||||||
|
post `forM_` \case
|
||||||
|
(ExactPrint.Types.AnnComment (ExactPrint.Types.Comment cmStr _ _), l) -> do
|
||||||
|
ppmMoveToExactLoc l
|
||||||
|
mTell $ Text.Builder.fromString cmStr
|
||||||
|
(ExactPrint.Types.G AnnEofPos, (ExactPrint.Types.DP (eofX, eofY))) ->
|
||||||
|
let
|
||||||
|
folder (acc, _) (kw, ExactPrint.Types.DP (x, y)) = case kw of
|
||||||
|
ExactPrint.Types.AnnComment cm
|
||||||
|
| GHC.RealSrcSpan span <- ExactPrint.Types.commentIdentifier cm
|
||||||
|
-> ( acc + x + GHC.srcSpanEndLine span - GHC.srcSpanStartLine span
|
||||||
|
, y + GHC.srcSpanEndCol span - GHC.srcSpanStartCol span
|
||||||
|
)
|
||||||
|
_ -> (acc + x, y)
|
||||||
|
(cmX, cmY) = foldl' folder (0, 0) finalComments
|
||||||
|
in
|
||||||
|
ppmMoveToExactLoc $ ExactPrint.Types.DP (eofX - cmX, eofY - cmY)
|
||||||
|
_ -> return ()
|
||||||
|
|
||||||
|
withTransformedAnns :: Data ast => ast -> PPM () -> PPM ()
|
||||||
|
withTransformedAnns ast m = do
|
||||||
|
-- TODO: implement `local` for MultiReader/MultiRWS
|
||||||
|
readers@(conf :+: anns :+: HNil) <- MultiRWSS.mGetRawR
|
||||||
|
MultiRWSS.mPutRawR (conf :+: f anns :+: HNil)
|
||||||
|
m
|
||||||
|
MultiRWSS.mPutRawR readers
|
||||||
|
where
|
||||||
|
f anns =
|
||||||
|
let ((), (annsBalanced, _), _) =
|
||||||
|
ExactPrint.runTransform anns (commentAnnFixTransformGlob ast)
|
||||||
|
in annsBalanced
|
||||||
|
|
||||||
|
|
||||||
|
ppDecl :: LHsDecl RdrName -> PPM ()
|
||||||
|
ppDecl d@(L loc decl) = case decl of
|
||||||
|
SigD sig -> -- trace (_sigHead sig) $
|
||||||
|
withTransformedAnns d $ do
|
||||||
|
-- runLayouter $ Old.layoutSig (L loc sig)
|
||||||
|
briDoc <- briDocMToPPM $ layoutSig (L loc sig)
|
||||||
|
layoutBriDoc d briDoc
|
||||||
|
ValD bind -> -- trace (_bindHead bind) $
|
||||||
|
withTransformedAnns d $ do
|
||||||
|
-- Old.layoutBind (L loc bind)
|
||||||
|
briDoc <- briDocMToPPM $ do
|
||||||
|
eitherNode <- layoutBind (L loc bind)
|
||||||
|
case eitherNode of
|
||||||
|
Left ns -> docLines $ return <$> ns
|
||||||
|
Right n -> return n
|
||||||
|
layoutBriDoc d briDoc
|
||||||
|
_ -> briDocMToPPM (briDocByExactNoComment d) >>= layoutBriDoc d
|
||||||
|
|
||||||
|
_sigHead :: Sig RdrName -> String
|
||||||
|
_sigHead = \case
|
||||||
|
TypeSig names _ ->
|
||||||
|
"TypeSig " ++ intercalate "," (Text.unpack . lrdrNameToText <$> names)
|
||||||
|
_ -> "unknown sig"
|
||||||
|
|
||||||
|
_bindHead :: HsBind RdrName -> String
|
||||||
|
_bindHead = \case
|
||||||
|
FunBind fId _ _ _ [] -> "FunBind " ++ (Text.unpack $ lrdrNameToText $ fId)
|
||||||
|
PatBind _pat _ _ _ ([], []) -> "PatBind smth"
|
||||||
|
_ -> "unknown bind"
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
layoutBriDoc :: Data.Data.Data ast => ast -> BriDocNumbered -> PPM ()
|
||||||
|
layoutBriDoc ast briDoc = do
|
||||||
|
-- first step: transform the briDoc.
|
||||||
|
briDoc' <- MultiRWSS.withMultiStateS BDEmpty $ do
|
||||||
|
-- Note that briDoc is BriDocNumbered, but state type is BriDoc.
|
||||||
|
-- That's why the alt-transform looks a bit special here.
|
||||||
|
traceIfDumpConf "bridoc raw" _dconf_dump_bridoc_raw
|
||||||
|
$ briDocToDoc
|
||||||
|
$ unwrapBriDocNumbered
|
||||||
|
$ briDoc
|
||||||
|
-- bridoc transformation: remove alts
|
||||||
|
transformAlts briDoc >>= mSet
|
||||||
|
mGet >>= briDocToDoc .> traceIfDumpConf "bridoc post-alt"
|
||||||
|
_dconf_dump_bridoc_simpl_alt
|
||||||
|
-- bridoc transformation: float stuff in
|
||||||
|
mGet >>= transformSimplifyFloating .> mSet
|
||||||
|
mGet >>= briDocToDoc .> traceIfDumpConf "bridoc post-floating"
|
||||||
|
_dconf_dump_bridoc_simpl_floating
|
||||||
|
-- bridoc transformation: par removal
|
||||||
|
mGet >>= transformSimplifyPar .> mSet
|
||||||
|
mGet >>= briDocToDoc .> traceIfDumpConf "bridoc post-par"
|
||||||
|
_dconf_dump_bridoc_simpl_par
|
||||||
|
-- bridoc transformation: float stuff in
|
||||||
|
mGet >>= transformSimplifyColumns .> mSet
|
||||||
|
mGet >>= briDocToDoc .> traceIfDumpConf "bridoc post-columns"
|
||||||
|
_dconf_dump_bridoc_simpl_columns
|
||||||
|
-- bridoc transformation: indent
|
||||||
|
mGet >>= transformSimplifyIndent .> mSet
|
||||||
|
mGet >>= briDocToDoc .> traceIfDumpConf "bridoc post-indent"
|
||||||
|
_dconf_dump_bridoc_simpl_indent
|
||||||
|
mGet >>= briDocToDoc .> traceIfDumpConf "bridoc final"
|
||||||
|
_dconf_dump_bridoc_final
|
||||||
|
-- -- convert to Simple type
|
||||||
|
-- simpl <- mGet <&> transformToSimple
|
||||||
|
-- return simpl
|
||||||
|
|
||||||
|
anns :: ExactPrint.Types.Anns <- mAsk
|
||||||
|
let filteredAnns = filterAnns ast anns
|
||||||
|
|
||||||
|
traceIfDumpConf "bridoc annotations filtered/transformed"
|
||||||
|
_dconf_dump_annotations
|
||||||
|
$ annsDoc filteredAnns
|
||||||
|
|
||||||
|
let state = LayoutState
|
||||||
|
{ _lstate_baseYs = [0]
|
||||||
|
, _lstate_curYOrAddNewline = Right 0 -- important that we use left here
|
||||||
|
-- because moveToAnn stuff of the
|
||||||
|
-- first node needs to do its
|
||||||
|
-- thing properly.
|
||||||
|
, _lstate_indLevels = [0]
|
||||||
|
, _lstate_indLevelLinger = 0
|
||||||
|
, _lstate_comments = filteredAnns
|
||||||
|
, _lstate_commentCol = Nothing
|
||||||
|
, _lstate_addSepSpace = Nothing
|
||||||
|
, _lstate_inhibitMTEL = False
|
||||||
|
}
|
||||||
|
|
||||||
|
state' <- MultiRWSS.withMultiStateS state $ layoutBriDocM briDoc'
|
||||||
|
|
||||||
|
let remainingComments =
|
||||||
|
extractAllComments =<< Map.elems (_lstate_comments state')
|
||||||
|
remainingComments
|
||||||
|
`forM_` (fst .> show .> LayoutErrorUnusedComment .> (:[]) .> mTell)
|
||||||
|
|
||||||
|
return $ ()
|
|
@ -5,7 +5,7 @@
|
||||||
{-# LANGUAGE TypeApplications #-}
|
{-# LANGUAGE TypeApplications #-}
|
||||||
{-# LANGUAGE ConstraintKinds #-}
|
{-# LANGUAGE ConstraintKinds #-}
|
||||||
|
|
||||||
module Language.Haskell.Brittany.Backend
|
module Language.Haskell.Brittany.Internal.Backend
|
||||||
( layoutBriDocM
|
( layoutBriDocM
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
@ -19,11 +19,11 @@ import qualified Language.Haskell.GHC.ExactPrint.Annotate as ExactPrint.Annotate
|
||||||
import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
|
import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
|
||||||
import Language.Haskell.GHC.ExactPrint.Types ( AnnKey, Annotation )
|
import Language.Haskell.GHC.ExactPrint.Types ( AnnKey, Annotation )
|
||||||
|
|
||||||
import Language.Haskell.Brittany.LayouterBasics
|
import Language.Haskell.Brittany.Internal.LayouterBasics
|
||||||
import Language.Haskell.Brittany.BackendUtils
|
import Language.Haskell.Brittany.Internal.BackendUtils
|
||||||
import Language.Haskell.Brittany.Utils
|
import Language.Haskell.Brittany.Internal.Utils
|
||||||
import Language.Haskell.Brittany.Config.Types
|
import Language.Haskell.Brittany.Internal.Config.Types
|
||||||
import Language.Haskell.Brittany.Types
|
import Language.Haskell.Brittany.Internal.Types
|
||||||
|
|
||||||
|
|
||||||
import qualified Data.Text.Lazy.Builder as Text.Builder
|
import qualified Data.Text.Lazy.Builder as Text.Builder
|
|
@ -7,7 +7,7 @@
|
||||||
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
|
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
module Language.Haskell.Brittany.BackendUtils
|
module Language.Haskell.Brittany.Internal.BackendUtils
|
||||||
( layoutWriteAppend
|
( layoutWriteAppend
|
||||||
, layoutWriteAppendMultiline
|
, layoutWriteAppendMultiline
|
||||||
, layoutWriteNewlineBlock
|
, layoutWriteNewlineBlock
|
||||||
|
@ -38,8 +38,8 @@ where
|
||||||
|
|
||||||
#include "prelude.inc"
|
#include "prelude.inc"
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Types
|
import Language.Haskell.Brittany.Internal.Types
|
||||||
import Language.Haskell.Brittany.Config.Types
|
import Language.Haskell.Brittany.Internal.Config.Types
|
||||||
import Language.Haskell.GHC.ExactPrint.Types ( AnnKey
|
import Language.Haskell.GHC.ExactPrint.Types ( AnnKey
|
||||||
, Annotation
|
, Annotation
|
||||||
, KeywordId
|
, KeywordId
|
||||||
|
@ -47,7 +47,7 @@ import Language.Haskell.GHC.ExactPrint.Types ( AnnKey
|
||||||
|
|
||||||
import qualified Data.Text.Lazy.Builder as Text.Builder
|
import qualified Data.Text.Lazy.Builder as Text.Builder
|
||||||
import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint
|
import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint
|
||||||
import Language.Haskell.Brittany.Utils
|
import Language.Haskell.Brittany.Internal.Utils
|
||||||
|
|
||||||
import GHC ( Located, GenLocated(L), moduleNameString )
|
import GHC ( Located, GenLocated(L), moduleNameString )
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
module Language.Haskell.Brittany.Config
|
module Language.Haskell.Brittany.Internal.Config
|
||||||
( CConfig(..)
|
( CConfig(..)
|
||||||
, CDebugConfig(..)
|
, CDebugConfig(..)
|
||||||
, CLayoutConfig(..)
|
, CLayoutConfig(..)
|
||||||
|
@ -16,8 +16,8 @@ where
|
||||||
|
|
||||||
#include "prelude.inc"
|
#include "prelude.inc"
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Types
|
import Language.Haskell.Brittany.Internal.Types
|
||||||
import Language.Haskell.Brittany.LayouterBasics
|
import Language.Haskell.Brittany.Internal.LayouterBasics
|
||||||
|
|
||||||
import qualified Data.Yaml
|
import qualified Data.Yaml
|
||||||
|
|
||||||
|
@ -25,8 +25,8 @@ import UI.Butcher.Monadic
|
||||||
|
|
||||||
import qualified System.Console.CmdArgs.Explicit as CmdArgs
|
import qualified System.Console.CmdArgs.Explicit as CmdArgs
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Config.Types
|
import Language.Haskell.Brittany.Internal.Config.Types
|
||||||
import Language.Haskell.Brittany.Utils
|
import Language.Haskell.Brittany.Internal.Utils
|
||||||
|
|
||||||
import Data.Coerce ( Coercible, coerce )
|
import Data.Coerce ( Coercible, coerce )
|
||||||
|
|
|
@ -4,7 +4,7 @@
|
||||||
{-# LANGUAGE RankNTypes #-}
|
{-# LANGUAGE RankNTypes #-}
|
||||||
{-# LANGUAGE DeriveDataTypeable #-}
|
{-# LANGUAGE DeriveDataTypeable #-}
|
||||||
|
|
||||||
module Language.Haskell.Brittany.Config.Types
|
module Language.Haskell.Brittany.Internal.Config.Types
|
||||||
where
|
where
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
|
||||||
module Language.Haskell.Brittany.ExactPrintUtils
|
module Language.Haskell.Brittany.Internal.ExactPrintUtils
|
||||||
( parseModule
|
( parseModule
|
||||||
, parseModuleFromString
|
, parseModuleFromString
|
||||||
, commentAnnFixTransform
|
, commentAnnFixTransform
|
||||||
|
@ -12,10 +12,10 @@ where
|
||||||
|
|
||||||
#include "prelude.inc"
|
#include "prelude.inc"
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Types
|
import Language.Haskell.Brittany.Internal.Types
|
||||||
import Language.Haskell.Brittany.Config.Types
|
import Language.Haskell.Brittany.Internal.Config.Types
|
||||||
import Language.Haskell.Brittany.LayouterBasics
|
import Language.Haskell.Brittany.Internal.LayouterBasics
|
||||||
import Language.Haskell.Brittany.Utils
|
import Language.Haskell.Brittany.Internal.Utils
|
||||||
|
|
||||||
import DynFlags ( getDynFlags )
|
import DynFlags ( getDynFlags )
|
||||||
import GHC ( runGhc, GenLocated(L), moduleNameString )
|
import GHC ( runGhc, GenLocated(L), moduleNameString )
|
|
@ -1,4 +1,4 @@
|
||||||
module Language.Haskell.Brittany.LayouterBasics
|
module Language.Haskell.Brittany.Internal.LayouterBasics
|
||||||
( processDefault
|
( processDefault
|
||||||
, rdrNameToText
|
, rdrNameToText
|
||||||
, lrdrNameToText
|
, lrdrNameToText
|
||||||
|
@ -64,9 +64,9 @@ import Language.Haskell.GHC.ExactPrint.Types ( AnnKey, Annotation, KeywordId )
|
||||||
|
|
||||||
import qualified Data.Text.Lazy.Builder as Text.Builder
|
import qualified Data.Text.Lazy.Builder as Text.Builder
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Config.Types
|
import Language.Haskell.Brittany.Internal.Config.Types
|
||||||
import Language.Haskell.Brittany.Types
|
import Language.Haskell.Brittany.Internal.Types
|
||||||
import Language.Haskell.Brittany.Utils
|
import Language.Haskell.Brittany.Internal.Utils
|
||||||
|
|
||||||
import RdrName ( RdrName(..) )
|
import RdrName ( RdrName(..) )
|
||||||
import GHC ( Located, runGhc, GenLocated(L), moduleNameString )
|
import GHC ( Located, runGhc, GenLocated(L), moduleNameString )
|
|
@ -1,7 +1,7 @@
|
||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
{-# LANGUAGE TypeApplications #-}
|
{-# LANGUAGE TypeApplications #-}
|
||||||
|
|
||||||
module Language.Haskell.Brittany.Layouters.Decl
|
module Language.Haskell.Brittany.Internal.Layouters.Decl
|
||||||
( layoutSig
|
( layoutSig
|
||||||
, layoutBind
|
, layoutBind
|
||||||
, layoutLocalBinds
|
, layoutLocalBinds
|
||||||
|
@ -16,9 +16,9 @@ where
|
||||||
|
|
||||||
#include "prelude.inc"
|
#include "prelude.inc"
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Types
|
import Language.Haskell.Brittany.Internal.Types
|
||||||
import Language.Haskell.Brittany.LayouterBasics
|
import Language.Haskell.Brittany.Internal.LayouterBasics
|
||||||
import Language.Haskell.Brittany.Config.Types
|
import Language.Haskell.Brittany.Internal.Config.Types
|
||||||
|
|
||||||
import RdrName ( RdrName(..) )
|
import RdrName ( RdrName(..) )
|
||||||
import GHC ( runGhc, GenLocated(L), moduleNameString )
|
import GHC ( runGhc, GenLocated(L), moduleNameString )
|
||||||
|
@ -32,10 +32,10 @@ import BasicTypes ( InlinePragma(..)
|
||||||
)
|
)
|
||||||
import Language.Haskell.GHC.ExactPrint.Types ( mkAnnKey )
|
import Language.Haskell.GHC.ExactPrint.Types ( mkAnnKey )
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Layouters.Type
|
import Language.Haskell.Brittany.Internal.Layouters.Type
|
||||||
import {-# SOURCE #-} Language.Haskell.Brittany.Layouters.Expr
|
import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Expr
|
||||||
import {-# SOURCE #-} Language.Haskell.Brittany.Layouters.Stmt
|
import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Stmt
|
||||||
import Language.Haskell.Brittany.Layouters.Pattern
|
import Language.Haskell.Brittany.Internal.Layouters.Pattern
|
||||||
|
|
||||||
import Bag ( mapBagM )
|
import Bag ( mapBagM )
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
|
||||||
module Language.Haskell.Brittany.Layouters.Expr
|
module Language.Haskell.Brittany.Internal.Layouters.Expr
|
||||||
( layoutExpr
|
( layoutExpr
|
||||||
, litBriDoc
|
, litBriDoc
|
||||||
, overLitValBriDoc
|
, overLitValBriDoc
|
||||||
|
@ -11,8 +11,8 @@ where
|
||||||
|
|
||||||
#include "prelude.inc"
|
#include "prelude.inc"
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Types
|
import Language.Haskell.Brittany.Internal.Types
|
||||||
import Language.Haskell.Brittany.LayouterBasics
|
import Language.Haskell.Brittany.Internal.LayouterBasics
|
||||||
|
|
||||||
import RdrName ( RdrName(..) )
|
import RdrName ( RdrName(..) )
|
||||||
import GHC ( runGhc, GenLocated(L), moduleNameString, AnnKeywordId(..) )
|
import GHC ( runGhc, GenLocated(L), moduleNameString, AnnKeywordId(..) )
|
||||||
|
@ -21,11 +21,11 @@ import Name
|
||||||
import qualified FastString
|
import qualified FastString
|
||||||
import BasicTypes
|
import BasicTypes
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Utils
|
import Language.Haskell.Brittany.Internal.Utils
|
||||||
import Language.Haskell.Brittany.Layouters.Pattern
|
import Language.Haskell.Brittany.Internal.Layouters.Pattern
|
||||||
import Language.Haskell.Brittany.Layouters.Decl
|
import Language.Haskell.Brittany.Internal.Layouters.Decl
|
||||||
import Language.Haskell.Brittany.Layouters.Stmt
|
import Language.Haskell.Brittany.Internal.Layouters.Stmt
|
||||||
import Language.Haskell.Brittany.Layouters.Type
|
import Language.Haskell.Brittany.Internal.Layouters.Type
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
|
||||||
module Language.Haskell.Brittany.Layouters.Expr
|
module Language.Haskell.Brittany.Internal.Layouters.Expr
|
||||||
( layoutExpr
|
( layoutExpr
|
||||||
, litBriDoc
|
, litBriDoc
|
||||||
, overLitValBriDoc
|
, overLitValBriDoc
|
||||||
|
@ -11,8 +11,8 @@ where
|
||||||
|
|
||||||
#include "prelude.inc"
|
#include "prelude.inc"
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Types
|
import Language.Haskell.Brittany.Internal.Types
|
||||||
import Language.Haskell.Brittany.LayouterBasics
|
import Language.Haskell.Brittany.Internal.LayouterBasics
|
||||||
|
|
||||||
import RdrName ( RdrName(..) )
|
import RdrName ( RdrName(..) )
|
||||||
import GHC ( runGhc, GenLocated(L), moduleNameString )
|
import GHC ( runGhc, GenLocated(L), moduleNameString )
|
|
@ -1,6 +1,6 @@
|
||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
|
||||||
module Language.Haskell.Brittany.Layouters.Pattern
|
module Language.Haskell.Brittany.Internal.Layouters.Pattern
|
||||||
( layoutPat
|
( layoutPat
|
||||||
, colsWrapPat
|
, colsWrapPat
|
||||||
)
|
)
|
||||||
|
@ -10,8 +10,8 @@ where
|
||||||
|
|
||||||
#include "prelude.inc"
|
#include "prelude.inc"
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Types
|
import Language.Haskell.Brittany.Internal.Types
|
||||||
import Language.Haskell.Brittany.LayouterBasics
|
import Language.Haskell.Brittany.Internal.LayouterBasics
|
||||||
|
|
||||||
import RdrName ( RdrName(..) )
|
import RdrName ( RdrName(..) )
|
||||||
import GHC ( Located, runGhc, GenLocated(L), moduleNameString )
|
import GHC ( Located, runGhc, GenLocated(L), moduleNameString )
|
||||||
|
@ -19,8 +19,8 @@ import HsSyn
|
||||||
import Name
|
import Name
|
||||||
import BasicTypes
|
import BasicTypes
|
||||||
|
|
||||||
import {-# SOURCE #-} Language.Haskell.Brittany.Layouters.Expr
|
import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Expr
|
||||||
import Language.Haskell.Brittany.Layouters.Type
|
import Language.Haskell.Brittany.Internal.Layouters.Type
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
|
||||||
module Language.Haskell.Brittany.Layouters.Stmt
|
module Language.Haskell.Brittany.Internal.Layouters.Stmt
|
||||||
( layoutStmt
|
( layoutStmt
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
@ -9,8 +9,8 @@ where
|
||||||
|
|
||||||
#include "prelude.inc"
|
#include "prelude.inc"
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Types
|
import Language.Haskell.Brittany.Internal.Types
|
||||||
import Language.Haskell.Brittany.LayouterBasics
|
import Language.Haskell.Brittany.Internal.LayouterBasics
|
||||||
|
|
||||||
import RdrName ( RdrName(..) )
|
import RdrName ( RdrName(..) )
|
||||||
import GHC ( runGhc, GenLocated(L), moduleNameString )
|
import GHC ( runGhc, GenLocated(L), moduleNameString )
|
||||||
|
@ -19,9 +19,9 @@ import Name
|
||||||
import qualified FastString
|
import qualified FastString
|
||||||
import BasicTypes
|
import BasicTypes
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Layouters.Pattern
|
import Language.Haskell.Brittany.Internal.Layouters.Pattern
|
||||||
import Language.Haskell.Brittany.Layouters.Decl
|
import Language.Haskell.Brittany.Internal.Layouters.Decl
|
||||||
import {-# SOURCE #-} Language.Haskell.Brittany.Layouters.Expr
|
import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Expr
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
|
||||||
module Language.Haskell.Brittany.Layouters.Stmt
|
module Language.Haskell.Brittany.Internal.Layouters.Stmt
|
||||||
( layoutStmt
|
( layoutStmt
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
@ -9,8 +9,8 @@ where
|
||||||
|
|
||||||
#include "prelude.inc"
|
#include "prelude.inc"
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Types
|
import Language.Haskell.Brittany.Internal.Types
|
||||||
import Language.Haskell.Brittany.LayouterBasics
|
import Language.Haskell.Brittany.Internal.LayouterBasics
|
||||||
|
|
||||||
import RdrName ( RdrName(..) )
|
import RdrName ( RdrName(..) )
|
||||||
import GHC ( runGhc, GenLocated(L), moduleNameString )
|
import GHC ( runGhc, GenLocated(L), moduleNameString )
|
|
@ -1,6 +1,6 @@
|
||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
|
||||||
module Language.Haskell.Brittany.Layouters.Type
|
module Language.Haskell.Brittany.Internal.Layouters.Type
|
||||||
( layoutType
|
( layoutType
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
@ -9,9 +9,9 @@ where
|
||||||
|
|
||||||
#include "prelude.inc"
|
#include "prelude.inc"
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Config.Types
|
import Language.Haskell.Brittany.Internal.Config.Types
|
||||||
import Language.Haskell.Brittany.Types
|
import Language.Haskell.Brittany.Internal.Types
|
||||||
import Language.Haskell.Brittany.LayouterBasics
|
import Language.Haskell.Brittany.Internal.LayouterBasics
|
||||||
|
|
||||||
import RdrName ( RdrName(..) )
|
import RdrName ( RdrName(..) )
|
||||||
import GHC ( runGhc, GenLocated(L), moduleNameString )
|
import GHC ( runGhc, GenLocated(L), moduleNameString )
|
|
@ -1,4 +1,4 @@
|
||||||
module Language.Haskell.Brittany.Prelude
|
module Language.Haskell.Brittany.Internal.Prelude
|
||||||
where
|
where
|
||||||
|
|
||||||
|
|
|
@ -5,7 +5,7 @@
|
||||||
{-# LANGUAGE BangPatterns #-}
|
{-# LANGUAGE BangPatterns #-}
|
||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
|
||||||
module Language.Haskell.Brittany.Transformations.Alt
|
module Language.Haskell.Brittany.Internal.Transformations.Alt
|
||||||
( transformAlts
|
( transformAlts
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
@ -16,9 +16,9 @@ where
|
||||||
|
|
||||||
import Data.HList.ContainsType
|
import Data.HList.ContainsType
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Utils
|
import Language.Haskell.Brittany.Internal.Utils
|
||||||
import Language.Haskell.Brittany.Config.Types
|
import Language.Haskell.Brittany.Internal.Config.Types
|
||||||
import Language.Haskell.Brittany.Types
|
import Language.Haskell.Brittany.Internal.Types
|
||||||
|
|
||||||
import qualified Control.Monad.Memo as Memo
|
import qualified Control.Monad.Memo as Memo
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
module Language.Haskell.Brittany.Transformations.Columns
|
module Language.Haskell.Brittany.Internal.Transformations.Columns
|
||||||
( transformSimplifyColumns
|
( transformSimplifyColumns
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
@ -7,9 +7,9 @@ where
|
||||||
|
|
||||||
#include "prelude.inc"
|
#include "prelude.inc"
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Utils
|
import Language.Haskell.Brittany.Internal.Utils
|
||||||
import Language.Haskell.Brittany.Config.Types
|
import Language.Haskell.Brittany.Internal.Config.Types
|
||||||
import Language.Haskell.Brittany.Types
|
import Language.Haskell.Brittany.Internal.Types
|
||||||
|
|
||||||
import qualified Data.Generics.Uniplate.Direct as Uniplate
|
import qualified Data.Generics.Uniplate.Direct as Uniplate
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
module Language.Haskell.Brittany.Transformations.Floating
|
module Language.Haskell.Brittany.Internal.Transformations.Floating
|
||||||
( transformSimplifyFloating
|
( transformSimplifyFloating
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
@ -7,9 +7,9 @@ where
|
||||||
|
|
||||||
#include "prelude.inc"
|
#include "prelude.inc"
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Utils
|
import Language.Haskell.Brittany.Internal.Utils
|
||||||
import Language.Haskell.Brittany.Config.Types
|
import Language.Haskell.Brittany.Internal.Config.Types
|
||||||
import Language.Haskell.Brittany.Types
|
import Language.Haskell.Brittany.Internal.Types
|
||||||
|
|
||||||
import qualified Data.Generics.Uniplate.Direct as Uniplate
|
import qualified Data.Generics.Uniplate.Direct as Uniplate
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
module Language.Haskell.Brittany.Transformations.Indent
|
module Language.Haskell.Brittany.Internal.Transformations.Indent
|
||||||
( transformSimplifyIndent
|
( transformSimplifyIndent
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
@ -7,9 +7,9 @@ where
|
||||||
|
|
||||||
#include "prelude.inc"
|
#include "prelude.inc"
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Utils
|
import Language.Haskell.Brittany.Internal.Utils
|
||||||
import Language.Haskell.Brittany.Config.Types
|
import Language.Haskell.Brittany.Internal.Config.Types
|
||||||
import Language.Haskell.Brittany.Types
|
import Language.Haskell.Brittany.Internal.Types
|
||||||
|
|
||||||
import qualified Data.Generics.Uniplate.Direct as Uniplate
|
import qualified Data.Generics.Uniplate.Direct as Uniplate
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
module Language.Haskell.Brittany.Transformations.Par
|
module Language.Haskell.Brittany.Internal.Transformations.Par
|
||||||
( transformSimplifyPar
|
( transformSimplifyPar
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
@ -7,9 +7,9 @@ where
|
||||||
|
|
||||||
#include "prelude.inc"
|
#include "prelude.inc"
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Utils
|
import Language.Haskell.Brittany.Internal.Utils
|
||||||
import Language.Haskell.Brittany.Config.Types
|
import Language.Haskell.Brittany.Internal.Config.Types
|
||||||
import Language.Haskell.Brittany.Types
|
import Language.Haskell.Brittany.Internal.Types
|
||||||
|
|
||||||
import qualified Data.Generics.Uniplate.Direct as Uniplate
|
import qualified Data.Generics.Uniplate.Direct as Uniplate
|
||||||
|
|
|
@ -5,7 +5,7 @@
|
||||||
{-# LANGUAGE PatternSynonyms #-}
|
{-# LANGUAGE PatternSynonyms #-}
|
||||||
{-# LANGUAGE BangPatterns #-}
|
{-# LANGUAGE BangPatterns #-}
|
||||||
|
|
||||||
module Language.Haskell.Brittany.Types
|
module Language.Haskell.Brittany.Internal.Types
|
||||||
where
|
where
|
||||||
|
|
||||||
|
|
||||||
|
@ -22,7 +22,7 @@ import GHC ( Located, runGhc, GenLocated(L), moduleNameString, AnnKeyw
|
||||||
import Language.Haskell.GHC.ExactPrint ( AnnKey, Comment )
|
import Language.Haskell.GHC.ExactPrint ( AnnKey, Comment )
|
||||||
import Language.Haskell.GHC.ExactPrint.Types ( KeywordId, Anns, DeltaPos, mkAnnKey )
|
import Language.Haskell.GHC.ExactPrint.Types ( KeywordId, Anns, DeltaPos, mkAnnKey )
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Config.Types
|
import Language.Haskell.Brittany.Internal.Config.Types
|
||||||
|
|
||||||
import Data.Generics.Uniplate.Direct as Uniplate
|
import Data.Generics.Uniplate.Direct as Uniplate
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
{-# LANGUAGE DeriveDataTypeable #-}
|
{-# LANGUAGE DeriveDataTypeable #-}
|
||||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
|
|
||||||
module Language.Haskell.Brittany.Utils
|
module Language.Haskell.Brittany.Internal.Utils
|
||||||
( parDoc
|
( parDoc
|
||||||
, fromMaybeIdentity
|
, fromMaybeIdentity
|
||||||
, fromOptionIdentity
|
, fromOptionIdentity
|
||||||
|
@ -50,8 +50,8 @@ import qualified Data.ByteString as B
|
||||||
|
|
||||||
import DataTreePrint
|
import DataTreePrint
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Config.Types
|
import Language.Haskell.Brittany.Internal.Config.Types
|
||||||
import Language.Haskell.Brittany.Types
|
import Language.Haskell.Brittany.Internal.Types
|
||||||
|
|
||||||
import qualified Data.Generics.Uniplate.Direct as Uniplate
|
import qualified Data.Generics.Uniplate.Direct as Uniplate
|
||||||
|
|
|
@ -786,7 +786,7 @@ import Control.Monad.Trans.Class ( lift
|
||||||
import Control.Monad.Trans.Maybe ( MaybeT (..)
|
import Control.Monad.Trans.Maybe ( MaybeT (..)
|
||||||
)
|
)
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Prelude
|
import Language.Haskell.Brittany.Internal.Prelude
|
||||||
|
|
||||||
import Data.Data ( toConstr
|
import Data.Data ( toConstr
|
||||||
)
|
)
|
||||||
|
|
Loading…
Reference in New Issue