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

Split up littests input into multiple files 

*.blt instead of just tests.blt

yay for unix-style for ordering the inputs "15-regression.blt"
pull/60/head
Lennart Spitzner 2017-10-02 20:50:51 +02:00
parent bb40870f81
commit a0112524aa
5 changed files with 509 additions and 507 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
brittany.cabal
View File

@ -24,7 +24,7 @@ extra-doc-files: {
doc/implementation/*.md doc/implementation/*.md
} }
extra-source-files: { extra-source-files: {
src-literatetests/tests.blt src-literatetests/*.blt
} }
source-repository head { source-repository head {
@ -330,6 +330,7 @@ test-suite littests
, czipwith , czipwith
, ghc-boot-th , ghc-boot-th
, hspec >=2.4.1 && <2.5 , hspec >=2.4.1 && <2.5
, filepath
, parsec >=3.1.11 && <3.2 , parsec >=3.1.11 && <3.2
} }
ghc-options: -Wall ghc-options: -Wall

504
src-literatetests/tests.blt → src-literatetests/10-tests.blt
View File

@ -589,507 +589,3 @@ func =
] ]
++ [ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc] ++ [ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc]
###############################################################################
###############################################################################
###############################################################################
#group regression
###############################################################################
###############################################################################
###############################################################################
#test newlines-comment
func = do
abc <- foo
--abc
return ()
#test parenthesis-around-unit
func = (())
#test let-defs indentation
func = do
let foo True = True
foo _ = False
return ()
#test record update indentation 1
func = do
s <- mGet
mSet $ s { _lstate_indent = _lstate_indent state }
#test record update indentation 2
func = do
s <- mGet
mSet $ s { _lstate_indent = _lstate_indent state
, _lstate_indent = _lstate_indent state
}
#test record update indentation 3
func = do
s <- mGet
mSet $ s
{ _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
, _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
}
#test post-indent comment
func = do
-- abc
-- def
return ()
#test post-unindent comment
func = do
do
return ()
-- abc
-- def
return ()
#test CPP empty comment case
#pending CPP parsing needs fixing for roundTripEqual
{-# LANGUAGE CPP #-}
module Test where
func = do
#if FOO
let x = 13
#endif
stmt x
## really, the following should be handled by forcing the Alt to multiline
## because there are comments. as long as this is not implemented though,
## we should ensure the trivial solution works.
#test comment inline placement (temporary)
func
:: Int -- basic indentation amount
-> Int -- currently used width in current line (after indent)
-- used to accurately calc placing of the current-line
-> LayoutDesc
-> Int
#test some indentation thingy
func =
( lkjadljasldjalskdjaldjalsdjkalsdjlaksdjlasjdlajsaldskj
$ abc
$ def
$ ghi
$ jkl
)
#test parenthesized operator
buildG bounds0 edges0 = accumArray (flip (:)) [] bounds0 (map reassoc edges0)
where reassoc (v, e, w) = (v, (e, w))
#test record pattern matching stuff
downloadRepoPackage = case repo of
RepoLocal {..} -> return ()
RepoLocal { abc } -> return ()
RepoLocal{} -> return ()
#test do let comment indentation level problem
func = do
let (primaryPkg, otherPkgs) = selectPrimaryLocalPackage pwd pkgs'
(bproblems, x) = resolveBuildTargets primaryPkg otherPkgs utargets''
-- default local dir target if there's no given target
utargets'' = "foo"
return ()
#test list comprehension comment placement
func =
[ (thing, take 10 alts) --TODO: select best ones
| (thing, _got, alts@(_:_)) <- nosuchFooThing
, gast <- award
]
#test if-then-else comment placement
func = if x
then if y -- y is important
then foo
else bar
else Nothing
#test qualified infix pattern
#pending "TODO"
wrapPatPrepend pat prepElem = do
patDocs <- layoutPat pat
case Seq.viewl patDocs of
Seq.EmptyL -> return $ Seq.empty
x1 Seq.:< xR -> do
x1' <- docSeq [prepElem, return x1]
return $ x1' Seq.<| xR
#test type signature multiline forcing issue
layoutWriteNewlineBlock
:: ( MonadMultiWriter Text.Builder.Builder m
, MonadMultiState LayoutState m
, MonadMultiWriter (Seq String) m
)
=> m ()
#test multiwayif proper indentation
{-# LANGUAGE MultiWayIf #-}
readMergePersConfig path shouldCreate conf = do
exists <- liftIO $ System.Directory.doesFileExist path
if
| exists -> do
contents <- liftIO $ ByteString.readFile path -- no lazy IO, tyvm.
fileConf <- case Data.Yaml.decodeEither contents of
Left e -> do
liftIO
$ putStrErrLn
$ "error reading in brittany config from "
++ path
++ ":"
liftIO $ putStrErrLn e
mzero
Right x -> return x
return $ fileConf Semigroup.<> conf
| shouldCreate -> do
liftIO $ ByteString.writeFile path $ Data.Yaml.encode $ cMap
(Option . Just . runIdentity)
staticDefaultConfig
return $ conf
| otherwise -> do
return conf
#test nested pattern alignment issue"
func = BuildReport
where
convertInstallOutcome = case result of
Left BR.PlanningFailed -> PlanningFailed
Left (BR.DependentFailed p) -> DependencyFailed p
Left (BR.DownloadFailed _) -> DownloadFailed
Left (BR.UnpackFailed _) -> UnpackFailed
Left (BR.ConfigureFailed _) -> ConfigureFailed
Left (BR.BuildFailed _) -> BuildFailed
Left (BR.TestsFailed _) -> TestsFailed
Left (BR.InstallFailed _) -> InstallFailed
Right (BR.BuildOk _ _ _ ) -> InstallOk
#test nested pattern alignment issue"
func = BuildReport
where
convertInstallOutcome = case result of
Left BR.PlanningFailed -> PlanningFailed
Left (BR.DependentFailed p) -> DependencyFailed p
Left (BR.DownloadFailed _) -> DownloadFailed
Left (BR.UnpackFailed _) -> UnpackFailed
Left (BR.ConfigureFailed _) -> ConfigureFailed
Left (BR.BuildFailed _) -> BuildFailed
Left (BR.TestsFailed _) -> TestsFailed
Left (BR.InstallFailed _) -> InstallFailed
Right (BR.BuildOk _ _ _ ) -> InstallOk
#test partially overflowing alignment issue"
showPackageDetailedInfo pkginfo =
renderStyle (style { lineLength = 80, ribbonsPerLine = 1 })
$ char '*'
$+$ something
[ entry "Synopsis" synopsis hideIfNull reflowParagraphs
, entry "Versions available"
sourceVersions
(altText null "[ Not available from server ]")
(dispTopVersions 9 (preferredVersions pkginfo))
, entry
"Versions installed"
installedVersions
( altText
null
(if hasLib pkginfo then "[ Not installed ]" else "[ Unknown ]")
)
(dispTopVersions 4 (preferredVersions pkginfo))
, entry "Homepage" homepage orNotSpecified text
, entry "Bug reports" bugReports orNotSpecified text
, entry "Description" description hideIfNull reflowParagraphs
, entry "Category" category hideIfNull text
, entry "License" license alwaysShow disp
, entry "Author" author hideIfNull reflowLines
, entry "Maintainer" maintainer hideIfNull reflowLines
, entry "Source repo" sourceRepo orNotSpecified text
, entry "Executables" executables hideIfNull (commaSep text)
, entry "Flags" flags hideIfNull (commaSep dispFlag)
, entry "Dependencies" dependencies hideIfNull (commaSep dispExtDep)
, entry "Documentation" haddockHtml showIfInstalled text
, entry "Cached" haveTarball alwaysShow dispYesNo
, if not (hasLib pkginfo)
then empty
else text "Modules:"
$+$ nest 4 (vcat (map disp . sort . modules $ pkginfo))
]
#test issue 7a
isValidPosition position | validX && validY = Just position
| otherwise = Nothing
#test issue-6-pattern-linebreak-validity
## this is ugly, but at least syntactically valid.
foo = Reflex.runSpiderHost $ ReflexHost.hostApp $ do
(inputEvent :: Reflex.Event Reflex.Spider String, inputFire :: String
-> IO Bool ) <-
ReflexHost.newExternalEvent
liftIO . forkIO . forever $ getLine >>= inputFire
ReflexHost.performEvent_ $ fmap (liftIO . putStrLn) inputEvent
#test issue 16
foldrDesc f z = unSwitchQueue $ \q ->
switch (Min.foldrDesc (f unTaggedF) z q) (Min.foldrAsc (f unTaggedF) z q)
#test issue 18
autocheckCases =
[ ("Never Deadlocks" , representative deadlocksNever)
, ("No Exceptions" , representative exceptionsNever)
, ("Consistent Result", alwaysSame) -- already representative
]
#test issue 18b
autocheckCases =
[ ("Never Deadlocks", representative deadlocksNever)
, ("No Exceptions" , representative exceptionsNever)
, ( "Consistent Result"
, alwaysSame -- already representative
)
]
#test issue 18c
func =
[ (abc, (1111, 1111))
, (def, (2, 2))
, foo -- comment
]
#test issue 26
foo a b = g a b -- fooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
where g a b = b + b * a
#test issue 26b
foo a b = g a b where g a b = b + b * a -- fooooooooooooooooooooooooooooooooooo
#test aggressive alignment 1
func = do
abc <- expr
abcccccccccccccccccc <- expr
abcccccccccccccccccccccccccccccccccccccccccc <- expr
abccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc <- expr
#test example alignment 1
func (MyLongFoo abc def) = 1
func (Bar a d ) = 2
func _ = 3
#test listcomprehension-case-of
parserCompactLocation =
[ try
$ [ ParseRelAbs (Text.Read.read digits) _ _
| digits <- many1 digit
, rel1 :: Maybe (Either Int (Ratio Int)) <- optionMaybe
[ case divPart of
Nothing -> Left $ Text.Read.read digits
Just ddigits ->
Right $ Text.Read.read digits % Text.Read.read ddigits
| digits <- many1 digit
, divPart <- optionMaybe (string "/" *> many1 digit)
]
]
]
#test opapp-specialcasing-1
func = fooooooooooooooooooooooooooooooooo $ foooooooooooooooooooooooooooooooo
foooooooooooooooooooooooooooooooo
foooooooooooooooooooooooooooooooo
#test opapp-specialcasing-2
func =
fooooooooooooooooooooooooooooooooo
+ foooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooo
foooooooooooooooooooooooooooooooo
#test opapp-specialcasing-3
func = fooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooo
[ foooooooooooooooooooooooooooooooo
, foooooooooooooooooooooooooooooooo
, foooooooooooooooooooooooooooooooo
]
#test opapp-indenting
parserPrim =
[ r
| r <-
[ SGPPrimFloat $ bool id (0-) minus $ readGnok "parserPrim"
(d1 ++ d2 ++ d3 ++ d4)
| d2 <- string "."
, d3 <- many1 (oneOf "0123456789")
, _ <- string "f"
]
<|> [ SGPPrimFloat $ bool id (0-) minus $ fromIntegral
(readGnok "parserPrim" d1 :: Integer)
| _ <- string "f"
]
<|> [ SGPPrimInt $ bool id (0-) minus $ fromIntegral
(readGnok "parserPrim" d1 :: Integer)
| _ <- string "i"
]
]
#test another-parspacing-testcase
samples = (SV.unpackaaaaadat) <&> \f ->
aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
#test recordupd-singleline-bug
runBrittany tabSize text = do
let
config' = staticDefaultConfig
config = config'
{ _conf_layout = (_conf_layout config') { _lconfig_indentAmount = coerce
tabSize
}
, _conf_forward = forwardOptionsSyntaxExtsEnabled
}
parsePrintModule config text
#test issue 38
{-# LANGUAGE TypeApplications #-}
foo = bar @Baz
#test comment-before-BDCols
{-# LANGUAGE TypeApplications #-}
layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do
docAlt
$ -- one-line solution
[ docCols
(ColBindingLine alignmentToken)
[ docSeq (patPartInline ++ [guardPart])
, docSeq
[ appSep $ return binderDoc
, docForceSingleline $ return body
, wherePart
]
]
| not hasComments
, [(guards, body, _bodyRaw)] <- [clauseDocs]
, let guardPart = singleLineGuardsDoc guards
, wherePart <- case mWhereDocs of
Nothing -> return @[] $ docEmpty
Just [w] -> return @[] $ docSeq
[ docSeparator
, appSep $ docLit $ Text.pack "where"
, docSetIndentLevel $ docForceSingleline $ return w
]
_ -> []
]
++ -- one-line solution + where in next line(s)
[ docLines
$ [ docCols
(ColBindingLine alignmentToken)
[ docSeq (patPartInline ++ [guardPart])
, docSeq
[appSep $ return binderDoc, docForceParSpacing $ return body]
]
]
++ wherePartMultiLine
| [(guards, body, _bodyRaw)] <- [clauseDocs]
, let guardPart = singleLineGuardsDoc guards
, Data.Maybe.isJust mWhereDocs
]
++ -- two-line solution + where in next line(s)
[ docLines
$ [ docForceSingleline
$ docSeq (patPartInline ++ [guardPart, return binderDoc])
, docEnsureIndent BrIndentRegular $ docForceSingleline $ return
body
]
++ wherePartMultiLine
| [(guards, body, _bodyRaw)] <- [clauseDocs]
, let guardPart = singleLineGuardsDoc guards
]
#test comment-testcase-17
{-# LANGUAGE MultiWayIf #-}
func = do
let foo = if
| Constuctoooooooooooooooooooooooooooooooooooor `elem` artics -- TODO
-> max
(defLen - 0.2) -- TODO
(defLen * 0.8)
| otherwise -> max (defLen - 0.05) (defLen * 0.95) -- TODO
return True
#test issue 49
foo n = case n of
1 -> True
-1 -> False
bar n = case n of
(-2, -2) -> (-2, -2)
#test issue 48 a
foo =
let a = b@1
cccc = ()
in foo
#test issue 48 b
{-# LANGUAGE TypeApplications #-}
foo =
let a = b @1
cccc = ()
in foo
#test issue 52 a
{-# LANGUAGE RecordWildCards #-}
v = A {a = 1, ..} where b = 2
#test issue 52 b
{-# LANGUAGE RecordWildCards #-}
v = A {..} where b = 2
#test issue 52 c
{-# LANGUAGE RecordWildCards #-}
v = A {a = 1, b = 2, c = 3}
###############################################################################
###############################################################################
###############################################################################
#group pending
###############################################################################
###############################################################################
###############################################################################
## this testcase is not about idempotency, but about _how_ the output differs
## from the input; i cannot really express this yet with the current
## test-suite.
## #test ayaz
##
## myManageHook =
## composeOne [isFullscreen -?> doFullFloat, isDialog -?> doFloat, transience]
## <+> composeAll
## [ className =? "Pidgin" --> doFloat
## , className =? "XCalc" --> doFloat
## -- plan9port's acme
## , className =? "acme" --> doFloat
## -- Acme with Vi bindings editor
## , title =? "ED" --> doFloat
## , title =? "wlc-x11" --> doFloat
## , className =? "Skype" --> doFloat
## , className =? "ffplay" --> doFloat
## , className =? "mpv" --> doFloat
## , className =? "Plugin-container" --> doFloat -- Firefox flash, etc.
## -- Firefox works well tiled, but it has dialog windows we want to float.
## , appName =? "Browser" --> doFloat
## ]
## where
## role = stringProperty "WM_WINDOW_ROLE"

467
src-literatetests/15-regressions.blt Normal file
View File

@ -0,0 +1,467 @@
###############################################################################
###############################################################################
###############################################################################
#group regression
###############################################################################
###############################################################################
###############################################################################
#test newlines-comment
func = do
abc <- foo
--abc
return ()
#test parenthesis-around-unit
func = (())
#test let-defs indentation
func = do
let foo True = True
foo _ = False
return ()
#test record update indentation 1
func = do
s <- mGet
mSet $ s { _lstate_indent = _lstate_indent state }
#test record update indentation 2
func = do
s <- mGet
mSet $ s { _lstate_indent = _lstate_indent state
, _lstate_indent = _lstate_indent state
}
#test record update indentation 3
func = do
s <- mGet
mSet $ s
{ _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
, _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
}
#test post-indent comment
func = do
-- abc
-- def
return ()
#test post-unindent comment
func = do
do
return ()
-- abc
-- def
return ()
#test CPP empty comment case
#pending CPP parsing needs fixing for roundTripEqual
{-# LANGUAGE CPP #-}
module Test where
func = do
#if FOO
let x = 13
#endif
stmt x
## really, the following should be handled by forcing the Alt to multiline
## because there are comments. as long as this is not implemented though,
## we should ensure the trivial solution works.
#test comment inline placement (temporary)
func
:: Int -- basic indentation amount
-> Int -- currently used width in current line (after indent)
-- used to accurately calc placing of the current-line
-> LayoutDesc
-> Int
#test some indentation thingy
func =
( lkjadljasldjalskdjaldjalsdjkalsdjlaksdjlasjdlajsaldskj
$ abc
$ def
$ ghi
$ jkl
)
#test parenthesized operator
buildG bounds0 edges0 = accumArray (flip (:)) [] bounds0 (map reassoc edges0)
where reassoc (v, e, w) = (v, (e, w))
#test record pattern matching stuff
downloadRepoPackage = case repo of
RepoLocal {..} -> return ()
RepoLocal { abc } -> return ()
RepoLocal{} -> return ()
#test do let comment indentation level problem
func = do
let (primaryPkg, otherPkgs) = selectPrimaryLocalPackage pwd pkgs'
(bproblems, x) = resolveBuildTargets primaryPkg otherPkgs utargets''
-- default local dir target if there's no given target
utargets'' = "foo"
return ()
#test list comprehension comment placement
func =
[ (thing, take 10 alts) --TODO: select best ones
| (thing, _got, alts@(_:_)) <- nosuchFooThing
, gast <- award
]
#test if-then-else comment placement
func = if x
then if y -- y is important
then foo
else bar
else Nothing
#test qualified infix pattern
#pending "TODO"
wrapPatPrepend pat prepElem = do
patDocs <- layoutPat pat
case Seq.viewl patDocs of
Seq.EmptyL -> return $ Seq.empty
x1 Seq.:< xR -> do
x1' <- docSeq [prepElem, return x1]
return $ x1' Seq.<| xR
#test type signature multiline forcing issue
layoutWriteNewlineBlock
:: ( MonadMultiWriter Text.Builder.Builder m
, MonadMultiState LayoutState m
, MonadMultiWriter (Seq String) m
)
=> m ()
#test multiwayif proper indentation
{-# LANGUAGE MultiWayIf #-}
readMergePersConfig path shouldCreate conf = do
exists <- liftIO $ System.Directory.doesFileExist path
if
| exists -> do
contents <- liftIO $ ByteString.readFile path -- no lazy IO, tyvm.
fileConf <- case Data.Yaml.decodeEither contents of
Left e -> do
liftIO
$ putStrErrLn
$ "error reading in brittany config from "
++ path
++ ":"
liftIO $ putStrErrLn e
mzero
Right x -> return x
return $ fileConf Semigroup.<> conf
| shouldCreate -> do
liftIO $ ByteString.writeFile path $ Data.Yaml.encode $ cMap
(Option . Just . runIdentity)
staticDefaultConfig
return $ conf
| otherwise -> do
return conf
#test nested pattern alignment issue"
func = BuildReport
where
convertInstallOutcome = case result of
Left BR.PlanningFailed -> PlanningFailed
Left (BR.DependentFailed p) -> DependencyFailed p
Left (BR.DownloadFailed _) -> DownloadFailed
Left (BR.UnpackFailed _) -> UnpackFailed
Left (BR.ConfigureFailed _) -> ConfigureFailed
Left (BR.BuildFailed _) -> BuildFailed
Left (BR.TestsFailed _) -> TestsFailed
Left (BR.InstallFailed _) -> InstallFailed
Right (BR.BuildOk _ _ _ ) -> InstallOk
#test nested pattern alignment issue"
func = BuildReport
where
convertInstallOutcome = case result of
Left BR.PlanningFailed -> PlanningFailed
Left (BR.DependentFailed p) -> DependencyFailed p
Left (BR.DownloadFailed _) -> DownloadFailed
Left (BR.UnpackFailed _) -> UnpackFailed
Left (BR.ConfigureFailed _) -> ConfigureFailed
Left (BR.BuildFailed _) -> BuildFailed
Left (BR.TestsFailed _) -> TestsFailed
Left (BR.InstallFailed _) -> InstallFailed
Right (BR.BuildOk _ _ _ ) -> InstallOk
#test partially overflowing alignment issue"
showPackageDetailedInfo pkginfo =
renderStyle (style { lineLength = 80, ribbonsPerLine = 1 })
$ char '*'
$+$ something
[ entry "Synopsis" synopsis hideIfNull reflowParagraphs
, entry "Versions available"
sourceVersions
(altText null "[ Not available from server ]")
(dispTopVersions 9 (preferredVersions pkginfo))
, entry
"Versions installed"
installedVersions
( altText
null
(if hasLib pkginfo then "[ Not installed ]" else "[ Unknown ]")
)
(dispTopVersions 4 (preferredVersions pkginfo))
, entry "Homepage" homepage orNotSpecified text
, entry "Bug reports" bugReports orNotSpecified text
, entry "Description" description hideIfNull reflowParagraphs
, entry "Category" category hideIfNull text
, entry "License" license alwaysShow disp
, entry "Author" author hideIfNull reflowLines
, entry "Maintainer" maintainer hideIfNull reflowLines
, entry "Source repo" sourceRepo orNotSpecified text
, entry "Executables" executables hideIfNull (commaSep text)
, entry "Flags" flags hideIfNull (commaSep dispFlag)
, entry "Dependencies" dependencies hideIfNull (commaSep dispExtDep)
, entry "Documentation" haddockHtml showIfInstalled text
, entry "Cached" haveTarball alwaysShow dispYesNo
, if not (hasLib pkginfo)
then empty
else text "Modules:"
$+$ nest 4 (vcat (map disp . sort . modules $ pkginfo))
]
#test issue 7a
isValidPosition position | validX && validY = Just position
| otherwise = Nothing
#test issue-6-pattern-linebreak-validity
## this is ugly, but at least syntactically valid.
foo = Reflex.runSpiderHost $ ReflexHost.hostApp $ do
(inputEvent :: Reflex.Event Reflex.Spider String, inputFire :: String
-> IO Bool ) <-
ReflexHost.newExternalEvent
liftIO . forkIO . forever $ getLine >>= inputFire
ReflexHost.performEvent_ $ fmap (liftIO . putStrLn) inputEvent
#test issue 16
foldrDesc f z = unSwitchQueue $ \q ->
switch (Min.foldrDesc (f unTaggedF) z q) (Min.foldrAsc (f unTaggedF) z q)
#test issue 18
autocheckCases =
[ ("Never Deadlocks" , representative deadlocksNever)
, ("No Exceptions" , representative exceptionsNever)
, ("Consistent Result", alwaysSame) -- already representative
]
#test issue 18b
autocheckCases =
[ ("Never Deadlocks", representative deadlocksNever)
, ("No Exceptions" , representative exceptionsNever)
, ( "Consistent Result"
, alwaysSame -- already representative
)
]
#test issue 18c
func =
[ (abc, (1111, 1111))
, (def, (2, 2))
, foo -- comment
]
#test issue 26
foo a b = g a b -- fooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
where g a b = b + b * a
#test issue 26b
foo a b = g a b where g a b = b + b * a -- fooooooooooooooooooooooooooooooooooo
#test aggressive alignment 1
func = do
abc <- expr
abcccccccccccccccccc <- expr
abcccccccccccccccccccccccccccccccccccccccccc <- expr
abccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc <- expr
#test example alignment 1
func (MyLongFoo abc def) = 1
func (Bar a d ) = 2
func _ = 3
#test listcomprehension-case-of
parserCompactLocation =
[ try
$ [ ParseRelAbs (Text.Read.read digits) _ _
| digits <- many1 digit
, rel1 :: Maybe (Either Int (Ratio Int)) <- optionMaybe
[ case divPart of
Nothing -> Left $ Text.Read.read digits
Just ddigits ->
Right $ Text.Read.read digits % Text.Read.read ddigits
| digits <- many1 digit
, divPart <- optionMaybe (string "/" *> many1 digit)
]
]
]
#test opapp-specialcasing-1
func = fooooooooooooooooooooooooooooooooo $ foooooooooooooooooooooooooooooooo
foooooooooooooooooooooooooooooooo
foooooooooooooooooooooooooooooooo
#test opapp-specialcasing-2
func =
fooooooooooooooooooooooooooooooooo
+ foooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooo
foooooooooooooooooooooooooooooooo
#test opapp-specialcasing-3
func = fooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooo
[ foooooooooooooooooooooooooooooooo
, foooooooooooooooooooooooooooooooo
, foooooooooooooooooooooooooooooooo
]
#test opapp-indenting
parserPrim =
[ r
| r <-
[ SGPPrimFloat $ bool id (0-) minus $ readGnok "parserPrim"
(d1 ++ d2 ++ d3 ++ d4)
| d2 <- string "."
, d3 <- many1 (oneOf "0123456789")
, _ <- string "f"
]
<|> [ SGPPrimFloat $ bool id (0-) minus $ fromIntegral
(readGnok "parserPrim" d1 :: Integer)
| _ <- string "f"
]
<|> [ SGPPrimInt $ bool id (0-) minus $ fromIntegral
(readGnok "parserPrim" d1 :: Integer)
| _ <- string "i"
]
]
#test another-parspacing-testcase
samples = (SV.unpackaaaaadat) <&> \f ->
aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
#test recordupd-singleline-bug
runBrittany tabSize text = do
let
config' = staticDefaultConfig
config = config'
{ _conf_layout = (_conf_layout config') { _lconfig_indentAmount = coerce
tabSize
}
, _conf_forward = forwardOptionsSyntaxExtsEnabled
}
parsePrintModule config text
#test issue 38
{-# LANGUAGE TypeApplications #-}
foo = bar @Baz
#test comment-before-BDCols
{-# LANGUAGE TypeApplications #-}
layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do
docAlt
$ -- one-line solution
[ docCols
(ColBindingLine alignmentToken)
[ docSeq (patPartInline ++ [guardPart])
, docSeq
[ appSep $ return binderDoc
, docForceSingleline $ return body
, wherePart
]
]
| not hasComments
, [(guards, body, _bodyRaw)] <- [clauseDocs]
, let guardPart = singleLineGuardsDoc guards
, wherePart <- case mWhereDocs of
Nothing -> return @[] $ docEmpty
Just [w] -> return @[] $ docSeq
[ docSeparator
, appSep $ docLit $ Text.pack "where"
, docSetIndentLevel $ docForceSingleline $ return w
]
_ -> []
]
++ -- one-line solution + where in next line(s)
[ docLines
$ [ docCols
(ColBindingLine alignmentToken)
[ docSeq (patPartInline ++ [guardPart])
, docSeq
[appSep $ return binderDoc, docForceParSpacing $ return body]
]
]
++ wherePartMultiLine
| [(guards, body, _bodyRaw)] <- [clauseDocs]
, let guardPart = singleLineGuardsDoc guards
, Data.Maybe.isJust mWhereDocs
]
++ -- two-line solution + where in next line(s)
[ docLines
$ [ docForceSingleline
$ docSeq (patPartInline ++ [guardPart, return binderDoc])
, docEnsureIndent BrIndentRegular $ docForceSingleline $ return
body
]
++ wherePartMultiLine
| [(guards, body, _bodyRaw)] <- [clauseDocs]
, let guardPart = singleLineGuardsDoc guards
]
#test comment-testcase-17
{-# LANGUAGE MultiWayIf #-}
func = do
let foo = if
| Constuctoooooooooooooooooooooooooooooooooooor `elem` artics -- TODO
-> max
(defLen - 0.2) -- TODO
(defLen * 0.8)
| otherwise -> max (defLen - 0.05) (defLen * 0.95) -- TODO
return True
#test issue 49
foo n = case n of
1 -> True
-1 -> False
bar n = case n of
(-2, -2) -> (-2, -2)
#test issue 48 a
foo =
let a = b@1
cccc = ()
in foo
#test issue 48 b
{-# LANGUAGE TypeApplications #-}
foo =
let a = b @1
cccc = ()
in foo
#test issue 52 a
{-# LANGUAGE RecordWildCards #-}
v = A {a = 1, ..} where b = 2
#test issue 52 b
{-# LANGUAGE RecordWildCards #-}
v = A {..} where b = 2
#test issue 52 c
{-# LANGUAGE RecordWildCards #-}
v = A {a = 1, b = 2, c = 3}

35
src-literatetests/16-pending.blt Normal file
View File

@ -0,0 +1,35 @@
###############################################################################
###############################################################################
###############################################################################
#group pending
###############################################################################
###############################################################################
###############################################################################
## this testcase is not about idempotency, but about _how_ the output differs
## from the input; i cannot really express this yet with the current
## test-suite.
## #test ayaz
##
## myManageHook =
## composeOne [isFullscreen -?> doFullFloat, isDialog -?> doFloat, transience]
## <+> composeAll
## [ className =? "Pidgin" --> doFloat
## , className =? "XCalc" --> doFloat
## -- plan9port's acme
## , className =? "acme" --> doFloat
## -- Acme with Vi bindings editor
## , title =? "ED" --> doFloat
## , title =? "wlc-x11" --> doFloat
## , className =? "Skype" --> doFloat
## , className =? "ffplay" --> doFloat
## , className =? "mpv" --> doFloat
## , className =? "Plugin-container" --> doFloat -- Firefox flash, etc.
## -- Firefox works well tiled, but it has dialog windows we want to float.
## , appName =? "Browser" --> doFloat
## ]
## where
## role = stringProperty "WM_WINDOW_ROLE"

7
src-literatetests/Main.hs
View File

@ -24,6 +24,7 @@ import Language.Haskell.Brittany.Internal.Config
import Data.Coerce ( coerce ) import Data.Coerce ( coerce )
import qualified Data.Text.IO as Text.IO import qualified Data.Text.IO as Text.IO
import System.FilePath ( (</>) )
@ -38,8 +39,10 @@ data InputLine
main :: IO () main :: IO ()
main = do main = do
input <- Text.IO.readFile "src-literatetests/tests.blt" files <- System.Directory.listDirectory "src-literatetests/"
let groups = createChunks input let blts = List.sort $ filter (".blt" `isSuffixOf`) files
inputs <- blts `forM` \blt -> Text.IO.readFile ("src-literatetests" </> blt)
let groups = createChunks =<< inputs
hspec $ groups `forM_` \(groupname, tests) -> do hspec $ groups `forM_` \(groupname, tests) -> do
describe (Text.unpack groupname) $ tests `forM_` \(name, pend, inp) -> do describe (Text.unpack groupname) $ tests `forM_` \(name, pend, inp) -> do
(if pend then before_ pending else id) (if pend then before_ pending else id)