516 lines
15 KiB
Plaintext
516 lines
15 KiB
Plaintext
###############################################################################
|
|
###############################################################################
|
|
###############################################################################
|
|
#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_foo = _lstate_foo state
|
|
}
|
|
|
|
#test record update indentation 3
|
|
func = do
|
|
s <- mGet
|
|
mSet $ s
|
|
{ _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
|
|
, _lstate_foo = _lstate_foo lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
|
|
}
|
|
|
|
#test record construction 1
|
|
func = Foo {_lstate_indent = _lstate_indent state}
|
|
|
|
#test record construction 2
|
|
func = Foo
|
|
{ _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
|
|
, _lstate_fooo = _lstate_foo lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
|
|
}
|
|
|
|
#test record construction 3
|
|
func = do
|
|
Foo
|
|
{ _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
|
|
, _lstate_foo = _lstate_foo 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}
|
|
|
|
#test issue 63 a
|
|
#pending fix does not work on 8.0.2
|
|
test :: Proxy 'Int
|
|
|
|
#test issue 63 b
|
|
#pending fix does not work on 8.0.2
|
|
test :: Proxy '[ 'True]
|
|
|
|
#test issue 63 c
|
|
#pending fix does not work on 8.0.2
|
|
test :: Proxy '[Bool]
|
|
|
|
#test issue 64
|
|
{-# LANGUAGE RankNTypes, KindSignatures #-}
|
|
func
|
|
:: forall m str
|
|
. (Str str, Monad m)
|
|
=> Int
|
|
-> Proxy (str :: [*])
|
|
-> m (Tagged str String)
|
|
|
|
#test issue 67
|
|
fmapuv :: U.Unbox a => (a -> b) -> U.Vector a -> V.Vector b
|
|
fmapuv f xs = G.generate (G.length xs) (f . (xs G.!))
|
|
|
|
|
|
#test parallellistcomp-workaround
|
|
cs0 = 0 : [ c / Interval n | c <- cs | n <- [1..] ]
|
|
|
|
#test issue 70
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
deriveFromJSON (unPrefix "assignPost") ''AssignmentPost
|