diff --git a/brittany.cabal b/brittany.cabal index 957fb06..2294238 100644 --- a/brittany.cabal +++ b/brittany.cabal @@ -24,7 +24,7 @@ extra-doc-files: { doc/implementation/*.md } extra-source-files: { - src-literatetests/tests.blt + src-literatetests/*.blt } source-repository head { @@ -330,6 +330,7 @@ test-suite littests , czipwith , ghc-boot-th , hspec >=2.4.1 && <2.5 + , filepath , parsec >=3.1.11 && <3.2 } ghc-options: -Wall diff --git a/src-literatetests/tests.blt b/src-literatetests/10-tests.blt similarity index 50% rename from src-literatetests/tests.blt rename to src-literatetests/10-tests.blt index f4db082..696cbb6 100644 --- a/src-literatetests/tests.blt +++ b/src-literatetests/10-tests.blt @@ -589,507 +589,3 @@ func = ] ++ [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" - diff --git a/src-literatetests/15-regressions.blt b/src-literatetests/15-regressions.blt new file mode 100644 index 0000000..0a63b7a --- /dev/null +++ b/src-literatetests/15-regressions.blt @@ -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} + diff --git a/src-literatetests/16-pending.blt b/src-literatetests/16-pending.blt new file mode 100644 index 0000000..c8147d8 --- /dev/null +++ b/src-literatetests/16-pending.blt @@ -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" + diff --git a/src-literatetests/Main.hs b/src-literatetests/Main.hs index fe966e6..34b4e4e 100644 --- a/src-literatetests/Main.hs +++ b/src-literatetests/Main.hs @@ -24,6 +24,7 @@ import Language.Haskell.Brittany.Internal.Config import Data.Coerce ( coerce ) import qualified Data.Text.IO as Text.IO +import System.FilePath ( () ) @@ -38,8 +39,10 @@ data InputLine main :: IO () main = do - input <- Text.IO.readFile "src-literatetests/tests.blt" - let groups = createChunks input + files <- System.Directory.listDirectory "src-literatetests/" + 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 describe (Text.unpack groupname) $ tests `forM_` \(name, pend, inp) -> do (if pend then before_ pending else id)