From f350113f7f7c9f7213d7d086989048b2ed9a9df3 Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Mon, 22 May 2017 21:25:08 +0200 Subject: [PATCH] Refactor all modules: +Internal; Add public Brittany module --- brittany.cabal | 39 +- src-brittany/Main.hs | 10 +- src-idemtests/cases/LayoutBasics.hs | 8 +- src-literatetests/Main.hs | 4 +- src-unittests/AsymptoticPerfTests.hs | 2 +- src-unittests/TestMain.hs | 2 +- src-unittests/TestUtils.hs | 4 +- src/Language/Haskell/Brittany.hs | 394 +---------------- src/Language/Haskell/Brittany/Internal.hs | 401 ++++++++++++++++++ .../Brittany/{ => Internal}/Backend.hs | 12 +- .../Brittany/{ => Internal}/BackendUtils.hs | 8 +- .../Haskell/Brittany/{ => Internal}/Config.hs | 10 +- .../Brittany/{ => Internal}/Config/Types.hs | 2 +- .../{ => Internal}/ExactPrintUtils.hs | 10 +- .../Brittany/{ => Internal}/LayouterBasics.hs | 8 +- .../Brittany/{ => Internal}/Layouters/Decl.hs | 16 +- .../Brittany/{ => Internal}/Layouters/Expr.hs | 16 +- .../{ => Internal}/Layouters/Expr.hs-boot | 6 +- .../{ => Internal}/Layouters/Pattern.hs | 10 +- .../Brittany/{ => Internal}/Layouters/Stmt.hs | 12 +- .../{ => Internal}/Layouters/Stmt.hs-boot | 6 +- .../Brittany/{ => Internal}/Layouters/Type.hs | 8 +- .../Brittany/{ => Internal}/Prelude.hs | 2 +- .../{ => Internal}/Transformations/Alt.hs | 8 +- .../{ => Internal}/Transformations/Columns.hs | 8 +- .../Transformations/Floating.hs | 8 +- .../{ => Internal}/Transformations/Indent.hs | 8 +- .../{ => Internal}/Transformations/Par.hs | 8 +- .../Haskell/Brittany/{ => Internal}/Types.hs | 4 +- .../Haskell/Brittany/{ => Internal}/Utils.hs | 6 +- srcinc/prelude.inc | 2 +- 31 files changed, 530 insertions(+), 512 deletions(-) create mode 100644 src/Language/Haskell/Brittany/Internal.hs rename src/Language/Haskell/Brittany/{ => Internal}/Backend.hs (98%) rename src/Language/Haskell/Brittany/{ => Internal}/BackendUtils.hs (98%) rename src/Language/Haskell/Brittany/{ => Internal}/Config.hs (96%) rename src/Language/Haskell/Brittany/{ => Internal}/Config/Types.hs (99%) rename src/Language/Haskell/Brittany/{ => Internal}/ExactPrintUtils.hs (96%) rename src/Language/Haskell/Brittany/{ => Internal}/LayouterBasics.hs (99%) rename src/Language/Haskell/Brittany/{ => Internal}/Layouters/Decl.hs (96%) rename src/Language/Haskell/Brittany/{ => Internal}/Layouters/Expr.hs (98%) rename src/Language/Haskell/Brittany/{ => Internal}/Layouters/Expr.hs-boot (71%) rename src/Language/Haskell/Brittany/{ => Internal}/Layouters/Pattern.hs (94%) rename src/Language/Haskell/Brittany/{ => Internal}/Layouters/Stmt.hs (84%) rename src/Language/Haskell/Brittany/{ => Internal}/Layouters/Stmt.hs-boot (66%) rename src/Language/Haskell/Brittany/{ => Internal}/Layouters/Type.hs (98%) rename src/Language/Haskell/Brittany/{ => Internal}/Prelude.hs (96%) rename src/Language/Haskell/Brittany/{ => Internal}/Transformations/Alt.hs (99%) rename src/Language/Haskell/Brittany/{ => Internal}/Transformations/Columns.hs (95%) rename src/Language/Haskell/Brittany/{ => Internal}/Transformations/Floating.hs (97%) rename src/Language/Haskell/Brittany/{ => Internal}/Transformations/Indent.hs (87%) rename src/Language/Haskell/Brittany/{ => Internal}/Transformations/Par.hs (85%) rename src/Language/Haskell/Brittany/{ => Internal}/Types.hs (99%) rename src/Language/Haskell/Brittany/{ => Internal}/Utils.hs (98%) diff --git a/brittany.cabal b/brittany.cabal index d97e2d2..82b4564 100644 --- a/brittany.cabal +++ b/brittany.cabal @@ -45,27 +45,28 @@ library { } exposed-modules: { Language.Haskell.Brittany - Language.Haskell.Brittany.Prelude - Language.Haskell.Brittany.Types - Language.Haskell.Brittany.Utils - Language.Haskell.Brittany.Config - Language.Haskell.Brittany.Config.Types + Language.Haskell.Brittany.Internal + Language.Haskell.Brittany.Internal.Prelude + Language.Haskell.Brittany.Internal.Types + Language.Haskell.Brittany.Internal.Utils + Language.Haskell.Brittany.Internal.Config + Language.Haskell.Brittany.Internal.Config.Types } other-modules: { - Language.Haskell.Brittany.LayouterBasics - Language.Haskell.Brittany.Backend - Language.Haskell.Brittany.BackendUtils - Language.Haskell.Brittany.ExactPrintUtils - Language.Haskell.Brittany.Layouters.Type - Language.Haskell.Brittany.Layouters.Decl - Language.Haskell.Brittany.Layouters.Expr - Language.Haskell.Brittany.Layouters.Stmt - Language.Haskell.Brittany.Layouters.Pattern - Language.Haskell.Brittany.Transformations.Alt - Language.Haskell.Brittany.Transformations.Floating - Language.Haskell.Brittany.Transformations.Par - Language.Haskell.Brittany.Transformations.Columns - Language.Haskell.Brittany.Transformations.Indent + Language.Haskell.Brittany.Internal.LayouterBasics + Language.Haskell.Brittany.Internal.Backend + Language.Haskell.Brittany.Internal.BackendUtils + Language.Haskell.Brittany.Internal.ExactPrintUtils + Language.Haskell.Brittany.Internal.Layouters.Type + Language.Haskell.Brittany.Internal.Layouters.Decl + Language.Haskell.Brittany.Internal.Layouters.Expr + Language.Haskell.Brittany.Internal.Layouters.Stmt + Language.Haskell.Brittany.Internal.Layouters.Pattern + Language.Haskell.Brittany.Internal.Transformations.Alt + Language.Haskell.Brittany.Internal.Transformations.Floating + Language.Haskell.Brittany.Internal.Transformations.Par + Language.Haskell.Brittany.Internal.Transformations.Columns + Language.Haskell.Brittany.Internal.Transformations.Indent Paths_brittany } ghc-options: { diff --git a/src-brittany/Main.hs b/src-brittany/Main.hs index 3991079..b1035f8 100644 --- a/src-brittany/Main.hs +++ b/src-brittany/Main.hs @@ -18,11 +18,11 @@ import Data.CZipWith import qualified Debug.Trace as Trace -import Language.Haskell.Brittany.Types -import Language.Haskell.Brittany -import Language.Haskell.Brittany.Config -import Language.Haskell.Brittany.Config.Types -import Language.Haskell.Brittany.Utils +import Language.Haskell.Brittany.Internal.Types +import Language.Haskell.Brittany.Internal +import Language.Haskell.Brittany.Internal.Config +import Language.Haskell.Brittany.Internal.Config.Types +import Language.Haskell.Brittany.Internal.Utils import qualified Text.PrettyPrint as PP diff --git a/src-idemtests/cases/LayoutBasics.hs b/src-idemtests/cases/LayoutBasics.hs index 4f853cc..3664d3e 100644 --- a/src-idemtests/cases/LayoutBasics.hs +++ b/src-idemtests/cases/LayoutBasics.hs @@ -12,7 +12,7 @@ {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE KindSignatures #-} -module Language.Haskell.Brittany.LayoutBasics +module Language.Haskell.Brittany.Internal.LayoutBasics ( processDefault , layoutByExact -- , layoutByExactR @@ -84,9 +84,9 @@ import Language.Haskell.GHC.ExactPrint.Types ( AnnKey, Annotation ) import qualified Data.Text.Lazy.Builder as Text.Builder -import Language.Haskell.Brittany.Config.Types -import Language.Haskell.Brittany.Types -import Language.Haskell.Brittany.Utils +import Language.Haskell.Brittany.Internal.Config.Types +import Language.Haskell.Brittany.Internal.Types +import Language.Haskell.Brittany.Internal.Utils import RdrName ( RdrName(..) ) import GHC ( runGhc, GenLocated(L), moduleNameString ) diff --git a/src-literatetests/Main.hs b/src-literatetests/Main.hs index c95602f..9196dba 100644 --- a/src-literatetests/Main.hs +++ b/src-literatetests/Main.hs @@ -16,9 +16,9 @@ import Text.Parsec.Text ( Parser ) import Data.Char ( isSpace ) 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 ) diff --git a/src-unittests/AsymptoticPerfTests.hs b/src-unittests/AsymptoticPerfTests.hs index 98bc45f..09b4f2b 100644 --- a/src-unittests/AsymptoticPerfTests.hs +++ b/src-unittests/AsymptoticPerfTests.hs @@ -13,7 +13,7 @@ import Test.Hspec import NeatInterpolation -import Language.Haskell.Brittany +import Language.Haskell.Brittany.Internal import TestUtils diff --git a/src-unittests/TestMain.hs b/src-unittests/TestMain.hs index afb7a94..33a04eb 100644 --- a/src-unittests/TestMain.hs +++ b/src-unittests/TestMain.hs @@ -10,7 +10,7 @@ import Test.Hspec import NeatInterpolation -import Language.Haskell.Brittany +import Language.Haskell.Brittany.Internal import AsymptoticPerfTests diff --git a/src-unittests/TestUtils.hs b/src-unittests/TestUtils.hs index 15bb396..9659e47 100644 --- a/src-unittests/TestUtils.hs +++ b/src-unittests/TestUtils.hs @@ -10,9 +10,9 @@ import Test.Hspec 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 ) diff --git a/src/Language/Haskell/Brittany.hs b/src/Language/Haskell/Brittany.hs index 6a74465..ac0b90d 100644 --- a/src/Language/Haskell/Brittany.hs +++ b/src/Language/Haskell/Brittany.hs @@ -2,12 +2,8 @@ module Language.Haskell.Brittany ( pureModuleTransform - , parsePrintModule - , pPrintModule - , pPrintModuleAndCheck - -- re-export from utils: - , parseModule - , parseModuleFromString + , CConfig + , LayoutError(..) ) where @@ -15,387 +11,7 @@ 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 Language.Haskell.Brittany.Internal +import Language.Haskell.Brittany.Internal.Types +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 $ () diff --git a/src/Language/Haskell/Brittany/Internal.hs b/src/Language/Haskell/Brittany/Internal.hs new file mode 100644 index 0000000..5bbfc54 --- /dev/null +++ b/src/Language/Haskell/Brittany/Internal.hs @@ -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 $ () diff --git a/src/Language/Haskell/Brittany/Backend.hs b/src/Language/Haskell/Brittany/Internal/Backend.hs similarity index 98% rename from src/Language/Haskell/Brittany/Backend.hs rename to src/Language/Haskell/Brittany/Internal/Backend.hs index e7de59c..2ea4e64 100644 --- a/src/Language/Haskell/Brittany/Backend.hs +++ b/src/Language/Haskell/Brittany/Internal/Backend.hs @@ -5,7 +5,7 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ConstraintKinds #-} -module Language.Haskell.Brittany.Backend +module Language.Haskell.Brittany.Internal.Backend ( layoutBriDocM ) 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 Language.Haskell.GHC.ExactPrint.Types ( AnnKey, Annotation ) -import Language.Haskell.Brittany.LayouterBasics -import Language.Haskell.Brittany.BackendUtils -import Language.Haskell.Brittany.Utils -import Language.Haskell.Brittany.Config.Types -import Language.Haskell.Brittany.Types +import Language.Haskell.Brittany.Internal.LayouterBasics +import Language.Haskell.Brittany.Internal.BackendUtils +import Language.Haskell.Brittany.Internal.Utils +import Language.Haskell.Brittany.Internal.Config.Types +import Language.Haskell.Brittany.Internal.Types import qualified Data.Text.Lazy.Builder as Text.Builder diff --git a/src/Language/Haskell/Brittany/BackendUtils.hs b/src/Language/Haskell/Brittany/Internal/BackendUtils.hs similarity index 98% rename from src/Language/Haskell/Brittany/BackendUtils.hs rename to src/Language/Haskell/Brittany/Internal/BackendUtils.hs index 3017e36..8ae48b4 100644 --- a/src/Language/Haskell/Brittany/BackendUtils.hs +++ b/src/Language/Haskell/Brittany/Internal/BackendUtils.hs @@ -7,7 +7,7 @@ {-# OPTIONS_GHC -Wno-redundant-constraints #-} #endif -module Language.Haskell.Brittany.BackendUtils +module Language.Haskell.Brittany.Internal.BackendUtils ( layoutWriteAppend , layoutWriteAppendMultiline , layoutWriteNewlineBlock @@ -38,8 +38,8 @@ where #include "prelude.inc" -import Language.Haskell.Brittany.Types -import Language.Haskell.Brittany.Config.Types +import Language.Haskell.Brittany.Internal.Types +import Language.Haskell.Brittany.Internal.Config.Types import Language.Haskell.GHC.ExactPrint.Types ( AnnKey , Annotation , KeywordId @@ -47,7 +47,7 @@ import Language.Haskell.GHC.ExactPrint.Types ( AnnKey import qualified Data.Text.Lazy.Builder as Text.Builder 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 ) diff --git a/src/Language/Haskell/Brittany/Config.hs b/src/Language/Haskell/Brittany/Internal/Config.hs similarity index 96% rename from src/Language/Haskell/Brittany/Config.hs rename to src/Language/Haskell/Brittany/Internal/Config.hs index 4f6d23f..53b10d4 100644 --- a/src/Language/Haskell/Brittany/Config.hs +++ b/src/Language/Haskell/Brittany/Internal/Config.hs @@ -1,4 +1,4 @@ -module Language.Haskell.Brittany.Config +module Language.Haskell.Brittany.Internal.Config ( CConfig(..) , CDebugConfig(..) , CLayoutConfig(..) @@ -16,8 +16,8 @@ where #include "prelude.inc" -import Language.Haskell.Brittany.Types -import Language.Haskell.Brittany.LayouterBasics +import Language.Haskell.Brittany.Internal.Types +import Language.Haskell.Brittany.Internal.LayouterBasics import qualified Data.Yaml @@ -25,8 +25,8 @@ import UI.Butcher.Monadic import qualified System.Console.CmdArgs.Explicit as CmdArgs -import Language.Haskell.Brittany.Config.Types -import Language.Haskell.Brittany.Utils +import Language.Haskell.Brittany.Internal.Config.Types +import Language.Haskell.Brittany.Internal.Utils import Data.Coerce ( Coercible, coerce ) diff --git a/src/Language/Haskell/Brittany/Config/Types.hs b/src/Language/Haskell/Brittany/Internal/Config/Types.hs similarity index 99% rename from src/Language/Haskell/Brittany/Config/Types.hs rename to src/Language/Haskell/Brittany/Internal/Config/Types.hs index 006203f..80a8018 100644 --- a/src/Language/Haskell/Brittany/Config/Types.hs +++ b/src/Language/Haskell/Brittany/Internal/Config/Types.hs @@ -4,7 +4,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE DeriveDataTypeable #-} -module Language.Haskell.Brittany.Config.Types +module Language.Haskell.Brittany.Internal.Config.Types where diff --git a/src/Language/Haskell/Brittany/ExactPrintUtils.hs b/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs similarity index 96% rename from src/Language/Haskell/Brittany/ExactPrintUtils.hs rename to src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs index 956d746..c3a7d72 100644 --- a/src/Language/Haskell/Brittany/ExactPrintUtils.hs +++ b/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs @@ -1,6 +1,6 @@ {-# LANGUAGE DataKinds #-} -module Language.Haskell.Brittany.ExactPrintUtils +module Language.Haskell.Brittany.Internal.ExactPrintUtils ( parseModule , parseModuleFromString , commentAnnFixTransform @@ -12,10 +12,10 @@ where #include "prelude.inc" -import Language.Haskell.Brittany.Types -import Language.Haskell.Brittany.Config.Types -import Language.Haskell.Brittany.LayouterBasics -import Language.Haskell.Brittany.Utils +import Language.Haskell.Brittany.Internal.Types +import Language.Haskell.Brittany.Internal.Config.Types +import Language.Haskell.Brittany.Internal.LayouterBasics +import Language.Haskell.Brittany.Internal.Utils import DynFlags ( getDynFlags ) import GHC ( runGhc, GenLocated(L), moduleNameString ) diff --git a/src/Language/Haskell/Brittany/LayouterBasics.hs b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs similarity index 99% rename from src/Language/Haskell/Brittany/LayouterBasics.hs rename to src/Language/Haskell/Brittany/Internal/LayouterBasics.hs index 096d1dd..7ef4123 100644 --- a/src/Language/Haskell/Brittany/LayouterBasics.hs +++ b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs @@ -1,4 +1,4 @@ -module Language.Haskell.Brittany.LayouterBasics +module Language.Haskell.Brittany.Internal.LayouterBasics ( processDefault , rdrNameToText , lrdrNameToText @@ -64,9 +64,9 @@ import Language.Haskell.GHC.ExactPrint.Types ( AnnKey, Annotation, KeywordId ) import qualified Data.Text.Lazy.Builder as Text.Builder -import Language.Haskell.Brittany.Config.Types -import Language.Haskell.Brittany.Types -import Language.Haskell.Brittany.Utils +import Language.Haskell.Brittany.Internal.Config.Types +import Language.Haskell.Brittany.Internal.Types +import Language.Haskell.Brittany.Internal.Utils import RdrName ( RdrName(..) ) import GHC ( Located, runGhc, GenLocated(L), moduleNameString ) diff --git a/src/Language/Haskell/Brittany/Layouters/Decl.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs similarity index 96% rename from src/Language/Haskell/Brittany/Layouters/Decl.hs rename to src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs index b01d283..a2da0a1 100644 --- a/src/Language/Haskell/Brittany/Layouters/Decl.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs @@ -1,7 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeApplications #-} -module Language.Haskell.Brittany.Layouters.Decl +module Language.Haskell.Brittany.Internal.Layouters.Decl ( layoutSig , layoutBind , layoutLocalBinds @@ -16,9 +16,9 @@ where #include "prelude.inc" -import Language.Haskell.Brittany.Types -import Language.Haskell.Brittany.LayouterBasics -import Language.Haskell.Brittany.Config.Types +import Language.Haskell.Brittany.Internal.Types +import Language.Haskell.Brittany.Internal.LayouterBasics +import Language.Haskell.Brittany.Internal.Config.Types import RdrName ( RdrName(..) ) import GHC ( runGhc, GenLocated(L), moduleNameString ) @@ -32,10 +32,10 @@ import BasicTypes ( InlinePragma(..) ) import Language.Haskell.GHC.ExactPrint.Types ( mkAnnKey ) -import Language.Haskell.Brittany.Layouters.Type -import {-# SOURCE #-} Language.Haskell.Brittany.Layouters.Expr -import {-# SOURCE #-} Language.Haskell.Brittany.Layouters.Stmt -import Language.Haskell.Brittany.Layouters.Pattern +import Language.Haskell.Brittany.Internal.Layouters.Type +import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Expr +import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Stmt +import Language.Haskell.Brittany.Internal.Layouters.Pattern import Bag ( mapBagM ) diff --git a/src/Language/Haskell/Brittany/Layouters/Expr.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs similarity index 98% rename from src/Language/Haskell/Brittany/Layouters/Expr.hs rename to src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs index db19318..f1ad0ad 100644 --- a/src/Language/Haskell/Brittany/Layouters/Expr.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs @@ -1,6 +1,6 @@ {-# LANGUAGE DataKinds #-} -module Language.Haskell.Brittany.Layouters.Expr +module Language.Haskell.Brittany.Internal.Layouters.Expr ( layoutExpr , litBriDoc , overLitValBriDoc @@ -11,8 +11,8 @@ where #include "prelude.inc" -import Language.Haskell.Brittany.Types -import Language.Haskell.Brittany.LayouterBasics +import Language.Haskell.Brittany.Internal.Types +import Language.Haskell.Brittany.Internal.LayouterBasics import RdrName ( RdrName(..) ) import GHC ( runGhc, GenLocated(L), moduleNameString, AnnKeywordId(..) ) @@ -21,11 +21,11 @@ import Name import qualified FastString import BasicTypes -import Language.Haskell.Brittany.Utils -import Language.Haskell.Brittany.Layouters.Pattern -import Language.Haskell.Brittany.Layouters.Decl -import Language.Haskell.Brittany.Layouters.Stmt -import Language.Haskell.Brittany.Layouters.Type +import Language.Haskell.Brittany.Internal.Utils +import Language.Haskell.Brittany.Internal.Layouters.Pattern +import Language.Haskell.Brittany.Internal.Layouters.Decl +import Language.Haskell.Brittany.Internal.Layouters.Stmt +import Language.Haskell.Brittany.Internal.Layouters.Type diff --git a/src/Language/Haskell/Brittany/Layouters/Expr.hs-boot b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs-boot similarity index 71% rename from src/Language/Haskell/Brittany/Layouters/Expr.hs-boot rename to src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs-boot index caf6353..0d01034 100644 --- a/src/Language/Haskell/Brittany/Layouters/Expr.hs-boot +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs-boot @@ -1,6 +1,6 @@ {-# LANGUAGE DataKinds #-} -module Language.Haskell.Brittany.Layouters.Expr +module Language.Haskell.Brittany.Internal.Layouters.Expr ( layoutExpr , litBriDoc , overLitValBriDoc @@ -11,8 +11,8 @@ where #include "prelude.inc" -import Language.Haskell.Brittany.Types -import Language.Haskell.Brittany.LayouterBasics +import Language.Haskell.Brittany.Internal.Types +import Language.Haskell.Brittany.Internal.LayouterBasics import RdrName ( RdrName(..) ) import GHC ( runGhc, GenLocated(L), moduleNameString ) diff --git a/src/Language/Haskell/Brittany/Layouters/Pattern.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs similarity index 94% rename from src/Language/Haskell/Brittany/Layouters/Pattern.hs rename to src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs index c836886..e231856 100644 --- a/src/Language/Haskell/Brittany/Layouters/Pattern.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs @@ -1,6 +1,6 @@ {-# LANGUAGE DataKinds #-} -module Language.Haskell.Brittany.Layouters.Pattern +module Language.Haskell.Brittany.Internal.Layouters.Pattern ( layoutPat , colsWrapPat ) @@ -10,8 +10,8 @@ where #include "prelude.inc" -import Language.Haskell.Brittany.Types -import Language.Haskell.Brittany.LayouterBasics +import Language.Haskell.Brittany.Internal.Types +import Language.Haskell.Brittany.Internal.LayouterBasics import RdrName ( RdrName(..) ) import GHC ( Located, runGhc, GenLocated(L), moduleNameString ) @@ -19,8 +19,8 @@ import HsSyn import Name import BasicTypes -import {-# SOURCE #-} Language.Haskell.Brittany.Layouters.Expr -import Language.Haskell.Brittany.Layouters.Type +import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Expr +import Language.Haskell.Brittany.Internal.Layouters.Type diff --git a/src/Language/Haskell/Brittany/Layouters/Stmt.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs similarity index 84% rename from src/Language/Haskell/Brittany/Layouters/Stmt.hs rename to src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs index 20c14a9..692b467 100644 --- a/src/Language/Haskell/Brittany/Layouters/Stmt.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs @@ -1,6 +1,6 @@ {-# LANGUAGE DataKinds #-} -module Language.Haskell.Brittany.Layouters.Stmt +module Language.Haskell.Brittany.Internal.Layouters.Stmt ( layoutStmt ) where @@ -9,8 +9,8 @@ where #include "prelude.inc" -import Language.Haskell.Brittany.Types -import Language.Haskell.Brittany.LayouterBasics +import Language.Haskell.Brittany.Internal.Types +import Language.Haskell.Brittany.Internal.LayouterBasics import RdrName ( RdrName(..) ) import GHC ( runGhc, GenLocated(L), moduleNameString ) @@ -19,9 +19,9 @@ import Name import qualified FastString import BasicTypes -import Language.Haskell.Brittany.Layouters.Pattern -import Language.Haskell.Brittany.Layouters.Decl -import {-# SOURCE #-} Language.Haskell.Brittany.Layouters.Expr +import Language.Haskell.Brittany.Internal.Layouters.Pattern +import Language.Haskell.Brittany.Internal.Layouters.Decl +import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Expr diff --git a/src/Language/Haskell/Brittany/Layouters/Stmt.hs-boot b/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs-boot similarity index 66% rename from src/Language/Haskell/Brittany/Layouters/Stmt.hs-boot rename to src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs-boot index bd57750..0cb46be 100644 --- a/src/Language/Haskell/Brittany/Layouters/Stmt.hs-boot +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs-boot @@ -1,6 +1,6 @@ {-# LANGUAGE DataKinds #-} -module Language.Haskell.Brittany.Layouters.Stmt +module Language.Haskell.Brittany.Internal.Layouters.Stmt ( layoutStmt ) where @@ -9,8 +9,8 @@ where #include "prelude.inc" -import Language.Haskell.Brittany.Types -import Language.Haskell.Brittany.LayouterBasics +import Language.Haskell.Brittany.Internal.Types +import Language.Haskell.Brittany.Internal.LayouterBasics import RdrName ( RdrName(..) ) import GHC ( runGhc, GenLocated(L), moduleNameString ) diff --git a/src/Language/Haskell/Brittany/Layouters/Type.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs similarity index 98% rename from src/Language/Haskell/Brittany/Layouters/Type.hs rename to src/Language/Haskell/Brittany/Internal/Layouters/Type.hs index 2c42029..0ca6ab7 100644 --- a/src/Language/Haskell/Brittany/Layouters/Type.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs @@ -1,6 +1,6 @@ {-# LANGUAGE DataKinds #-} -module Language.Haskell.Brittany.Layouters.Type +module Language.Haskell.Brittany.Internal.Layouters.Type ( layoutType ) where @@ -9,9 +9,9 @@ where #include "prelude.inc" -import Language.Haskell.Brittany.Config.Types -import Language.Haskell.Brittany.Types -import Language.Haskell.Brittany.LayouterBasics +import Language.Haskell.Brittany.Internal.Config.Types +import Language.Haskell.Brittany.Internal.Types +import Language.Haskell.Brittany.Internal.LayouterBasics import RdrName ( RdrName(..) ) import GHC ( runGhc, GenLocated(L), moduleNameString ) diff --git a/src/Language/Haskell/Brittany/Prelude.hs b/src/Language/Haskell/Brittany/Internal/Prelude.hs similarity index 96% rename from src/Language/Haskell/Brittany/Prelude.hs rename to src/Language/Haskell/Brittany/Internal/Prelude.hs index 563bfb8..f4f85c0 100644 --- a/src/Language/Haskell/Brittany/Prelude.hs +++ b/src/Language/Haskell/Brittany/Internal/Prelude.hs @@ -1,4 +1,4 @@ -module Language.Haskell.Brittany.Prelude +module Language.Haskell.Brittany.Internal.Prelude where diff --git a/src/Language/Haskell/Brittany/Transformations/Alt.hs b/src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs similarity index 99% rename from src/Language/Haskell/Brittany/Transformations/Alt.hs rename to src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs index 208771e..6ef4a2b 100644 --- a/src/Language/Haskell/Brittany/Transformations/Alt.hs +++ b/src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs @@ -5,7 +5,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} -module Language.Haskell.Brittany.Transformations.Alt +module Language.Haskell.Brittany.Internal.Transformations.Alt ( transformAlts ) where @@ -16,9 +16,9 @@ where import Data.HList.ContainsType -import Language.Haskell.Brittany.Utils -import Language.Haskell.Brittany.Config.Types -import Language.Haskell.Brittany.Types +import Language.Haskell.Brittany.Internal.Utils +import Language.Haskell.Brittany.Internal.Config.Types +import Language.Haskell.Brittany.Internal.Types import qualified Control.Monad.Memo as Memo diff --git a/src/Language/Haskell/Brittany/Transformations/Columns.hs b/src/Language/Haskell/Brittany/Internal/Transformations/Columns.hs similarity index 95% rename from src/Language/Haskell/Brittany/Transformations/Columns.hs rename to src/Language/Haskell/Brittany/Internal/Transformations/Columns.hs index 13f3161..040e7e9 100644 --- a/src/Language/Haskell/Brittany/Transformations/Columns.hs +++ b/src/Language/Haskell/Brittany/Internal/Transformations/Columns.hs @@ -1,4 +1,4 @@ -module Language.Haskell.Brittany.Transformations.Columns +module Language.Haskell.Brittany.Internal.Transformations.Columns ( transformSimplifyColumns ) where @@ -7,9 +7,9 @@ where #include "prelude.inc" -import Language.Haskell.Brittany.Utils -import Language.Haskell.Brittany.Config.Types -import Language.Haskell.Brittany.Types +import Language.Haskell.Brittany.Internal.Utils +import Language.Haskell.Brittany.Internal.Config.Types +import Language.Haskell.Brittany.Internal.Types import qualified Data.Generics.Uniplate.Direct as Uniplate diff --git a/src/Language/Haskell/Brittany/Transformations/Floating.hs b/src/Language/Haskell/Brittany/Internal/Transformations/Floating.hs similarity index 97% rename from src/Language/Haskell/Brittany/Transformations/Floating.hs rename to src/Language/Haskell/Brittany/Internal/Transformations/Floating.hs index e831011..e36a545 100644 --- a/src/Language/Haskell/Brittany/Transformations/Floating.hs +++ b/src/Language/Haskell/Brittany/Internal/Transformations/Floating.hs @@ -1,4 +1,4 @@ -module Language.Haskell.Brittany.Transformations.Floating +module Language.Haskell.Brittany.Internal.Transformations.Floating ( transformSimplifyFloating ) where @@ -7,9 +7,9 @@ where #include "prelude.inc" -import Language.Haskell.Brittany.Utils -import Language.Haskell.Brittany.Config.Types -import Language.Haskell.Brittany.Types +import Language.Haskell.Brittany.Internal.Utils +import Language.Haskell.Brittany.Internal.Config.Types +import Language.Haskell.Brittany.Internal.Types import qualified Data.Generics.Uniplate.Direct as Uniplate diff --git a/src/Language/Haskell/Brittany/Transformations/Indent.hs b/src/Language/Haskell/Brittany/Internal/Transformations/Indent.hs similarity index 87% rename from src/Language/Haskell/Brittany/Transformations/Indent.hs rename to src/Language/Haskell/Brittany/Internal/Transformations/Indent.hs index 703f050..b3d7709 100644 --- a/src/Language/Haskell/Brittany/Transformations/Indent.hs +++ b/src/Language/Haskell/Brittany/Internal/Transformations/Indent.hs @@ -1,4 +1,4 @@ -module Language.Haskell.Brittany.Transformations.Indent +module Language.Haskell.Brittany.Internal.Transformations.Indent ( transformSimplifyIndent ) where @@ -7,9 +7,9 @@ where #include "prelude.inc" -import Language.Haskell.Brittany.Utils -import Language.Haskell.Brittany.Config.Types -import Language.Haskell.Brittany.Types +import Language.Haskell.Brittany.Internal.Utils +import Language.Haskell.Brittany.Internal.Config.Types +import Language.Haskell.Brittany.Internal.Types import qualified Data.Generics.Uniplate.Direct as Uniplate diff --git a/src/Language/Haskell/Brittany/Transformations/Par.hs b/src/Language/Haskell/Brittany/Internal/Transformations/Par.hs similarity index 85% rename from src/Language/Haskell/Brittany/Transformations/Par.hs rename to src/Language/Haskell/Brittany/Internal/Transformations/Par.hs index be3f532..e048584 100644 --- a/src/Language/Haskell/Brittany/Transformations/Par.hs +++ b/src/Language/Haskell/Brittany/Internal/Transformations/Par.hs @@ -1,4 +1,4 @@ -module Language.Haskell.Brittany.Transformations.Par +module Language.Haskell.Brittany.Internal.Transformations.Par ( transformSimplifyPar ) where @@ -7,9 +7,9 @@ where #include "prelude.inc" -import Language.Haskell.Brittany.Utils -import Language.Haskell.Brittany.Config.Types -import Language.Haskell.Brittany.Types +import Language.Haskell.Brittany.Internal.Utils +import Language.Haskell.Brittany.Internal.Config.Types +import Language.Haskell.Brittany.Internal.Types import qualified Data.Generics.Uniplate.Direct as Uniplate diff --git a/src/Language/Haskell/Brittany/Types.hs b/src/Language/Haskell/Brittany/Internal/Types.hs similarity index 99% rename from src/Language/Haskell/Brittany/Types.hs rename to src/Language/Haskell/Brittany/Internal/Types.hs index fabd6bf..5420e7b 100644 --- a/src/Language/Haskell/Brittany/Types.hs +++ b/src/Language/Haskell/Brittany/Internal/Types.hs @@ -5,7 +5,7 @@ {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE BangPatterns #-} -module Language.Haskell.Brittany.Types +module Language.Haskell.Brittany.Internal.Types 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.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 diff --git a/src/Language/Haskell/Brittany/Utils.hs b/src/Language/Haskell/Brittany/Internal/Utils.hs similarity index 98% rename from src/Language/Haskell/Brittany/Utils.hs rename to src/Language/Haskell/Brittany/Internal/Utils.hs index b55b3d3..33fe6a0 100644 --- a/src/Language/Haskell/Brittany/Utils.hs +++ b/src/Language/Haskell/Brittany/Internal/Utils.hs @@ -1,7 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -module Language.Haskell.Brittany.Utils +module Language.Haskell.Brittany.Internal.Utils ( parDoc , fromMaybeIdentity , fromOptionIdentity @@ -50,8 +50,8 @@ import qualified Data.ByteString as B import DataTreePrint -import Language.Haskell.Brittany.Config.Types -import Language.Haskell.Brittany.Types +import Language.Haskell.Brittany.Internal.Config.Types +import Language.Haskell.Brittany.Internal.Types import qualified Data.Generics.Uniplate.Direct as Uniplate diff --git a/srcinc/prelude.inc b/srcinc/prelude.inc index 71226c3..d9572d0 100644 --- a/srcinc/prelude.inc +++ b/srcinc/prelude.inc @@ -786,7 +786,7 @@ import Control.Monad.Trans.Class ( lift import Control.Monad.Trans.Maybe ( MaybeT (..) ) -import Language.Haskell.Brittany.Prelude +import Language.Haskell.Brittany.Internal.Prelude import Data.Data ( toConstr )