Refactor all modules: +Internal; Add public Brittany module

pull/35/head
Lennart Spitzner 2017-05-22 21:25:08 +02:00
parent 5dbe0f2c9c
commit f350113f7f
31 changed files with 530 additions and 512 deletions

View File

@ -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: {

View File

@ -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

View File

@ -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 )

View File

@ -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 )

View File

@ -13,7 +13,7 @@ import Test.Hspec
import NeatInterpolation import NeatInterpolation
import Language.Haskell.Brittany import Language.Haskell.Brittany.Internal
import TestUtils import TestUtils

View File

@ -10,7 +10,7 @@ import Test.Hspec
import NeatInterpolation import NeatInterpolation
import Language.Haskell.Brittany import Language.Haskell.Brittany.Internal
import AsymptoticPerfTests import AsymptoticPerfTests

View File

@ -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 )

View File

@ -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 $ ()

View File

@ -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 $ ()

View File

@ -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

View File

@ -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 )

View File

@ -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 )

View File

@ -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

View File

@ -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 )

View File

@ -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 )

View File

@ -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 )

View File

@ -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

View File

@ -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 )

View File

@ -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

View File

@ -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

View File

@ -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 )

View File

@ -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 )

View File

@ -1,4 +1,4 @@
module Language.Haskell.Brittany.Prelude module Language.Haskell.Brittany.Internal.Prelude
where where

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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
) )