hexagoxel
/
brittany
1
0
Fork 0
Code Issues 117 Pull Requests 5 Packages Projects Releases 5 Wiki Activity
brittany/src-literatetests/tests.blt

882 lines
24 KiB
Plaintext
Raw Blame History

###############################################################################
###############################################################################
###############################################################################
#group type signatures
###############################################################################
###############################################################################
###############################################################################
#test simple001
func :: a -> a
#test long typeVar
func
:: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
#test keep linebreak mode
func
:: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-> lakjsdlkjasldkj
-> lakjsdlkjasldkj
#test simple parens 1
func :: ((a))
#test simple parens 2
func :: (a -> a) -> a
#test simple parens 3
func :: a -> (a -> a)
#test did anyone say parentheses?
func :: (((((((((())))))))))
-- current output is.. funny. wonder if that can/needs to be improved..
#test give me more!
#pending
func :: ((((((((((((((((((((((((((((((((((((((((((()))))))))))))))))))))))))))))))))))))))))))
#test unit
func :: ()
###############################################################################
#test paren'd func 1
func
:: ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-> lakjsdlkjasldkj
-> lakjsdlkjasldkj
)
#test paren'd func 2
func
:: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-> (lakjsdlkjasldkj -> lakjsdlkjasldkj)
#test paren'd func 3
func
:: (lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd -> lakjsdlkjasldkj)
-> lakjsdlkjasldkj
#test paren'd func 4
func
:: ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
)
-> lakjsdlkjasldkj
#test paren'd func 5
func
:: ( ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
)
)
###############################################################################
#test type application 1
func :: asd -> Either a b
#test type application 2
func
:: asd
-> Either
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
#test type application 3
func
:: asd
-> Trither
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
#test type application 4
func
:: Trither
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-> asd
#test type application 5
func
:: Trither
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
(lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd -> asd)
#test type application 6
func
:: Trither
asd
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
)
#test type application paren 1
func
:: asd
-> ( Trither
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
)
#test type application paren 2
func
:: asd
-> ( Trither
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
)
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
#test type application paren 3
func
:: ( Trither
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
)
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-> asd
###############################################################################
#test list simple
func :: [a -> b]
#test list func
func
:: [ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
]
#test list paren
func
:: [ ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
)
]
################################################################## -- #############
#test tuple type 1
func :: (a, b, c)
#test tuple type 2
func :: ((a, b, c), (a, b, c), (a, b, c))
#test tuple type long
func
:: ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
, lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
, lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
)
#test tuple type nested
func
:: ( ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
, (lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd)
, lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
)
)
#test tuple type function
func
:: [ ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
, lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
, lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
)
]
###############################################################################
#test type operator stuff
#pending
test050 :: a :+: b
test051 :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
:+: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
test052 :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
:+: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
###############################################################################
#test forall oneliner
{-# LANGUAGE ScopedTypeVariables #-}
func :: forall (a :: *) b . a -> b
#test forall context multiline
{-# LANGUAGE ScopedTypeVariables #-}
func
:: forall m
. Foo
=> ColMap2
-> ColInfo
-> ColInfo
-> ColInfo
-> ColInfo
-> m ()
#test forall no-context multiline
{-# LANGUAGE ScopedTypeVariables #-}
func
:: forall m
. ColMap2
-> ColInfo
-> ColInfo
-> ColInfo
-> ColInfo
-> ColInfo
-> m ()
#test language pragma issue
{-# LANGUAGE ScopedTypeVariables #-}
func :: forall (a :: *) b . a -> b
#test comments 1
func :: a -> b -- comment
#test comments 2
funcA :: a -> b -- comment A
funcB :: a -> b -- comment B
#test comments all
#pending
-- a
func -- b
:: -- c
a -- d
-> -- e
( -- f
c -- g
, -- h
d -- i
) -- j
-- k
###############################################################################
#test ImplicitParams 1
{-# LANGUAGE ImplicitParams #-}
func :: (?asd::Int) -> ()
#test ImplicitParams 2
{-# LANGUAGE ImplicitParams #-}
func
:: ( ?asd
:: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
)
-> ()
###############################################################################
###############################################################################
###############################################################################
#group type signatures pragmas
###############################################################################
###############################################################################
###############################################################################
#test inline pragma 1
func = f
where
{-# INLINE f #-}
f = id
#test inline pragma 2
func = ($)
where
{-# INLINE ($) #-}
($) = id
#test inline pragma 3
func = f
where
{-# INLINE CONLIKE [1] f #-}
f = id
#test inline pragma 4
#pending this does not work with the compiler version we currently use yet (i think). should work with ghc-8.0.2.
func = f
where
{-# INLINE [~] f #-}
f = id
###############################################################################
###############################################################################
###############################################################################
#group equation.basic
###############################################################################
###############################################################################
###############################################################################
## some basic testing of different kinds of equations.
## some focus on column layouting for multiple-equation definitions.
## (that part probably is not implemented in any way yet.)
#test basic 1
func x = x
#test infix 1
x *** y = x
#test symbol prefix
(***) x y = x
###############################################################################
###############################################################################
###############################################################################
#group equation.patterns
###############################################################################
###############################################################################
###############################################################################
#test wildcard
func _ = x
#test simple long pattern
#pending
func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable
= x
#test simple multiline pattern
#pending
func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable
reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable
= x
#test another multiline pattern
#pending
func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable
a
b
= x
#test simple constructor
func (A a) = a
#test list constructor
func (x:xr) = x
#test some other constructor symbol
#pending
func (x:+:xr) = x
###############################################################################
###############################################################################
###############################################################################
#group equation.guards
###############################################################################
###############################################################################
###############################################################################
#test simple guard
func | True = x
#test multiple-clauses-1
func x | x = simple expression
| otherwise = 0
#test multiple-clauses-2
func x
| a somewhat longer guard x = "and a somewhat longer expession that does not"
| otherwise = "fit without putting the guards in new lines"
#test multiple-clauses-3
func x
| very long guard, another rather long guard that refers to x
= nontrivial expression foo bar alsdkjlasdjlasj
| otherwise
= 0
#test multiple-clauses-4
func x
| very loooooooooooooooooooooooooooooong guard
, another rather long guard that refers to x
= nontrivial expression foo bar alsdkjlasdjlasj
| otherwise
= 0
###############################################################################
###############################################################################
###############################################################################
#group expression.basic
###############################################################################
###############################################################################
###############################################################################
#test var
func = x
describe "infix op" $ do
#test 1
func = x + x
#test long
#pending
func = mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
+ mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
#test long keep linemode 1
#pending
func = mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
+ mweroiuxlskdfjlksj
+ mweroiuxlskdfjlksj
#test long keep linemode 2
#pending
func = mweroiuxlskdfjlksj
+ mweroiuxlskdfjlksj
+ mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
#test literals
func = 1
func = "abc"
func = 1.1e5
func = 'x'
func = 981409823458910394810928414192837123987123987123
#test lambdacase
{-# LANGUAGE LambdaCase #-}
func = \case
FooBar -> x
Baz -> y
#test lambda
func = \x -> abc
describe "app" $ do
#test 1
func = klajsdas klajsdas klajsdas
#test 2
func = lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
#test 3
func = lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd lakjsdlajsdljas
lakjsdlajsdljas
lakjsdlajsdljas
###
#group expression.basic.sections
###
#test left
func = (1+)
#test right
func = (+1)
#test left inf
## TODO: this could be improved..
func = (1`abc`)
#test right inf
func = (`abc`1)
###
#group tuples
###
#test 1
func = (abc, def)
#test 2
#pending
func = (lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
, lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd)
###############################################################################
###############################################################################
###############################################################################
#group expression.do statements
###############################################################################
###############################################################################
###############################################################################
#test simple
func = do
stmt
stmt
#test bind
func = do
x <- stmt
stmt x
#test let
func = do
let x = 13
stmt x
###############################################################################
###############################################################################
###############################################################################
#group expression.lists
###############################################################################
###############################################################################
###############################################################################
#test monad-comprehension-case-of
func =
foooooo
$ [ case
foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
of
_ -> True
]
###############################################################################
###############################################################################
###############################################################################
#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
#pending "TODO"
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)
]
]
]
###############################################################################
###############################################################################
###############################################################################
#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"
Reference in New Issue View Git Blame Copy Permalink