hexagoxel
/
brittany
1
0
Fork 0
Code Issues 117 Pull Requests 5 Packages Projects Releases 5 Wiki Activity
brittany/src-unittests/IdentityTests.hs

538 lines
14 KiB
Haskell
Raw Blame History

{-# LANGUAGE QuasiQuotes #-}
module IdentityTests
( identityTests
)
where
#include "prelude.inc"
import Test.Hspec
import NeatInterpolation
import Language.Haskell.Brittany
import TestUtils
identityTests :: Spec
identityTests = do
describe "type signatures" $ typeSignatureTests
describe "equation" $ do
describe "basic" $ basicEquationTests
describe "patterns" $ patternTests
describe "guards" $ guardTests
describe "expression" $ do
describe "basic" $ basicExpressionTests
describe "do statements" $ doStatementTests
describe "alignment" $ alignmentTests
describe "regression" $ regressionTests
typeSignatureTests :: Spec
typeSignatureTests = do
it "simple001" $ roundTripEqual $
[text|
func :: a -> a
|]
it "long typeVar" $ roundTripEqual $
[text|
func
:: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
|]
it "keep linebreak mode" $ roundTripEqual $
[text|
func
:: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-> lakjsdlkjasldkj
-> lakjsdlkjasldkj
|]
it "simple parens 1" $ roundTripEqual $
[text|
func :: ((a))
|]
it "simple parens 2" $ roundTripEqual $
[text|
func :: (a -> a) -> a
|]
it "simple parens 3" $ roundTripEqual $
[text|
func :: a -> (a -> a)
|]
it "did anyone say parentheses?" $ roundTripEqual $
[text|
func :: (((((((((())))))))))
|]
before_ pending $ it "give me more!" $ roundTripEqual $
-- current output is.. funny. wonder if that can/needs to be improved..
[text|
func :: ((((((((((((((((((((((((((((((((((((((((((()))))))))))))))))))))))))))))))))))))))))))
|]
it "unit" $ roundTripEqual $
[text|
func :: ()
|]
-- ################################################################## --
-- ################################################################## --
-- ################################################################## --
it "paren'd func 1" $ roundTripEqual $
[text|
func
:: ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-> lakjsdlkjasldkj
-> lakjsdlkjasldkj
)
|]
it "paren'd func 2" $ roundTripEqual $
[text|
func
:: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-> (lakjsdlkjasldkj -> lakjsdlkjasldkj)
|]
it "paren'd func 3" $ roundTripEqual $
[text|
func
:: (lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd -> lakjsdlkjasldkj)
-> lakjsdlkjasldkj
|]
it "paren'd func 4" $ roundTripEqual $
[text|
func
:: ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
)
-> lakjsdlkjasldkj
|]
it "paren'd func 5" $ roundTripEqual $
[text|
func
:: ( ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
)
)
|]
-- ################################################################## --
-- ################################################################## --
-- ################################################################## --
it "type application 1" $ roundTripEqual $
[text|
func :: asd -> Either a b
|]
it "type application 2" $ roundTripEqual $
[text|
func
:: asd
-> Either
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
|]
it "type application 3" $ roundTripEqual $
[text|
func
:: asd
-> Trither
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
|]
it "type application 4" $ roundTripEqual $
[text|
func
:: Trither
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-> asd
|]
it "type application 5" $ roundTripEqual $
[text|
func
:: Trither
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
(lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd -> asd)
|]
it "type application 6" $ roundTripEqual $
[text|
func
:: Trither
asd
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
)
|]
it "type application paren 1" $ roundTripEqual $
[text|
func
:: asd
-> ( Trither
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
)
|]
it "type application paren 2" $ roundTripEqual $
[text|
func
:: asd
-> ( Trither
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
)
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
|]
it "type application paren 3" $ roundTripEqual $
[text|
func
:: ( Trither
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
)
lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-> asd
|]
-- ################################################################## --
-- ################################################################## --
-- ################################################################## --
it "list simple" $ roundTripEqual $
[text|
func :: [a -> b]
|]
it "list func" $ roundTripEqual $
[text|
func
:: [ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
]
|]
it "list paren" $ roundTripEqual $
[text|
func
:: [ ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
)
]
|]
-- ################################################################## --
-- ################################################################## --
-- ################################################################## --
it "tuple type 1" $ roundTripEqual $
[text|
func :: (a, b, c)
|]
it "tuple type 2" $ roundTripEqual $
[text|
func :: ((a, b, c), (a, b, c), (a, b, c))
|]
it "tuple type long" $ roundTripEqual $
[text|
func
:: ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
, lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
, lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
)
|]
it "tuple type nested" $ roundTripEqual $
[text|
func
:: ( ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
, (lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd)
, lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
)
)
|]
it "tuple type function" $ roundTripEqual $
[text|
func
:: [ ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
, lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
, lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
)
]
|]
-- ################################################################## --
-- ################################################################## --
-- ################################################################## --
before_ pending $ it "type operator stuff" $ roundTripEqual $
[text|
test050 :: a :+: b
test051 :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
:+: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
test052 :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
:+: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
|]
-- ################################################################## --
-- ################################################################## --
-- ################################################################## --
it "forall oneliner" $ roundTripEqual $
[text|
{-# LANGUAGE ScopedTypeVariables #-}
--this comment is necessary for whatever reason..
func :: forall (a :: *) b . a -> b
|]
it "language pragma issue" $ roundTripEqual $
[text|
{-# LANGUAGE ScopedTypeVariables #-}
func :: forall (a :: *) b . a -> b
|]
it "comments 1" $ roundTripEqual $
[text|
func :: a -> b -- comment
|]
it "comments 2" $ roundTripEqual $
[text|
funcA :: a -> b -- comment A
funcB :: a -> b -- comment B
|]
before_ pending $ it "comments all" $ roundTripEqual $
[text|
-- a
func -- b
:: -- c
a -- d
-> -- e
( -- f
c -- g
, -- h
d -- i
) -- j
-- k
|]
-- ################################################################## --
-- ################################################################## --
-- ################################################################## --
it "ImplicitParams 1" $ roundTripEqual $
[text|
{-# LANGUAGE ImplicitParams #-}
func :: (?asd::Int) -> ()
|]
it "ImplicitParams 2" $ roundTripEqual $
[text|
{-# LANGUAGE ImplicitParams #-}
func
:: ( ?asd
:: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
-> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd
)
-> ()
|]
-- 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.)
basicEquationTests :: Spec
basicEquationTests = do
it "basic 1" $ roundTripEqual $
[text|
func x = x
|]
it "infix 1" $ roundTripEqual $
[text|
x *** y = x
|]
it "symbol prefix" $ roundTripEqual $
[text|
(***) x y = x
|]
patternTests :: Spec
patternTests = do
it "wildcard" $ roundTripEqual $
[text|
func _ = x
|]
before_ pending $ it "simple long pattern" $ roundTripEqual $
[text|
func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable
= x
|]
before_ pending $ it "simple multiline pattern" $ roundTripEqual $
[text|
func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable
reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable
= x
|]
before_ pending $ it "another multiline pattern" $ roundTripEqual $
[text|
func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable
a
b
= x
|]
before_ pending $ it "simple constructor" $ roundTripEqual $
[text|
func (A a) = a
|]
before_ pending $ it "list constructor" $ roundTripEqual $
[text|
func (x:xr) = x
|]
before_ pending $ it "some other constructor symbol" $ roundTripEqual $
[text|
func (x:+:xr) = x
|]
guardTests :: Spec
guardTests = do
it "simple guard" $ roundTripEqual $
[text|
func | True = x
|]
basicExpressionTests :: Spec
basicExpressionTests = do
it "var" $ roundTripEqual $
[text|
func = x
|]
describe "infix op" $ do
it "1" $ roundTripEqual $
[text|
func = x + x
|]
before_ pending $ it "long" $ roundTripEqual $
[text|
func = mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
+ mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
|]
before_ pending $ it "long keep linemode 1" $ roundTripEqual $
[text|
func = mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
+ mweroiuxlskdfjlksj
+ mweroiuxlskdfjlksj
|]
before_ pending $ it "long keep linemode 2" $ roundTripEqual $
[text|
func = mweroiuxlskdfjlksj
+ mweroiuxlskdfjlksj
+ mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
|]
it "literals" $ roundTripEqual $
[text|
func = 1
func = "abc"
func = 1.1e5
func = 'x'
func = 981409823458910394810928414192837123987123987123
|]
it "lambdacase" $ roundTripEqual $
[text|
{-# LANGUAGE LambdaCase #-}
func = \case
FooBar -> x
Baz -> y
|]
doStatementTests :: Spec
doStatementTests = do
it "simple" $ roundTripEqual $
[text|
func = do
stmt
stmt
|]
it "bind" $ roundTripEqual $
[text|
func = do
x <- stmt
stmt x
|]
it "let" $ roundTripEqual $
[text|
func = do
let x = 13
stmt x
|]
return ()
alignmentTests :: Spec
alignmentTests = do
return ()
regressionTests :: Spec
regressionTests = do
it "newlines-comment" $ do
roundTripEqual $
[text|
func = do
abc <- foo
--abc
return ()
|]
it "parenthesis-around-unit" $ do
roundTripEqual $
[text|
func = (())
|]
it "let-defs indentation" $ do
roundTripEqual $
[text|
func = do
let foo True = True
foo _ = False
return ()
|]
it "record update indentation" $ do
roundTripEqual $
[text|
func = do
s <- mGet
mSet $ s
{ _lstate_indent = _lstate_indent state
}
|]
it "post-indent comment" $ do
roundTripEqual $
[text|
func = do
-- abc
-- def
return ()
|]
it "post-unindent comment" $ do
roundTripEqual $
[text|
func = do
do
return ()
-- abc
-- def
return ()
|]
it "CPP empty comment case" $ do
pendingWith "CPP parsing needs fixing for roundTripEqual"
roundTripEqual $
[text|
{-# 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.
it "comment inline placement (temporary)" $ do
roundTripEqual $
[text|
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
|]
Reference in New Issue View Git Blame Copy Permalink