hexagoxel
/
brittany
1
0
Fork 0
Code Issues 117 Pull Requests 5 Packages Projects Releases 5 Wiki Activity

Refactor/Rename LayoutError -> BrittanyError

pull/35/head
Lennart Spitzner 2017-05-23 00:09:42 +02:00
parent 72b8817f32
commit dfec26e55b
5 changed files with 43 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
src-brittany/Main.hs
View File

@ -159,22 +159,22 @@ mainCmdParser helpDesc = do
else 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
let customErrOrder ErrorInput{} = 4
customErrOrder LayoutWarning{} = 0 :: Int
customErrOrder LayoutErrorOutputCheck{} = 1
customErrOrder LayoutErrorUnusedComment{} = 2
customErrOrder LayoutErrorUnknownNode{} = 3
customErrOrder ErrorOutputCheck{} = 1
customErrOrder ErrorUnusedComment{} = 2
customErrOrder ErrorUnknownNode{} = 3
when (not $ null errsWarns) $ do
let groupedErrsWarns = Data.List.Extra.groupOn customErrOrder $ List.sortOn customErrOrder $ errsWarns
groupedErrsWarns `forM_` \case
(LayoutErrorOutputCheck{}:_) -> do
(ErrorOutputCheck{}:_) -> do
putStrErrLn $ "ERROR: brittany pretty printer" ++ " returned syntactically invalid result."
(LayoutErrorInput str:_) -> do
(ErrorInput str:_) -> do
putStrErrLn $ "ERROR: parse error: " ++ str
uns@(LayoutErrorUnknownNode{}:_) -> do
uns@(ErrorUnknownNode{}:_) -> do
putStrErrLn $ "ERROR: encountered unknown syntactical constructs:"
uns `forM_` \case
LayoutErrorUnknownNode str ast -> do
ErrorUnknownNode str ast -> do
putStrErrLn str
when (config & _conf_debug & _dconf_dump_ast_unknown & confUnpack) $ do
putStrErrLn $ " " ++ show (astToDoc ast)
@ -184,7 +184,7 @@ mainCmdParser helpDesc = do
warns `forM_` \case
LayoutWarning str -> putStrErrLn str
_ -> error "cannot happen (TM)"
unused@(LayoutErrorUnusedComment{}:_) -> do
unused@(ErrorUnusedComment{}:_) -> do
putStrErrLn
$ "Error: detected unprocessed comments."
++ " The transformation output will most likely"
@ -192,7 +192,7 @@ mainCmdParser helpDesc = do
++ " present in the input haskell source file."
putStrErrLn $ "Affected are the following comments:"
unused `forM_` \case
LayoutErrorUnusedComment str -> putStrErrLn str
ErrorUnusedComment str -> putStrErrLn str
_ -> error "cannot happen (TM)"
[] -> error "cannot happen"
-- TODO: don't output anything when there are errors unless user

2
src/Language/Haskell/Brittany.hs
View File

@ -3,7 +3,7 @@
module Language.Haskell.Brittany
( pureModuleTransform
, CConfig
, LayoutError(..)
, BrittanyError(..)
)
where

42
src/Language/Haskell/Brittany/Internal.hs
View File

@ -60,7 +60,7 @@ import qualified GHC.LanguageExtensions.Type as GHC
--
-- 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 :: CConfig Option -> Text -> IO (Either [BrittanyError] Text)
pureModuleTransform oConfigRaw inputText = runEitherT $ do
let configRaw = cZipWith fromOptionIdentity staticDefaultConfig oConfigRaw
let config = configRaw { _conf_debug = _conf_debug staticDefaultConfig }
@ -87,7 +87,7 @@ pureModuleTransform oConfigRaw inputText = runEitherT $ do
cppCheckFunc
(hackTransform $ Text.unpack inputText)
case parseResult of
Left err -> left $ [LayoutErrorInput err]
Left err -> left $ [ErrorInput err]
Right x -> pure $ x
(errsWarns, outputTextL) <- do
let omitCheck =
@ -103,21 +103,19 @@ pureModuleTransform oConfigRaw inputText = runEitherT $ do
pure $ if hackAroundIncludes
then (ews, TextL.unlines $ fmap hackF $ TextL.lines outRaw)
else (ews, outRaw)
let customErrOrder LayoutErrorInput{} = 4
let customErrOrder ErrorInput{} = 4
customErrOrder LayoutWarning{} = 0 :: Int
customErrOrder LayoutErrorOutputCheck{} = 1
customErrOrder LayoutErrorUnusedComment{} = 2
customErrOrder LayoutErrorUnknownNode{} = 3
customErrOrder ErrorOutputCheck{} = 1
customErrOrder ErrorUnusedComment{} = 2
customErrOrder ErrorUnknownNode{} = 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
if hasErrors then left $ errsWarns else pure $ TextL.toStrict outputTextL
-- LayoutErrors can be non-fatal warnings, thus both are returned instead
-- BrittanyErrors can be non-fatal warnings, thus both are returned instead
-- of an Either.
-- This should be cleaned up once it is clear what kinds of errors really
-- can occur.
@ -125,7 +123,7 @@ pPrintModule
:: Config
-> ExactPrint.Types.Anns
-> GHC.ParsedSource
-> ([LayoutError], TextL.Text)
-> ([BrittanyError], TextL.Text)
pPrintModule conf anns parsedModule =
let
((out, errs), debugStrings) =
@ -160,7 +158,7 @@ pPrintModuleAndCheck
:: Config
-> ExactPrint.Types.Anns
-> GHC.ParsedSource
-> IO ([LayoutError], TextL.Text)
-> IO ([BrittanyError], TextL.Text)
pPrintModuleAndCheck conf anns parsedModule = do
let ghcOptions = conf & _conf_forward & _options_ghc & runIdentity
let (errs, output) = pPrintModule conf anns parsedModule
@ -169,7 +167,7 @@ pPrintModuleAndCheck conf anns parsedModule = do
(\_ -> return $ Right ())
(TextL.unpack output)
let errs' = errs ++ case parseResult of
Left{} -> [LayoutErrorOutputCheck]
Left{} -> [ErrorOutputCheck]
Right{} -> []
return (errs', output)
@ -193,15 +191,13 @@ parsePrintModule conf filename input = do
return $ if null errs
then Right $ TextL.toStrict $ ltext
else
let
errStrs = errs <&> \case
LayoutErrorInput str -> str
LayoutErrorUnusedComment str -> str
let errStrs = errs <&> \case
ErrorInput str -> str
ErrorUnusedComment str -> str
LayoutWarning str -> str
LayoutErrorUnknownNode str _ -> str
LayoutErrorOutputCheck -> "Output is not syntactically valid."
in
Left $ "pretty printing error(s):\n" ++ List.unlines errStrs
ErrorUnknownNode str _ -> str
ErrorOutputCheck -> "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.
@ -234,7 +230,7 @@ parsePrintModule conf filename input = do
-- if (not $ null errs)
-- then do
-- let errStrs = errs <&> \case
-- LayoutErrorUnusedComment str -> str
-- ErrorUnusedComment str -> str
-- Left $ "pretty printing error(s):\n" ++ List.unlines errStrs
-- else return $ TextL.toStrict $ Text.Builder.toLazyText out
@ -396,6 +392,6 @@ layoutBriDoc ast briDoc = do
let remainingComments =
extractAllComments =<< Map.elems (_lstate_comments state')
remainingComments
`forM_` (fst .> show .> LayoutErrorUnusedComment .> (:[]) .> mTell)
`forM_` (fst .> show .> ErrorUnusedComment .> (:[]) .> mTell)
return $ ()

4
src/Language/Haskell/Brittany/Internal/LayouterBasics.hs
View File

@ -156,7 +156,7 @@ briDocByExactInlineOnly infoStr ast = do
exactPrinted
let
errorAction = do
mTell $ [LayoutErrorUnknownNode infoStr ast]
mTell $ [ErrorUnknownNode infoStr ast]
docLit $ Text.pack "{- BRITTANY ERROR UNHANDLED SYNTACTICAL CONSTRUCT -}"
case (fallbackMode, Text.lines exactPrinted) of
(ExactPrintFallbackModeNever, _ ) -> errorAction
@ -607,7 +607,7 @@ docEnsureIndent ind mbd = mbd >>= \bd -> allocateNode $ BDFEnsureIndent ind bd
unknownNodeError
:: Data.Data.Data ast => String -> ast -> ToBriDocM BriDocNumbered
unknownNodeError infoStr ast = do
mTell $ [LayoutErrorUnknownNode infoStr ast]
mTell $ [ErrorUnknownNode infoStr ast]
docLit $ Text.pack "{- BRITTANY ERROR UNHANDLED SYNTACTICAL CONSTRUCT -}"
spacifyDocs :: [ToBriDocM BriDocNumbered] -> [ToBriDocM BriDocNumbered]

14
src/Language/Haskell/Brittany/Internal/Types.hs
View File

@ -28,7 +28,7 @@ import Data.Generics.Uniplate.Direct as Uniplate
type PPM a = MultiRWSS.MultiRWS '[Config, ExactPrint.Anns] '[Text.Builder.Builder, [LayoutError], Seq String] '[] a
type PPM a = MultiRWSS.MultiRWS '[Config, ExactPrint.Anns] '[Text.Builder.Builder, [BrittanyError], Seq String] '[] a
data LayoutState = LayoutState
{ _lstate_baseYs :: [Int]
@ -114,17 +114,17 @@ instance Show LayoutState where
-- , _lsettings_initialAnns :: ExactPrint.Anns
-- }
data LayoutError
= LayoutErrorInput String
data BrittanyError
= ErrorInput String
-- ^ parsing failed
| LayoutErrorUnusedComment String
| ErrorUnusedComment String
-- ^ internal error: some comment went missing
| LayoutWarning String
-- ^ some warning
| forall ast . Data.Data.Data ast => LayoutErrorUnknownNode String ast
| forall ast . Data.Data.Data ast => ErrorUnknownNode String ast
-- ^ internal error: pretty-printing is not implemented for type of node
-- in the syntax-tree
| LayoutErrorOutputCheck
| ErrorOutputCheck
-- ^ checking the output for syntactic validity failed
data BriSpacing = BriSpacing
@ -187,7 +187,7 @@ data BrIndent = BrIndentNone
| BrIndentSpecial Int
deriving (Eq, Ord, Typeable, Data.Data.Data, Show)
type ToBriDocM = MultiRWSS.MultiRWS '[Config, Anns] '[[LayoutError], Seq String] '[NodeAllocIndex]
type ToBriDocM = MultiRWSS.MultiRWS '[Config, Anns] '[[BrittanyError], Seq String] '[NodeAllocIndex]
type ToBriDoc (sym :: * -> *) = Located (sym RdrName) -> ToBriDocM BriDocNumbered
type ToBriDoc' sym = Located sym -> ToBriDocM BriDocNumbered