Remove unused tests
Taylor Fausak
GitHub
parent
d03deccba8
commit
75cf5b83a3
src-idemtests
|
|
@ -1,4 +0,0 @@
|
|||
iterOne/
|
||||
iterTwo/
|
||||
brittany
|
||||
report.txt
|
||||
|
|
@ -1,17 +0,0 @@
|
|||
idempotency testing on real-life examples, i.e. checks that brittany(x) is
|
||||
equal to brittany(brittany(x)) for some x's. The idea is that these testcases
|
||||
are not yet transformed, i.e. that x is not brittany(x). This can capture
|
||||
certain bugs that are not detected by checking that brittany behaves as
|
||||
identity on "well-formed" input.
|
||||
|
||||
to run:
|
||||
|
||||
- put a "brittany" executable into this directory.
|
||||
- cd into this directory.
|
||||
- ./run.sh
|
||||
|
||||
report.txt will contain the results.
|
||||
|
||||
note that only the configuration in brittany.yaml is tested, which contains
|
||||
the default settings. ideally this would be managed in some other, more
|
||||
transparent fashion.
|
||||
|
|
@ -1,29 +0,0 @@
|
|||
conf_errorHandling:
|
||||
econf_Werror: false
|
||||
econf_produceOutputOnErrors: false
|
||||
econf_CPPMode: CPPModeNowarn
|
||||
conf_layout:
|
||||
lconfig_indentPolicy: IndentPolicyFree
|
||||
lconfig_cols: 80
|
||||
lconfig_indentAmount: 2
|
||||
lconfig_importColumn: 60
|
||||
lconfig_altChooser:
|
||||
tag: AltChooserBoundedSearch
|
||||
contents: 3
|
||||
lconfig_indentWhereSpecial: true
|
||||
lconfig_indentListSpecial: true
|
||||
conf_forward:
|
||||
options_ghc: []
|
||||
conf_debug:
|
||||
dconf_dump_annotations: false
|
||||
dconf_dump_bridoc_simpl_par: false
|
||||
dconf_dump_bridoc_simpl_indent: false
|
||||
dconf_dump_bridoc_simpl_floating: false
|
||||
dconf_dump_ast_full: false
|
||||
dconf_dump_bridoc_simpl_columns: false
|
||||
dconf_dump_ast_unknown: false
|
||||
dconf_dump_bridoc_simpl_alt: false
|
||||
dconf_dump_bridoc_final: false
|
||||
dconf_dump_bridoc_raw: false
|
||||
dconf_dump_config: false
|
||||
|
||||
|
|
@ -1,733 +0,0 @@
|
|||
module Language.Haskell.Brittany.Internal.LayoutBasics
|
||||
( processDefault
|
||||
, layoutByExact
|
||||
-- , layoutByExactR
|
||||
, descToBlockStart
|
||||
, descToBlockMinMax
|
||||
, descToMinMax
|
||||
, rdrNameToText
|
||||
, lrdrNameToText
|
||||
, lrdrNameToTextAnn
|
||||
, askIndent
|
||||
, calcLayoutMin
|
||||
, calcLayoutMax
|
||||
, getCurRemaining
|
||||
, layoutWriteAppend
|
||||
, layoutWriteAppendMultiline
|
||||
, layoutWriteNewline
|
||||
, layoutWriteNewlinePlain
|
||||
, layoutWriteEnsureNewline
|
||||
, layoutWriteEnsureBlock
|
||||
, layoutWriteEnsureBlockPlusN
|
||||
, layoutWithAddIndent
|
||||
, layoutWithAddIndentBlock
|
||||
, layoutWithAddIndentN
|
||||
, layoutWithAddIndentNBlock
|
||||
, layoutWithNonParamIndent
|
||||
, layoutWriteEnsureAbsoluteN
|
||||
, layoutAddSepSpace
|
||||
, moveToExactAnn
|
||||
, moveToExactAnn'
|
||||
, setOpIndent
|
||||
, stringLayouter
|
||||
, layoutWritePriorComments
|
||||
, layoutWritePostComments
|
||||
, layoutIndentRestorePostComment
|
||||
, layoutWritePriorCommentsRestore
|
||||
, layoutWritePostCommentsRestore
|
||||
, extractCommentsPrior
|
||||
, extractCommentsPost
|
||||
, applyLayouter
|
||||
, applyLayouterRestore
|
||||
, filterAnns
|
||||
, layouterFToLayouterM
|
||||
, ppmMoveToExactLoc
|
||||
, customLayouterF
|
||||
, docEmpty
|
||||
, docLit
|
||||
, docAlt
|
||||
, docSeq
|
||||
, docPar
|
||||
-- , docCols
|
||||
, docPostComment
|
||||
, docWrapNode
|
||||
, briDocByExact
|
||||
, fromMaybeIdentity
|
||||
, foldedAnnKeys
|
||||
)
|
||||
where
|
||||
|
||||
|
||||
|
||||
-- more imports here..
|
||||
|
||||
import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
|
||||
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.Utils as ExactPrint.Utils
|
||||
|
||||
import Language.Haskell.GHC.ExactPrint.Types ( AnnKey, Annotation )
|
||||
|
||||
import qualified Data.Text.Lazy.Builder as Text.Builder
|
||||
|
||||
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 )
|
||||
import qualified Outputable as GHC
|
||||
import qualified DynFlags as GHC
|
||||
import qualified FastString as GHC
|
||||
import qualified SrcLoc as GHC
|
||||
import SrcLoc ( SrcSpan )
|
||||
import OccName ( occNameString )
|
||||
import Name ( getOccString )
|
||||
import Module ( moduleName )
|
||||
import ApiAnnotation ( AnnKeywordId(..) )
|
||||
|
||||
import Data.Data
|
||||
import Data.Generics.Schemes
|
||||
import Data.Generics.Aliases
|
||||
|
||||
import DataTreePrint
|
||||
|
||||
import qualified Text.PrettyPrint as PP
|
||||
|
||||
import Data.Function ( fix )
|
||||
|
||||
|
||||
|
||||
processDefault :: (ExactPrint.Annotate.Annotate ast, MonadMultiWriter
|
||||
Text.Builder.Builder m,
|
||||
MonadMultiReader ExactPrint.Types.Anns m)
|
||||
=> GenLocated SrcSpan ast
|
||||
-> m ()
|
||||
processDefault x = do
|
||||
anns <- mAsk
|
||||
let str = ExactPrint.exactPrint x anns
|
||||
-- this hack is here so our print-empty-module trick does not add
|
||||
-- a newline at the start if there actually is no module header / imports
|
||||
-- / anything.
|
||||
-- TODO: instead the appropriate annotation could be removed when "cleaning"
|
||||
-- the module (header). This would remove the need for this hack!
|
||||
--test
|
||||
case str of
|
||||
"\n" -> return ()
|
||||
_ -> mTell $ Text.Builder.fromString $ str
|
||||
|
||||
|
||||
layoutByExact :: ( MonadMultiReader Config m
|
||||
, MonadMultiReader (ExactPrint.Types.Anns) m
|
||||
, ExactPrint.Annotate.Annotate ast
|
||||
)
|
||||
=> GenLocated SrcSpan ast -> m Layouter
|
||||
layoutByExact x = do
|
||||
anns <- mAsk
|
||||
trace (showTreeWithCustom (customLayouterF anns) x) $ layoutByExactR x
|
||||
-- trace (ExactPrint.Utils.showAnnData anns 2 x) $ layoutByExactR x
|
||||
|
||||
layoutByExactR :: (MonadMultiReader Config m
|
||||
, MonadMultiReader (ExactPrint.Types.Anns) m
|
||||
, ExactPrint.Annotate.Annotate ast)
|
||||
=> GenLocated SrcSpan ast -> m Layouter
|
||||
layoutByExactR x = do
|
||||
indent <- askIndent
|
||||
anns <- mAsk
|
||||
let t = Text.pack $ ExactPrint.exactPrint x anns
|
||||
let tlines = Text.lines $ t <> Text.pack "\n"
|
||||
tlineCount = length tlines
|
||||
let len = indent + maximum (Text.length <$> tlines)
|
||||
return $ Layouter
|
||||
{ _layouter_desc = LayoutDesc Nothing $ Just $ BlockDesc AllSameIndent len len Nothing
|
||||
, _layouter_func = \_ -> do
|
||||
-- layoutWriteEnsureBlock
|
||||
layoutWriteAppend $ Text.pack $ "{-" ++ show (ExactPrint.Types.mkAnnKey x, Map.lookup (ExactPrint.Types.mkAnnKey x) anns) ++ "-}"
|
||||
zip [1..] tlines `forM_` \(i, l) -> do
|
||||
layoutWriteAppend $ l
|
||||
unless (i==tlineCount) layoutWriteNewline
|
||||
do
|
||||
let subKeys = foldedAnnKeys x
|
||||
state <- mGet
|
||||
let filterF k _ = not $ k `Set.member` subKeys
|
||||
mSet $ state
|
||||
{ _lstate_commentsPrior = Map.filterWithKey filterF
|
||||
$ _lstate_commentsPrior state
|
||||
, _lstate_commentsPost = Map.filterWithKey filterF
|
||||
$ _lstate_commentsPost state
|
||||
}
|
||||
, _layouter_ast = x
|
||||
}
|
||||
|
||||
briDocByExact :: (ExactPrint.Annotate.Annotate ast,
|
||||
MonadMultiReader Config m,
|
||||
MonadMultiReader ExactPrint.Types.Anns m
|
||||
) => GenLocated SrcSpan ast -> m BriDoc
|
||||
briDocByExact ast = do
|
||||
anns <- mAsk
|
||||
traceIfDumpConf "ast" _dconf_dump_ast_unknown
|
||||
(printTreeWithCustom 100 (customLayouterF anns) ast)
|
||||
return $ docExt ast anns
|
||||
|
||||
descToBlockStart :: LayoutDesc -> Maybe BlockStart
|
||||
descToBlockStart (LayoutDesc _ (Just (BlockDesc bs _ _ _))) = Just bs
|
||||
descToBlockStart (LayoutDesc (Just line) _) = Just $ RestOfLine line
|
||||
descToBlockStart _ = Nothing
|
||||
|
||||
descToBlockMinMax :: LayoutDesc -> Maybe (Int, Int)
|
||||
descToBlockMinMax (LayoutDesc _ (Just (BlockDesc _ bmin bmax _))) = Just (bmin, bmax)
|
||||
descToBlockMinMax _ = Nothing
|
||||
|
||||
descToMinMax :: Int -> LayoutDesc -> Maybe (Int, Int)
|
||||
descToMinMax p (LayoutDesc _ (Just (BlockDesc start bmin bmax _))) =
|
||||
Just (max rolMin bmin, max rolMin bmax)
|
||||
where
|
||||
rolMin = case start of
|
||||
RestOfLine rol -> p + _lColumns_min rol
|
||||
AllSameIndent -> 0
|
||||
|
||||
descToMinMax p (LayoutDesc (Just (LayoutColumns _ _ lmin)) _) =
|
||||
Just (len, len)
|
||||
where
|
||||
len = p + lmin
|
||||
descToMinMax _ _ =
|
||||
Nothing
|
||||
|
||||
rdrNameToText :: RdrName -> Text
|
||||
-- rdrNameToText = Text.pack . show . flip runSDoc unsafeGlobalDynFlags . ppr
|
||||
rdrNameToText ( Unqual occname ) = Text.pack $ occNameString occname
|
||||
rdrNameToText ( Qual mname occname ) = Text.pack $ moduleNameString mname
|
||||
++ "."
|
||||
++ occNameString occname
|
||||
rdrNameToText ( Orig modul occname ) = Text.pack $ moduleNameString (moduleName modul)
|
||||
++ occNameString occname
|
||||
rdrNameToText ( Exact name ) = Text.pack $ getOccString name
|
||||
|
||||
lrdrNameToText :: GenLocated l RdrName -> Text
|
||||
lrdrNameToText (L _ n) = rdrNameToText n
|
||||
|
||||
lrdrNameToTextAnn :: ( MonadMultiReader Config m
|
||||
, MonadMultiReader (Map AnnKey Annotation) m
|
||||
)
|
||||
=> GenLocated SrcSpan RdrName
|
||||
-> m Text
|
||||
lrdrNameToTextAnn ast@(L _ n) = do
|
||||
anns <- mAsk
|
||||
let t = rdrNameToText n
|
||||
let hasUni x (ExactPrint.Types.G y, _) = x==y
|
||||
hasUni _ _ = False
|
||||
-- TODO: in general: we should _always_ process all annotaiton stuff here.
|
||||
-- whatever we don't probably should have had some effect on the
|
||||
-- output. in such cases, resorting to byExact is probably the safe
|
||||
-- choice.
|
||||
return $ case Map.lookup (ExactPrint.Types.mkAnnKey ast) anns of
|
||||
Nothing -> traceShow "Nothing" t
|
||||
Just (ExactPrint.Types.Ann _ _ _ aks _ _) -> if
|
||||
| any (hasUni AnnBackquote) aks -> Text.pack "`" <> t <> Text.pack "`"
|
||||
| any (hasUni AnnOpenP) aks -> Text.pack "(" <> t <> Text.pack ")"
|
||||
| otherwise -> t
|
||||
|
||||
|
||||
askIndent :: (MonadMultiReader Config m) => m Int
|
||||
askIndent = runIdentity . _lconfig_indentAmount . _conf_layout <$> mAsk
|
||||
|
||||
-- minimum block width, judged from block info or line, whichever is
|
||||
-- available.
|
||||
-- example: calcLayoutMin doBlock ~~~ atomically $ do
|
||||
-- foo
|
||||
-- ## indent
|
||||
-- ############# linepre
|
||||
-- ############### result (in this case)
|
||||
calcLayoutMin :: Int -- basic indentation amount
|
||||
-> Int -- currently used width in current line (after indent)
|
||||
-- used to accurately calc placing of the current-line
|
||||
-- stuff ("do" in the above example) and its width.
|
||||
-> LayoutDesc
|
||||
-> Int
|
||||
calcLayoutMin indent linePre (LayoutDesc line block) = case (line, block) of
|
||||
(_, Just (BlockDesc AllSameIndent m _ _)) -> indent + m
|
||||
(_, Just (BlockDesc (RestOfLine inl) m _ _)) -> max (linePre + _lColumns_min inl) (indent + m)
|
||||
(Just s, _) -> indent + _lColumns_min s
|
||||
_ -> error "bad LayoutDesc mnasdoiucxvlkjasd"
|
||||
|
||||
-- see
|
||||
calcLayoutMax :: Int -- basic indentation amount
|
||||
-> Int -- currently used width in current line (after indent)
|
||||
-- used to accurately calc placing of the current-line
|
||||
-- stuff ("do" in the above example) and its width.
|
||||
-> LayoutDesc
|
||||
-> Int
|
||||
calcLayoutMax indent linePre (LayoutDesc line block) = case (line, block) of
|
||||
(Just s, _) -> linePre + _lColumns_min s
|
||||
(_, Just (BlockDesc AllSameIndent _ m _)) -> indent + m
|
||||
(_, Just (BlockDesc (RestOfLine inl) _ m _)) -> max (linePre + _lColumns_min inl) (indent + m)
|
||||
_ -> error "bad LayoutDesc msdnfgouvadnfoiu"
|
||||
|
||||
getCurRemaining :: ( MonadMultiReader Config m
|
||||
, MonadMultiState LayoutState m
|
||||
)
|
||||
=> m Int
|
||||
getCurRemaining = do
|
||||
cols <- mAsk <&> _conf_layout .> _lconfig_cols .> runIdentity
|
||||
clc <- _lstate_curLineCols <$> mGet
|
||||
return $ cols - clc
|
||||
|
||||
layoutWriteAppend :: (MonadMultiWriter
|
||||
Text.Builder.Builder m,
|
||||
MonadMultiState LayoutState m)
|
||||
=> Text
|
||||
-> m ()
|
||||
layoutWriteAppend t = do
|
||||
state <- mGet
|
||||
if _lstate_addSepSpace state
|
||||
then do
|
||||
mSet $ state { _lstate_curLineCols = _lstate_curLineCols state + Text.length t + 1
|
||||
, _lstate_addSepSpace = False
|
||||
}
|
||||
mTell $ Text.Builder.fromText $ Text.pack " " <> t
|
||||
else do
|
||||
mSet $ state { _lstate_curLineCols = _lstate_curLineCols state + Text.length t }
|
||||
mTell $ Text.Builder.fromText t
|
||||
|
||||
layoutWriteAppendMultiline :: (MonadMultiWriter
|
||||
Text.Builder.Builder m,
|
||||
MonadMultiState LayoutState m)
|
||||
=> Text
|
||||
-> m ()
|
||||
layoutWriteAppendMultiline t = case Text.lines t of
|
||||
[] -> return ()
|
||||
(l:lr) -> do
|
||||
layoutWriteAppend l
|
||||
lr `forM_` \x -> do
|
||||
layoutWriteNewlinePlain
|
||||
layoutWriteAppend x
|
||||
|
||||
-- adds a newline and adds spaces to reach the current indentation level.
|
||||
-- TODO: rename newline -> newlineBlock and newlinePlain -> newline
|
||||
layoutWriteNewline :: (MonadMultiWriter
|
||||
Text.Builder.Builder m,
|
||||
MonadMultiState LayoutState m)
|
||||
=> m ()
|
||||
layoutWriteNewline = do
|
||||
state <- mGet
|
||||
mSet $ state { _lstate_curLineCols = _lstate_indent state
|
||||
, _lstate_commentCol = Nothing
|
||||
, _lstate_addSepSpace = False
|
||||
}
|
||||
mTell $ Text.Builder.fromString $ "\n" ++ replicate (_lstate_indent state) ' '
|
||||
|
||||
-- | does _not_ add spaces to again reach the current indentation levels.
|
||||
layoutWriteNewlinePlain :: (MonadMultiWriter
|
||||
Text.Builder.Builder m,
|
||||
MonadMultiState LayoutState m)
|
||||
=> m ()
|
||||
layoutWriteNewlinePlain = do
|
||||
state <- mGet
|
||||
mSet $ state { _lstate_curLineCols = 0
|
||||
, _lstate_commentCol = Nothing
|
||||
, _lstate_addSepSpace = False
|
||||
}
|
||||
mTell $ Text.Builder.fromString $ "\n"
|
||||
|
||||
layoutWriteEnsureNewline :: (MonadMultiWriter
|
||||
Text.Builder.Builder m,
|
||||
MonadMultiState LayoutState m)
|
||||
=> m ()
|
||||
layoutWriteEnsureNewline = do
|
||||
state <- mGet
|
||||
when (_lstate_curLineCols state /= _lstate_indent state)
|
||||
$ layoutWriteNewline
|
||||
|
||||
layoutWriteEnsureBlock :: (MonadMultiWriter
|
||||
Text.Builder.Builder m,
|
||||
MonadMultiState LayoutState m)
|
||||
=> m ()
|
||||
layoutWriteEnsureBlock = do
|
||||
state <- mGet
|
||||
let diff = _lstate_curLineCols state - _lstate_indent state
|
||||
if diff>0
|
||||
then layoutWriteNewline
|
||||
else if diff<0
|
||||
then do
|
||||
layoutWriteAppend $ Text.pack $ replicate (negate diff) ' '
|
||||
mSet $ state { _lstate_curLineCols = _lstate_indent state
|
||||
, _lstate_addSepSpace = False
|
||||
}
|
||||
else return ()
|
||||
|
||||
layoutWriteEnsureAbsoluteN :: (MonadMultiWriter
|
||||
Text.Builder.Builder m,
|
||||
MonadMultiState LayoutState m)
|
||||
=> Int -> m ()
|
||||
layoutWriteEnsureAbsoluteN n = do
|
||||
state <- mGet
|
||||
let diff = n - _lstate_curLineCols state
|
||||
if diff>0
|
||||
then do
|
||||
layoutWriteAppend $ Text.pack $ replicate diff ' '
|
||||
mSet $ state { _lstate_curLineCols = n
|
||||
, _lstate_addSepSpace = False
|
||||
}
|
||||
else return ()
|
||||
|
||||
layoutWriteEnsureBlockPlusN :: (MonadMultiWriter
|
||||
Text.Builder.Builder m,
|
||||
MonadMultiState LayoutState m)
|
||||
=> Int -> m ()
|
||||
layoutWriteEnsureBlockPlusN n = do
|
||||
state <- mGet
|
||||
let diff = _lstate_curLineCols state - _lstate_indent state - n
|
||||
if diff>0
|
||||
then layoutWriteNewline
|
||||
else if diff<0
|
||||
then do
|
||||
layoutWriteAppend $ Text.pack $ replicate (negate diff) ' '
|
||||
mSet $ state { _lstate_addSepSpace = False }
|
||||
else return ()
|
||||
|
||||
layoutWithAddIndent :: (MonadMultiWriter
|
||||
Text.Builder.Builder m,
|
||||
MonadMultiState LayoutState m
|
||||
,MonadMultiReader Config m)
|
||||
=> m ()
|
||||
-> m ()
|
||||
layoutWithAddIndent m = do
|
||||
amount <- mAsk <&> _conf_layout .> _lconfig_indentAmount .> runIdentity
|
||||
state <- mGet
|
||||
mSet state { _lstate_indent = _lstate_indent state + amount }
|
||||
m
|
||||
do
|
||||
s <- mGet
|
||||
mSet $ s { _lstate_indent = _lstate_indent state }
|
||||
|
||||
layoutWithAddIndentBlock :: (MonadMultiWriter
|
||||
Text.Builder.Builder m,
|
||||
MonadMultiState LayoutState m
|
||||
,MonadMultiReader Config m)
|
||||
=> m ()
|
||||
-> m ()
|
||||
layoutWithAddIndentBlock m = do
|
||||
amount <- mAsk <&> _conf_layout .> _lconfig_indentAmount .> runIdentity
|
||||
state <- mGet
|
||||
mSet state { _lstate_indent = _lstate_indent state + amount }
|
||||
layoutWriteEnsureBlock
|
||||
m
|
||||
do
|
||||
s <- mGet
|
||||
mSet $ s { _lstate_indent = _lstate_indent state }
|
||||
|
||||
layoutWithAddIndentNBlock :: (MonadMultiWriter
|
||||
Text.Builder.Builder m,
|
||||
MonadMultiState LayoutState m)
|
||||
=> Int
|
||||
-> m ()
|
||||
-> m ()
|
||||
layoutWithAddIndentNBlock amount m = do
|
||||
state <- mGet
|
||||
mSet state { _lstate_indent = _lstate_indent state + amount }
|
||||
layoutWriteEnsureBlock
|
||||
m
|
||||
do
|
||||
s <- mGet
|
||||
mSet $ s { _lstate_indent = _lstate_indent state }
|
||||
|
||||
layoutWithAddIndentN :: (MonadMultiWriter
|
||||
Text.Builder.Builder m,
|
||||
MonadMultiState LayoutState m)
|
||||
=> Int
|
||||
-> m ()
|
||||
-> m ()
|
||||
layoutWithAddIndentN amount m = do
|
||||
state <- mGet
|
||||
mSet state { _lstate_indent = _lstate_indent state + amount }
|
||||
m
|
||||
do
|
||||
s <- mGet
|
||||
mSet $ s { _lstate_indent = _lstate_indent state }
|
||||
|
||||
layoutAddSepSpace :: MonadMultiState LayoutState m => m ()
|
||||
layoutAddSepSpace = do
|
||||
state <- mGet
|
||||
mSet $ state { _lstate_addSepSpace = True }
|
||||
|
||||
moveToExactAnn :: (Data.Data.Data x,
|
||||
MonadMultiWriter Text.Builder.Builder m,
|
||||
MonadMultiState LayoutState m,
|
||||
MonadMultiReader (Map AnnKey Annotation) m) => GenLocated SrcSpan x -> m ()
|
||||
moveToExactAnn ast = do
|
||||
anns <- mAsk
|
||||
case Map.lookup (ExactPrint.Types.mkAnnKey ast) anns of
|
||||
Nothing -> return ()
|
||||
Just ann -> do
|
||||
let ExactPrint.Types.DP (x, _y) = ExactPrint.Types.annEntryDelta ann
|
||||
replicateM_ x $ layoutWriteNewline
|
||||
|
||||
-- TODO: when refactoring is complete, the other version of this method
|
||||
-- can probably be removed.
|
||||
moveToExactAnn' :: (MonadMultiWriter Text.Builder.Builder m,
|
||||
MonadMultiState LayoutState m,
|
||||
MonadMultiReader (Map AnnKey Annotation) m) => AnnKey -> m ()
|
||||
moveToExactAnn' annKey = do
|
||||
anns <- mAsk
|
||||
case Map.lookup annKey anns of
|
||||
Nothing -> return ()
|
||||
Just ann -> do
|
||||
-- curY <- mGet <&> _lstate_curLineCols
|
||||
let ExactPrint.Types.DP (x, _y) = ExactPrint.Types.annEntryDelta ann
|
||||
replicateM_ x $ layoutWriteNewline
|
||||
-- when (x/=0) $ do
|
||||
-- replicateM_ x $ layoutWriteNewlinePlain
|
||||
-- mModify $ \s -> s { _lstate_curLineCols = curY }
|
||||
-- mTell $ Text.Builder.fromString $ replicate curY ' '
|
||||
|
||||
ppmMoveToExactLoc :: MonadMultiWriter Text.Builder.Builder m
|
||||
=> ExactPrint.Types.DeltaPos
|
||||
-> m ()
|
||||
ppmMoveToExactLoc (ExactPrint.Types.DP (x,y)) = do
|
||||
replicateM_ x $ mTell $ Text.Builder.fromString "\n"
|
||||
replicateM_ y $ mTell $ Text.Builder.fromString " "
|
||||
|
||||
layoutWithNonParamIndent :: (MonadMultiWriter
|
||||
Text.Builder.Builder m,
|
||||
MonadMultiState LayoutState m)
|
||||
=> LayoutFuncParams -> m () -> m ()
|
||||
layoutWithNonParamIndent params m = do
|
||||
case _params_opIndent params of
|
||||
Nothing -> m
|
||||
Just x -> layoutWithAddIndentN x m
|
||||
|
||||
setOpIndent :: Int -> LayoutDesc -> LayoutFuncParams -> LayoutFuncParams
|
||||
setOpIndent i desc p = p
|
||||
{ _params_opIndent = Just $ case _bdesc_opIndentFloatUp =<< _ldesc_block desc of
|
||||
Nothing -> i
|
||||
Just j -> max i j
|
||||
}
|
||||
|
||||
stringLayouter :: Data.Data.Data ast
|
||||
=> GenLocated SrcSpan ast -> Text -> Layouter
|
||||
stringLayouter ast t = Layouter
|
||||
{ _layouter_desc = LayoutDesc
|
||||
{ _ldesc_line = Just $ LayoutColumns
|
||||
{ _lColumns_key = ColumnKeyUnique
|
||||
, _lColumns_lengths = [Text.length t]
|
||||
, _lColumns_min = Text.length t
|
||||
}
|
||||
, _ldesc_block = Nothing
|
||||
}
|
||||
, _layouter_func = \_ -> do
|
||||
layoutWritePriorCommentsRestore ast
|
||||
layoutWriteAppend t
|
||||
layoutWritePostComments ast
|
||||
, _layouter_ast = ast
|
||||
}
|
||||
|
||||
layoutWritePriorComments :: (Data.Data.Data ast,
|
||||
MonadMultiWriter Text.Builder.Builder m,
|
||||
MonadMultiState LayoutState m)
|
||||
=> GenLocated SrcSpan ast -> m ()
|
||||
layoutWritePriorComments ast = do
|
||||
mAnn <- do
|
||||
state <- mGet
|
||||
let key = ExactPrint.Types.mkAnnKey ast
|
||||
let m = _lstate_commentsPrior state
|
||||
let mAnn = Map.lookup key m
|
||||
mSet $ state { _lstate_commentsPrior = Map.delete key m }
|
||||
return mAnn
|
||||
case mAnn of
|
||||
Nothing -> return ()
|
||||
Just priors -> do
|
||||
when (not $ null priors) $ do
|
||||
state <- mGet
|
||||
mSet $ state { _lstate_commentCol = Just $ _lstate_curLineCols state }
|
||||
priors `forM_` \( ExactPrint.Types.Comment comment _ _
|
||||
, ExactPrint.Types.DP (x, y)
|
||||
) -> do
|
||||
replicateM_ x layoutWriteNewlinePlain
|
||||
layoutWriteAppend $ Text.pack $ replicate y ' '
|
||||
layoutWriteAppendMultiline $ Text.pack $ comment
|
||||
|
||||
-- this currently only extracs from the `annsDP` field of Annotations.
|
||||
-- per documentation, this seems sufficient, as the
|
||||
-- "..`annFollowingComments` are only added by AST transformations ..".
|
||||
layoutWritePostComments :: (Data.Data.Data ast,
|
||||
MonadMultiWriter Text.Builder.Builder m,
|
||||
MonadMultiState LayoutState m)
|
||||
=> GenLocated SrcSpan ast -> m ()
|
||||
layoutWritePostComments ast = do
|
||||
mAnn <- do
|
||||
state <- mGet
|
||||
let key = ExactPrint.Types.mkAnnKey ast
|
||||
let m = _lstate_commentsPost state
|
||||
let mAnn = Map.lookup key m
|
||||
mSet $ state { _lstate_commentsPost = Map.delete key m }
|
||||
return mAnn
|
||||
case mAnn of
|
||||
Nothing -> return ()
|
||||
Just posts -> do
|
||||
when (not $ null posts) $ do
|
||||
state <- mGet
|
||||
mSet $ state { _lstate_commentCol = Just $ _lstate_curLineCols state }
|
||||
posts `forM_` \( ExactPrint.Types.Comment comment _ _
|
||||
, ExactPrint.Types.DP (x, y)
|
||||
) -> do
|
||||
replicateM_ x layoutWriteNewlinePlain
|
||||
layoutWriteAppend $ Text.pack $ replicate y ' '
|
||||
layoutWriteAppendMultiline $ Text.pack $ comment
|
||||
|
||||
layoutIndentRestorePostComment :: ( Monad m
|
||||
, MonadMultiState LayoutState m
|
||||
, MonadMultiWriter Text.Builder.Builder m
|
||||
)
|
||||
=> m ()
|
||||
layoutIndentRestorePostComment = do
|
||||
mCommentCol <- _lstate_commentCol <$> mGet
|
||||
case mCommentCol of
|
||||
Nothing -> return ()
|
||||
Just commentCol -> do
|
||||
layoutWriteNewlinePlain
|
||||
layoutWriteAppend $ Text.pack $ replicate commentCol ' '
|
||||
|
||||
layoutWritePriorCommentsRestore :: (Data.Data.Data ast,
|
||||
MonadMultiWriter Text.Builder.Builder m,
|
||||
MonadMultiState LayoutState m)
|
||||
=> GenLocated SrcSpan ast -> m ()
|
||||
layoutWritePriorCommentsRestore x = do
|
||||
layoutWritePriorComments x
|
||||
layoutIndentRestorePostComment
|
||||
|
||||
layoutWritePostCommentsRestore :: (Data.Data.Data ast,
|
||||
MonadMultiWriter Text.Builder.Builder m,
|
||||
MonadMultiState LayoutState m)
|
||||
=> GenLocated SrcSpan ast -> m ()
|
||||
layoutWritePostCommentsRestore x = do
|
||||
layoutWritePostComments x
|
||||
layoutIndentRestorePostComment
|
||||
|
||||
extractCommentsPrior :: ExactPrint.Types.Anns -> PriorMap
|
||||
extractCommentsPrior anns = flip Map.mapMaybe anns $ \ann ->
|
||||
[r | let r = ExactPrint.Types.annPriorComments ann, not (null r)]
|
||||
extractCommentsPost :: ExactPrint.Types.Anns -> PostMap
|
||||
extractCommentsPost anns = flip Map.mapMaybe anns $ \ann ->
|
||||
[r
|
||||
| let
|
||||
r = ExactPrint.Types.annsDP ann
|
||||
>>= \case
|
||||
(ExactPrint.Types.AnnComment comment, dp) -> [(comment, dp)]
|
||||
_ -> []
|
||||
, not (null r)
|
||||
]
|
||||
|
||||
|
||||
applyLayouter :: Layouter -> LayoutFuncParams -> LayoutM ()
|
||||
applyLayouter l@(Layouter _ _ ast) params = do
|
||||
-- (always) write the prior comments at this point.
|
||||
layoutWritePriorCommentsRestore ast
|
||||
-- run the real stuff.
|
||||
_layouter_func l params
|
||||
-- if the _layouter_func has not done so already at some point
|
||||
-- (there are nodes for which this makes sense),
|
||||
-- write the post comments.
|
||||
-- effect is `return ()` if there are no postComments.
|
||||
layoutWritePostComments ast
|
||||
|
||||
applyLayouterRestore :: Layouter -> LayoutFuncParams -> LayoutM ()
|
||||
applyLayouterRestore l@(Layouter _ _ ast) params = do
|
||||
-- (always) write the prior comments at this point.
|
||||
layoutWritePriorCommentsRestore ast
|
||||
-- run the real stuff.
|
||||
_layouter_func l params
|
||||
-- if the _layouter_func has not done so already at some point
|
||||
-- (there are nodes for which this makes sense),
|
||||
-- write the post comments.
|
||||
-- effect is `return ()` if there are no postComments.
|
||||
layoutWritePostCommentsRestore ast
|
||||
|
||||
foldedAnnKeys :: Data.Data.Data ast
|
||||
=> ast
|
||||
-> Set ExactPrint.Types.AnnKey
|
||||
foldedAnnKeys ast = everything
|
||||
Set.union
|
||||
(\x -> maybe
|
||||
Set.empty
|
||||
Set.singleton
|
||||
[ gmapQi 1 (\t -> ExactPrint.Types.mkAnnKey $ L l t) x
|
||||
| typeRepTyCon (typeOf (L () ())) == (typeRepTyCon (typeOf x))
|
||||
, l <- gmapQi 0 cast x
|
||||
]
|
||||
)
|
||||
ast
|
||||
|
||||
filterAnns :: Data.Data.Data ast
|
||||
=> ast
|
||||
-> ExactPrint.Types.Anns
|
||||
-> ExactPrint.Types.Anns
|
||||
filterAnns ast anns =
|
||||
Map.filterWithKey (\k _ -> k `Set.member` foldedAnnKeys ast) anns
|
||||
|
||||
layouterFToLayouterM :: MultiReader '[Config, ExactPrint.Types.Anns] a -> LayoutM a
|
||||
layouterFToLayouterM m = do
|
||||
settings <- mAsk
|
||||
anns <- mAsk
|
||||
return $ runIdentity
|
||||
$ runMultiReaderTNil
|
||||
$ Control.Monad.Trans.MultiReader.Lazy.withMultiReader anns
|
||||
$ Control.Monad.Trans.MultiReader.Lazy.withMultiReader settings
|
||||
$ m
|
||||
|
||||
-- new BriDoc stuff
|
||||
|
||||
docEmpty :: BriDoc
|
||||
docEmpty = BDEmpty
|
||||
|
||||
docLit :: Text -> BriDoc
|
||||
docLit t = BDLit t
|
||||
|
||||
docExt :: ExactPrint.Annotate.Annotate ast
|
||||
=> GenLocated SrcSpan ast -> ExactPrint.Types.Anns -> BriDoc
|
||||
docExt x anns = BDExternal
|
||||
(ExactPrint.Types.mkAnnKey x)
|
||||
(foldedAnnKeys x)
|
||||
(Text.pack $ ExactPrint.exactPrint x anns)
|
||||
|
||||
docAlt :: [BriDoc] -> BriDoc
|
||||
docAlt = BDAlt
|
||||
|
||||
|
||||
docSeq :: [BriDoc] -> BriDoc
|
||||
docSeq = BDSeq
|
||||
|
||||
|
||||
docPostComment :: Data.Data.Data ast
|
||||
=> GenLocated SrcSpan ast
|
||||
-> BriDoc
|
||||
-> BriDoc
|
||||
docPostComment ast bd = BDAnnotationPost (ExactPrint.Types.mkAnnKey ast) bd
|
||||
|
||||
docWrapNode :: Data.Data.Data ast
|
||||
=> GenLocated SrcSpan ast
|
||||
-> BriDoc
|
||||
-> BriDoc
|
||||
docWrapNode ast bd = BDAnnotationPrior (ExactPrint.Types.mkAnnKey ast)
|
||||
$ BDAnnotationPost (ExactPrint.Types.mkAnnKey ast)
|
||||
$ bd
|
||||
|
||||
docPar :: BriDoc
|
||||
-> BriDoc
|
||||
-> BriDoc
|
||||
docPar line indented = BDPar BrIndentNone line indented
|
||||
|
||||
-- docPar :: BriDoc
|
||||
-- -> BrIndent
|
||||
-- -> [BriDoc]
|
||||
-- -> BriDoc
|
||||
-- docPar = BDPar
|
||||
|
||||
-- docCols :: ColSig
|
||||
-- -> [BriDoc]
|
||||
-- -> BriDoc
|
||||
-- docCols = BDCols
|
||||
|
||||
|
||||
fromMaybeIdentity :: Identity a -> Maybe a -> Identity a
|
||||
fromMaybeIdentity x y = Data.Coerce.coerce
|
||||
$ fromMaybe (Data.Coerce.coerce x) y
|
||||
|
|
@ -1,36 +0,0 @@
|
|||
#!/bin/bash
|
||||
|
||||
# set -x
|
||||
set -e
|
||||
|
||||
rm report.txt &> /dev/null || true
|
||||
|
||||
mkdir iterOne &> /dev/null || true
|
||||
mkdir iterTwo &> /dev/null || true
|
||||
|
||||
for FILE in ./cases/*
|
||||
do
|
||||
NAME=$(basename "$FILE")
|
||||
ITERNAMEONE="./iterOne/$NAME"
|
||||
ITERNAMETWO="./iterTwo/$NAME"
|
||||
if ! ./brittany -i "$FILE" -o "$ITERNAMEONE"
|
||||
then
|
||||
echo "FAILED step 1 for $FILE" | tee -a report.txt
|
||||
continue
|
||||
fi
|
||||
if ! ./brittany -i "$ITERNAMEONE" -o "$ITERNAMETWO"
|
||||
then
|
||||
echo "FAILED step 2 for $FILE" | tee -a report.txt
|
||||
continue
|
||||
fi
|
||||
if ! diff "$ITERNAMEONE" "$ITERNAMETWO" > diff.temp
|
||||
then
|
||||
echo "FAILED diff for $FILE with diff:" | tee -a report.txt
|
||||
cat diff.temp | tee -a report.txt
|
||||
echo "# meld $(realpath $ITERNAMEONE) $(realpath $ITERNAMETWO)" | tee -a report.txt
|
||||
continue
|
||||
fi
|
||||
echo "success for $FILE" | tee -a report.txt
|
||||
done
|
||||
|
||||
rm diff.temp &> /dev/null || true
|
||||
Loading…
Reference in New Issue