From bff9bfb3128700dd6bbaae6d612df2fcff3f1db6 Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Tue, 31 Jan 2023 19:54:20 +0000 Subject: [PATCH] Support and use nested file structure for tests --- brittany.cabal | 1 + data/10-structured/data-type-decl.blt | 288 +++ data/10-structured/decl-class.blt | 0 data/10-structured/decl-instance.blt | 127 ++ data/10-structured/decl-type-fam-ghc-9.blt | 134 ++ data/10-structured/decl-type-fam-instance.blt | 36 + data/10-structured/expression-basic.blt | 148 ++ data/10-structured/expression-do.blt | 17 + data/10-structured/expression-let.blt | 27 + data/10-structured/expression-special.blt | 19 + data/10-structured/fundecl.blt | 94 + data/10-structured/module-imports.blt | 271 +++ data/10-structured/module-top.blt | 66 + .../10-structured/type-signatures-pragmas.blt | 29 + data/10-structured/type-signatures.blt | 265 +++ data/10-structured/type-synonyms.blt | 94 + data/10-tests.blt | 1757 ----------------- data/11-extensions/implicitparams.blt | 28 + data/11-extensions/lambdacase.blt | 8 + data/11-extensions/multiwayif.blt | 16 + data/11-extensions/overloadedlabels.blt | 10 + data/11-extensions/patternsynonyms.blt | 100 + data/11-extensions/quasiquotes.blt | 34 + data/11-extensions/recursivedo.blt | 17 + data/11-extensions/unboxedtuples.blt | 14 + data/12-other.blt | 27 + data/14-extensions.blt | 241 --- data/30-tests-context-free.blt | 34 +- source/test-suite/Main.hs | 87 +- 29 files changed, 1951 insertions(+), 2038 deletions(-) create mode 100644 data/10-structured/data-type-decl.blt create mode 100644 data/10-structured/decl-class.blt create mode 100644 data/10-structured/decl-instance.blt create mode 100644 data/10-structured/decl-type-fam-ghc-9.blt create mode 100644 data/10-structured/decl-type-fam-instance.blt create mode 100644 data/10-structured/expression-basic.blt create mode 100644 data/10-structured/expression-do.blt create mode 100644 data/10-structured/expression-let.blt create mode 100644 data/10-structured/expression-special.blt create mode 100644 data/10-structured/fundecl.blt create mode 100644 data/10-structured/module-imports.blt create mode 100644 data/10-structured/module-top.blt create mode 100644 data/10-structured/type-signatures-pragmas.blt create mode 100644 data/10-structured/type-signatures.blt create mode 100644 data/10-structured/type-synonyms.blt delete mode 100644 data/10-tests.blt create mode 100644 data/11-extensions/implicitparams.blt create mode 100644 data/11-extensions/lambdacase.blt create mode 100644 data/11-extensions/multiwayif.blt create mode 100644 data/11-extensions/overloadedlabels.blt create mode 100644 data/11-extensions/patternsynonyms.blt create mode 100644 data/11-extensions/quasiquotes.blt create mode 100644 data/11-extensions/recursivedo.blt create mode 100644 data/11-extensions/unboxedtuples.blt create mode 100644 data/12-other.blt delete mode 100644 data/14-extensions.blt diff --git a/brittany.cabal b/brittany.cabal index 596b474..86d31b2 100644 --- a/brittany.cabal +++ b/brittany.cabal @@ -144,6 +144,7 @@ test-suite brittany-test-suite build-depends: , hspec ^>= 2.8.3 , parsec ^>= 3.1.14 + , these ^>= 1.1 hs-source-dirs: source/test-suite main-is: Main.hs type: exitcode-stdio-1.0 diff --git a/data/10-structured/data-type-decl.blt b/data/10-structured/data-type-decl.blt new file mode 100644 index 0000000..f4d9a84 --- /dev/null +++ b/data/10-structured/data-type-decl.blt @@ -0,0 +1,288 @@ +#group data type declarations + + +#test nullary data type +data Foo = Bar {} + +data Biz = Baz + +#test single record +data Foo = Bar + { foo :: Baz + } + +#test record multiple names +data Foo = Bar + { foo, bar :: Baz + } + +#test record multiple types +data Foo = Bar + { foo :: Baz + , bars :: Bizzz + } + +#test record multiple types and names +data Foo = Bar + { foo, biz :: Baz + , bar :: Bizzz + } + +#test record multiple types deriving +data Foo = Bar + { fooz :: Baz + , bar :: Bizzz + } + deriving Show + +#test record long field names +data MyRecord = MyConstructor + { bar1, bar2 + :: Loooooooooooooooooooooooooooooooong + -> Loooooooooooooooooooooooooooooooong + , foo1, foo2 + :: Loooooooooooooooooooooooooooooooonger + -> Loooooooooooooooooooooooooooooooonger + } + +#test record with DataTypeContexts +{-# LANGUAGE DatatypeContexts #-} +data + ( LooooooooooooooooooooongConstraint a + , LooooooooooooooooooooongConstraint b + ) => + MyRecord a b + = MyConstructor + { foo1, foo2 + :: loooooooooooooooooooooooooooooooong + -> loooooooooooooooooooooooooooooooong + , bar :: a + , bazz :: b + } + +#test record single line layout +#pending config flag is disabled for now +{-# LANGUAGE ScopedTypeVariables #-} +-- brittany { lconfig_allowSinglelineRecord: true } +data MyRecord = forall a . Show a => MyCons { foo :: a -> a, i :: Int } + +#test record no matching single line layout +{-# LANGUAGE ScopedTypeVariables #-} +-- brittany { lconfig_allowSinglelineRecord: true } +data MyRecord = forall a . Show a => Bar + { foo :: abittoolongbutnotvery -> abittoolongbutnotvery + } + +#test record forall constraint multiline +{-# LANGUAGE ScopedTypeVariables #-} +data MyRecord + = forall a + . LooooooooooooooooooooongConstraint a => + LoooooooooooongConstructor + { foo :: abittoolongbutnotvery -> abittoolongbutnotvery + } + +#test record forall constraint multiline more +{-# LANGUAGE ScopedTypeVariables #-} +data MyRecord + = forall a b + . ( Loooooooooooooooooooooooooooooooong a + , Loooooooooooooooooooooooooooooooong b + ) => + MyConstructor + { a :: a + , b :: b + } + +#test plain with forall and constraint +{-# LANGUAGE ScopedTypeVariables #-} +data MyStruct + = forall a b + . ( Loooooooooooooooooooooooooooooooong a + , Loooooooooooooooooooooooooooooooong b + ) => + MyConstructor (ToBriDocM BriDocNumbered) + (ToBriDocM BriDocNumbered) + (ToBriDocM BriDocNumbered) + +#test record with many features +{-# LANGUAGE ScopedTypeVariables #-} +data MyRecord + = forall a b + . ( Loooooooooooooooooooooooooooooooong a + , Loooooooooooooooooooooooooooooooong b + ) => + MyConstructor + { foo, foo2 + :: loooooooooooooooooooooooooooooooong + -> loooooooooooooooooooooooooooooooong + , bar :: a + , bazz :: b + } + deriving Show + +#test record multiple types deriving +data Foo = Bar + { foo :: Baz + , bars :: Bizzz + } + deriving (Show, Eq, Monad, Functor, Traversable, Foldable) + +#test record multiple deriving strategies +data Foo = Bar + { foo :: Baz + , bars :: Bizzz + } + deriving Show + deriving (Eq, Ord) + deriving stock Show + deriving stock (Eq, Ord) + deriving anyclass Show + deriving anyclass (Show, Eq, Monad, Functor) + deriving newtype Show + deriving newtype (Traversable, Foldable) + +#test record deriving via +data Foo = Bar + { foo :: Baz + , bars :: Bizzz + } + deriving ToJSON via (SomeType) + deriving (ToJSON, FromJSON) via (SomeType) + +#test single record existential +{-# LANGUAGE ExistentialQuantification #-} + +data Foo = forall a . Show a => Bar + { foo :: a + } + +#test record multiple types existential +{-# LANGUAGE ExistentialQuantification #-} + +data Foo = forall a b . (Show a, Eq b) => Bar + { foo :: a + , bars :: b + } + +#test plain comment simple +-- before +data MyData = MyData Int +-- after + +#test record newline comment +data MyRecord = MyRecord + { a :: Int + -- comment + , b :: Int + } + +#test record comments simple +data Foo = Bar -- a + { foo :: Baz -- b + , bars :: Bizzz -- c + } -- d + deriving (Show, Eq, Monad, Functor, Traversable, Foldable) -- e + +#test record comments strange inline +data Foo = Bar + { -- a + foo -- b + :: -- c + Baz -- d + , -- e + bars :: Bizzz + } + deriving (Show, Eq, Monad, Functor, Traversable, Foldable) + +#test record comments in deriving +## maybe we want to switch to a differnt layout when there are such comments. +## Don't hesitate to modify this testcase, it clearly is not the ideal layout +## for this. + +data Foo = Bar + { foo :: Baz + , bars :: Bizzz + } + -- a + deriving --b + ( -- c + ToJSON -- d + , -- e + FromJSON --f + ) -- g + +#test record comments in deriving via +## maybe we want to switch to a differnt layout when there are such comments. +## Don't hesitate to modify this testcase, it clearly is not the ideal layout +## for this. + +data Foo = Bar + { foo :: Baz + , bars :: Bizzz + } + -- a + deriving --a + ToJSON --b + via -- c + ( -- d + SomeType --e + , -- f + ABC --g + ) + +#test comment before equal sign +{-# LANGUAGE ExistentialQuantification #-} +data MyRecord + -- test comment + = forall a b + . ( Loooooooooooooooooooooooooooooooong a + , Loooooooooooooooooooooooooooooooong b + ) => + MyConstructor a b + +#test normal records on multi line indent policy left +-- brittany {lconfig_indentPolicy: IndentPolicyLeft } +data EnterpriseGrantsForCompanyResponse = EnterpriseGrantsForCompanyResponse + Types.Company + [EnterpriseGrantResponse] + +#test normal records on multi line indent policy free +-- brittany {lconfig_indentPolicy: IndentPolicyFree } +data GrantsForCompanyResp = GrantsForCompanyResp Types.Company + [EnterpriseGrantResponse] + +#test normal records on multi line indent policy free 2 +-- brittany {lconfig_indentPolicy: IndentPolicyFree } +data EnterpriseGrantsForCompanyResponse = EnterpriseGrantsForCompanyResponse + Types.Company + [EnterpriseGrantResponse] + +#test normal records on multi line indent policy multiple +-- brittany {lconfig_indentPolicy: IndentPolicyMultiple } +data GrantsForCompanyResp = GrantsForCompanyResp Types.Company + [EnterpriseGrantResponse] + +#test large record with a comment +data XIILqcacwiuNiu = XIILqcacwiuNiu + { oyyFtvbepgbOge_pebzVmuftEijwuj :: Jgtoyuh HessJvNlo + , wloQsiskdoxJop_xatiKrwedOxtu :: Jgtoyuh [Inotg] + , mmmJjcqtemyIyo_ovosDoreKeeoyamvove :: Jgtoyuh Eujo + , mbiIatelofxOzr_uluxNngiiMjah :: Jgtoyuh HessJvNlo + , obxIskfcxpkIkb_uuviTuevcSkrgo :: Jgtoyuh Int + , wqrAtuvuecoHwr_ilotNxbuPleo :: Jgtoyuh Ufaxdeq + , lofAfuebdhpLuv_cnekPoyFxmg :: Jgtoyuh Ufaxdeq + , ouoFugtawzvUpk_oupiLzptugy :: Jgtoyuh Eujo + , iqiXjtziwogNsa_uiyvSunaTtgUsf3 :: Jgtoyuh Oaivn + , odbIriaqnojUlz_onotoWuunehIpuy :: Jgtoyuh Eujo + , opjUxtkxzkiKse_luqjuZazt + :: Jgtoyuh [(Eujo, Int, Int, Int, Int, Int, NELUxro)] + -- , jcqRaqznxfhIpa_ywevMezmoYkutuwa :: Jgtoyuh () + , vayOmuasyphOfd_bcsVljmvt :: Jgtoyuh Eujo + , rifArahilooRax_ufikecqdImsv :: Jgtoyuh Oaivn + , raqKtopcpszDwb_oqocubasZuqjcryoDojGkw :: Jgtoyuh Oaivn + , mluJiilpcijUtt_gaisklifVekfeyagRmfbyzz :: Jgtoyuh Oaivn + , oqhPaahjupaSmi_gamwwoovKyxznecvEayluc :: Jgtoyuh Oaivn + , mazFubimwebZpa_itidehDodiDlboz :: Jgtoyuh Vrep + , jeyOcuesexaYoy_vpqn :: Jgtoyuh () + } diff --git a/data/10-structured/decl-class.blt b/data/10-structured/decl-class.blt new file mode 100644 index 0000000..e69de29 diff --git a/data/10-structured/decl-instance.blt b/data/10-structured/decl-instance.blt new file mode 100644 index 0000000..12f7ef6 --- /dev/null +++ b/data/10-structured/decl-instance.blt @@ -0,0 +1,127 @@ +#group decl/instance + + +#test simple-instance + +instance MyClass Int where + myMethod x = x + 1 + +#test simple-method-comment + +instance MyClass Int where + myMethod x = + -- insightful comment + x + 1 + +#test simple-method-signature + +instance MyClass Int where + myMethod :: Int -> Int + myMethod x = x + 1 + +#test simple-long-method-signature + +instance MyClass Int where + myMethod + :: Int + -> Int + -> AReallyLongType + -> AReallyLongType + -> AReallyLongType + -> Int + myMethod x = x + 1 + +#test simple-two-methods + +instance MyClass Int where + myMethod x = x + 1 + myMethod2 x = x + 1 + +#test simple-two-signatures + +instance MyClass Int where + myMethod + :: Int + -> Int + -> AReallyLongType + -> AReallyLongType + -> AReallyLongType + -> Int + myMethod x = x + 1 + + myMethod2 :: Int -> Int + myMethod2 x = x + 1 + +#test simple-instance-comment + +-- | This instance should be commented on +instance MyClass Int where + + -- | This method is also comment-worthy + myMethod x = x + 1 + +#test instance-with-type-family + +instance MyClass Int where + type MyType = Int + + myMethod :: MyType -> Int + myMethod x = x + 1 + +#test instance-with-type-family-below-method + +instance MyClass Int where + + type MyType = String + + myMethod :: MyType -> Int + myMethod x = x + 1 + + type MyType = Int + +#test instance-with-data-family + +instance MyClass Int where + + -- | This data is very important + data MyData = IntData + { intData :: String + , intData2 :: Int + } + + myMethod :: MyData -> Int + myMethod = intData2 + +#test instance-with-data-family-below-method + +instance MyClass Int where + -- | This data is important + data MyData = Test Int Int + + myMethod :: MyData -> Int + myMethod = intData2 + + -- | This data is also important + data MyData2 = IntData + { intData :: String + -- ^ Interesting field + , intData2 :: Int + } + +#test instance-with-newtype-family-and-deriving + +{-# LANGUAGE TypeFamilies #-} + +module Lib where + +instance Foo () where + newtype Bar () = Baz () + deriving (Eq, Ord, Show) + bar = Baz + +#test instance-with-newtype-family-and-record + +instance Foo Int where + newtype Bar Int = BarInt + { unBarInt :: Int + } diff --git a/data/10-structured/decl-type-fam-ghc-9.blt b/data/10-structured/decl-type-fam-ghc-9.blt new file mode 100644 index 0000000..a85a3d5 --- /dev/null +++ b/data/10-structured/decl-type-fam-ghc-9.blt @@ -0,0 +1,134 @@ +#group decl/typefam/ghc9-support + + +#test type-instance-without-comment + +{-# language TypeFamilies #-} +type family F a +type instance F Int = IO Int + +#test type-instance-with-comment + +{-# language TypeFamilies #-} +type family F a +type instance F Int = IO Int -- x + +#test type-instance-with-module-header + +{-# language TypeFamilies #-} +module M where +type family F a +type instance F Int = IO Int + +#test newtype-instance-without-comment + +{-# language TypeFamilies #-} +data family F a +newtype instance F Int = N Int + +#test newtype-instance-with-comment + +{-# language TypeFamilies #-} +data family F a +newtype instance F Int = N Int -- x + +#test newtype-instance-with-module-header + +{-# language TypeFamilies #-} +module M where +data family F a +newtype instance F Int = N Int + +#test data-instance-without-comment + +{-# language TypeFamilies #-} +data family F a +data instance F Int = D Int + +#test data-instance-with-comment + +{-# language TypeFamilies #-} +data family F a +data instance F Int = D Int -- x + +#test data-instance-with-module-header + +{-# language TypeFamilies #-} +module M where +data family F a +data instance F Int = D Int + +#test instance-type-without-comment + +{-# language TypeFamilies #-} +class C a where + type family F a +instance C Int where + type F Int = IO Int + +#test instance-type-with-comment + +{-# language TypeFamilies #-} +class C a where + type family F a +instance C Int where + type F Int = IO Int -- x + +#test instance-type-with-module-header + +{-# language TypeFamilies #-} +module M where +class C a where + type family F a +instance C Int where + type F Int = IO Int + +#test instance-newtype-without-comment + +{-# language TypeFamilies #-} +class C a where + data family F a +instance C Int where + newtype F Int = N Int + +#test instance-newtype-with-comment + +{-# language TypeFamilies #-} +class C a where + data family F a +instance C Int where + newtype F Int = N Int -- x + +#test instance-newtype-with-module-header + +{-# language TypeFamilies #-} +module M where +class C a where + data family F a +instance C Int where + newtype F Int = N Int + +#test instance-data-without-comment + +{-# language TypeFamilies #-} +class C a where + data family F a +instance C Int where + data F Int = D Int + +#test instance-data-with-comment + +{-# language TypeFamilies #-} +class C a where + data family F a +instance C Int where + data F Int = D Int -- x + +#test instance-data-with-module-header + +{-# language TypeFamilies #-} +module M where +class C a where + data family F a +instance C Int where + data F Int = D Int diff --git a/data/10-structured/decl-type-fam-instance.blt b/data/10-structured/decl-type-fam-instance.blt new file mode 100644 index 0000000..46c1f9b --- /dev/null +++ b/data/10-structured/decl-type-fam-instance.blt @@ -0,0 +1,36 @@ +#group decl/typefam/instance + + +#test simple-typefam-instance + +type instance MyFam Bool = String + +#test simple-typefam-instance-param-type + +type instance MyFam (Maybe a) = a -> Bool + +#test simple-typefam-instance-parens +#pending the parens cause problems since ghc-8.8 + +type instance (MyFam (String -> Int)) = String + +#test simple-typefam-instance-overflow + +type instance MyFam ALongishType + = AMuchLongerTypeThanThat + -> AnEvenLongerTypeThanTheLastOne + -> ShouldDefinitelyOverflow + +#test simple-typefam-instance-comments + +-- | A happy family +type instance MyFam Bool -- This is an odd one + = AnotherType -- Here's another + +#test simple-typefam-instance-parens-comment +#pending the parens cause problems since ghc-8.8 + +-- | A happy family +type instance (MyFam Bool) -- This is an odd one + = -- Here's another + AnotherType diff --git a/data/10-structured/expression-basic.blt b/data/10-structured/expression-basic.blt new file mode 100644 index 0000000..3a5d208 --- /dev/null +++ b/data/10-structured/expression-basic.blt @@ -0,0 +1,148 @@ +#group expression/basic + + +#test var +func = x + +describe "infix op" $ do +#test 1 +func = x + x + +#test long +func = + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj + + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj + +#test long keep linemode 1 +func = + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj + + mweroiuxlskdfjlksj + + mweroiuxlskdfjlksj + +#test long keep linemode 2 +func = + mweroiuxlskdfjlksj + + mweroiuxlskdfjlksj + + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj + +#test literals +func = 1 +func = "abc" +func = 1.1e5 +func = 'x' +func = 981409823458910394810928414192837123987123987123 + +#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 +func = (1 `abc`) + +#test right inf +func = (`abc` 1) + +### +#group tuples +### + +#test pair +func = (abc, def) + +#test pair section left +func = (abc, ) + +#test pair section right +func = (, abc) + +#test quintuple section long +myTupleSection = + ( verylaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaargefirstelement + , + , verylaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaargethirdelement + , + ) + +#test 2 +func = + ( lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd + , lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd + ) + +#test comment-after-then +foo = if True + then + -- iiiiii + "a " + else + "b " + +#test comment-after-if-else-do +func = if cond + then pure 42 + else do + -- test + abc + +#test nonempty-case-short +func = case x of + False -> False + True -> True + +#test nonempty-case-long +func = + case + lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd + lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd + of + False -> False + True -> True + +#test nonempty-case-long-do +func = do + case + lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd + lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd + of + False -> False + True -> True + +#test empty-case-short +func = case x of {} + +#test empty-case-long +func = + case + lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd + lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd + of {} + +#test empty-case-long-do +func = do + case + lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd + lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd + of {} diff --git a/data/10-structured/expression-do.blt b/data/10-structured/expression-do.blt new file mode 100644 index 0000000..a45bbf6 --- /dev/null +++ b/data/10-structured/expression-do.blt @@ -0,0 +1,17 @@ +#group expression/do + + +#test simple +func = do + stmt + stmt + +#test bind +func = do + x <- stmt + stmt x + +#test let +func = do + let x = 13 + stmt x diff --git a/data/10-structured/expression-let.blt b/data/10-structured/expression-let.blt new file mode 100644 index 0000000..890941e --- /dev/null +++ b/data/10-structured/expression-let.blt @@ -0,0 +1,27 @@ +#group expression/let + + +#test single-bind-comment-long +testMethod foo bar baz qux = + let x = undefined foo bar baz qux qux baz bar :: String + -- some comment explaining the in expression + in undefined foo x :: String + +#test single-bind-comment-short +testMethod foo bar baz qux = + let x = undefined :: String + -- some comment explaining the in expression + in undefined :: String + +#test single-bind-comment-before +testMethod foo bar baz qux = + -- some comment explaining the in expression + let x = undefined :: String in undefined :: String + +#test multiple-binds-comment +foo foo bar baz qux = + let a = 1 + b = 2 + c = 3 + -- some comment explaining the in expression + in undefined :: String diff --git a/data/10-structured/expression-special.blt b/data/10-structured/expression-special.blt new file mode 100644 index 0000000..dc4b7fe --- /dev/null +++ b/data/10-structured/expression-special.blt @@ -0,0 +1,19 @@ +#group expression.special + + +#test monad-comprehension-case-of +func = + foooooo + $ [ case + foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + of + _ -> True + ] + +#test operatorprefixalignment-even-with-multiline-alignbreak +func = + foo + $ [ aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + , bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb + ] + ++ [ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc] diff --git a/data/10-structured/fundecl.blt b/data/10-structured/fundecl.blt new file mode 100644 index 0000000..3f455bb --- /dev/null +++ b/data/10-structured/fundecl.blt @@ -0,0 +1,94 @@ +############################################################################### +#group decl/binding/basic +############################################################################### + +#test basic 1 +func x = x + +#test infix 1 +x *** y = x + +#test symbol prefix +(***) x y = x + +#test infix more args simple +(f >=> g) k = f k >>= g + +#test infix more args alignment +(Left a <$$> Left dd) e f = True +(Left a <$$> Right d ) e f = True +(Right a <$$> Left d ) e f = False +(Right a <$$> Right dd) e f = True + + +############################################################################### +#group decl/binding/patterns +############################################################################### + +#test wildcard +func _ = x + +#test simple long pattern +func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable = + x + +#test simple multiline pattern +func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable + = x + +#test another multiline pattern +func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable a b + = x + +#test simple constructor +func (A a) = a + +#test list constructor +func (x : xr) = x + +#test some other constructor symbol +func (x :+: xr) = x + +#test normal infix constructor +func (x `Foo` xr) = x + + +############################################################################### +#group decl/binding/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 long guard, another rather long guard that refers to x + = nontrivialexpression foo bar alsdkjlasdjlasj + | otherwise + = 0 + +#test multiple-clauses-5 +func x + | very loooooooooooooooooooooooooooooong guard + , another rather long guard that refers to x + = nontrivial expression foo bar alsdkjlasdjlasj + | otherwise + = 0 diff --git a/data/10-structured/module-imports.blt b/data/10-structured/module-imports.blt new file mode 100644 index 0000000..9c333a5 --- /dev/null +++ b/data/10-structured/module-imports.blt @@ -0,0 +1,271 @@ +#group module/imports + + +#test simple-import +import Data.List + +#test simple-import-alias +import Data.List as L + +#test simple-qualified-import +import qualified Data.List + +#test simple-qualified-import-alias +import qualified Data.List as L + +#test simple-safe +import safe Data.List as L + +#test simple-source +import {-# SOURCE #-} Data.List ( ) + +#test simple-safe-qualified +import safe qualified Data.List + +#test simple-safe-qualified-source +import {-# SOURCE #-} safe qualified Data.List + +#test simple-qualified-package +import qualified "base" Data.List + +#test qualifier-effect +import {-# SOURCE #-} safe qualified "base" Data.List as L +import {-# SOURCE #-} safe qualified "base" Data.List ( ) +import {-# SOURCE #-} safe qualified Data.List hiding ( ) + +#test instances-only +import qualified Data.List ( ) + +#test one-element +import Data.List ( nub ) + +#test several-elements +import Data.List ( foldl' + , indexElem + , nub + ) + +#test a-ridiculous-amount-of-elements +import Test ( Long + , anymore + , fit + , items + , line + , list + , not + , onA + , quite + , single + , that + , will + , with + ) + +#test with-things +import Test ( (+) + , (:!)(..) + , (:*)((:.), T7, t7) + , (:.) + , T + , T2() + , T3(..) + , T4(T4) + , T5(T5, t5) + , T6((<|>)) + ) + +#test hiding +import Test hiding ( ) +import Test as T + hiding ( ) + +#test import-hiding-many +import Prelude as X + hiding ( head + , init + , last + , maximum + , minimum + , pred + , read + , readFile + , succ + , tail + , undefined + ) + +#test long-module-name-simple +import TestJustAbitToLongModuleNameLikeThisOneIs + ( ) +import TestJustShortEnoughModuleNameLikeThisOne ( ) + +#test long-module-name-as +import TestJustAbitToLongModuleNameLikeThisOneI + as T +import TestJustShortEnoughModuleNameLikeThisOn as T + +#test long-module-name-hiding +import TestJustAbitToLongModuleNameLikeTh + hiding ( ) +import TestJustShortEnoughModuleNameLike hiding ( ) + +#test long-module-name-simple-items +import MoreThanSufficientlyLongModuleNameWithSome + ( compact + , fit + , inA + , items + , layout + , not + , that + , will + ) + +#test long-module-name-hiding-items +import TestJustAbitToLongModuleNameLikeTh + hiding ( abc + , def + , ghci + , jklm + ) +import TestJustShortEnoughModuleNameLike hiding ( abc + , def + , ghci + , jklm + ) + +#test long-module-name-other +import {-# SOURCE #-} safe qualified "qualifier" A hiding ( ) +import {-# SOURCE #-} safe qualified "qualifiers" A + hiding ( ) +import {-# SOURCE #-} safe qualified "qualifiers" AlsoAf as T +import {-# SOURCE #-} safe qualified "qualifiers" AlsoAff ( ) +import {-# SOURCE #-} safe qualified "qualifiers" AlsoAff + as T +import {-# SOURCE #-} safe qualified "qualifiers" AlsoAffe + ( ) + +#test import-with-comments +-- Test +import Data.List ( nub ) -- Test +{- Test -} +import qualified Data.List as L + ( foldl' ) {- Test -} + +-- Test +import Test ( test ) + +#test import-with-comments-2 + +import Test ( abc + , def + -- comment + ) + +#test import-with-comments-3 + +import Test ( abc + -- comment + ) + +#test import-with-comments-4 +import Test ( abc + -- comment + , def + , ghi + {- comment -} + , jkl + -- comment + ) + +#test import-with-comments-5 +import Test ( -- comment + ) + +#test long-bindings +import Test ( longbindingNameThatoverflowsColum + ) +import Test ( Long + ( List + , Of + , Things + ) + ) + +#test things-with-with-comments +import Test ( Thing + ( -- Comments + ) + ) +import Test ( Thing + ( Item + -- and Comment + ) + ) +import Test ( Thing + ( With + -- Comments + , and + -- also + , items + -- ! + ) + ) +#test prefer-dense-empty-list +import VeryLongModuleNameThatCouldEvenCauseAnEmptyBindingListToExpandIntoMultipleLine + ( ) + +#test preamble full-preamble +{-# LANGUAGE BangPatterns #-} + +{- + - Test module + -} +module Test + ( test1 + -- ^ test + , test2 + -- | test + , test3 + , test4 + , test5 + , test6 + , test7 + , test8 + , test9 + , test10 + -- Test 10 + ) where + +-- Test +import Data.List ( nub ) -- Test +{- Test -} +import qualified Data.List as L + ( foldl' ) {- Test -} + +-- Test +import Test ( test ) + +#test sorted-imports +import Aaa +import Baa + +#test sorted-import-groups +import Zaa +import Zab + +import Aaa +import Baa + +#test sorted-qualified-imports +import Boo +import qualified Zoo + +#test imports-groups-same-module +import Boo ( a ) + +import Boo ( b ) + +#test sorted-imports-nested +import A.B.C +import A.B.D diff --git a/data/10-structured/module-top.blt b/data/10-structured/module-top.blt new file mode 100644 index 0000000..50e51ab --- /dev/null +++ b/data/10-structured/module-top.blt @@ -0,0 +1,66 @@ +#group module/top + + +#test simple +module Main where + +#test no-exports +module Main () where + +#test one-export +module Main (main) where + +#test several-exports +module Main (main, test1, test2) where + +#test many-exports +module Main + ( main + , test1 + , test2 + , test3 + , test4 + , test5 + , test6 + , test7 + , test8 + , test9 + ) where + +#test exports-with-comments +module Main + ( main + -- main + , test1 + , test2 + -- Test 3 + , test3 + , test4 + -- Test 5 + , test5 + -- Test 6 + ) where + +#test simple-export-with-things +module Main (Test(..)) where + +#test simple-export-with-module-contents +module Main (module Main) where + +#test export-with-things +module Main (Test(Test, a, b)) where + +#test export-with-things-comment +-- comment1 + +module Main + ( Test(Test, a, b) + , foo -- comment2 + ) -- comment3 + where + +#test export-with-empty-thing +module Main (Test()) where + +#test empty-with-comment +-- Intentionally left empty diff --git a/data/10-structured/type-signatures-pragmas.blt b/data/10-structured/type-signatures-pragmas.blt new file mode 100644 index 0000000..87b4c82 --- /dev/null +++ b/data/10-structured/type-signatures-pragmas.blt @@ -0,0 +1,29 @@ +#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 noinline pragma 1 +{-# NOINLINE func #-} +func :: Int + +#test inline pragma 4 +func = f + where + {-# INLINE [~1] f #-} + f = id diff --git a/data/10-structured/type-signatures.blt b/data/10-structured/type-signatures.blt new file mode 100644 index 0000000..ed7c4c2 --- /dev/null +++ b/data/10-structured/type-signatures.blt @@ -0,0 +1,265 @@ +#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 nested tuples over line length +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 HsOpTy +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 forall context multiline with comments +{-# LANGUAGE RankNTypes #-} +addFlagStringParam + :: forall f out + . (Applicative f) + => String -- ^ short flag chars, i.e. "v" for -v + -> [String] -- ^ list of long names, i.e. ["verbose"] + -> String -- ^ param name + -> Flag String -- ^ properties + -> CmdParser f out String + +#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 +-- a +func -- b + :: -- c + a -- d + -> -- e + ( -- f + c -- g + , -- h + d -- i + ) -- j +-- k diff --git a/data/10-structured/type-synonyms.blt b/data/10-structured/type-synonyms.blt new file mode 100644 index 0000000..5885b5c --- /dev/null +++ b/data/10-structured/type-synonyms.blt @@ -0,0 +1,94 @@ +#group decl/type synonyms + + +#test simple-synonym + +type MySynonym = String + +#test parameterised-synonym + +type MySynonym a = [a] + +#test long-function-synonym + +-- | Important comment thrown in +type MySynonym b a + = MySynonym a b -> MySynonym a b -> MyParamType a b -> MyParamType a b + +#test overflowing-function-synonym + +type MySynonym3 b a + = MySynonym a b + -> MySynonym a b + -- ^ RandomComment + -> MyParamType a b + -> MyParamType a b + -> MySynonym2 b a + +#test synonym-with-kind-sig + +{-# LANGUAGE StarIsType #-} + +type MySynonym (a :: * -> *) + = MySynonym a b + -> MySynonym a b + -> MyParamType a b + -> MyParamType a b + -> MySynonym2 b a + +#test synonym-with-constraint + +type MySynonym a = Num a => a -> Int + +#test synonym-overflowing-with-constraint + +type MySynonym a + = Num a + => AReallyLongTypeName + -> AnotherReallyLongTypeName + -> AThirdTypeNameToOverflow + +#test synonym-forall + +{-# LANGUAGE RankNTypes #-} + +type MySynonym = forall a . [a] + +#test synonym-operator + +type (:+:) a b = (a, b) + +#test synonym-infix + +type a `MySynonym` b = a -> b + +#test synonym-infix-operator + +type a :+: b = (a, b) + +#test synonym-infix-parens + +type (a `Foo` b) c = (a, b, c) + +#test synonym-comments + +type Foo a -- fancy type comment + = -- strange comment + Int + +#test synonym-type-operators +type (a :+: b) = (a, b) + +#test synonym-multi-parens +#pending loses extra parens + +type ((a :+: b) c) = (a, c) + +#test synonym-tuple-type-many-comments + +type Foo + = ( -- t1 + A -- t2 + , -- t3 + B -- t4 + ) -- t5 diff --git a/data/10-tests.blt b/data/10-tests.blt deleted file mode 100644 index debf9aa..0000000 --- a/data/10-tests.blt +++ /dev/null @@ -1,1757 +0,0 @@ - -############################################################################### -############################################################################### -############################################################################### -#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 nested tuples over line length -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 HsOpTy -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 forall context multiline with comments -{-# LANGUAGE RankNTypes #-} -addFlagStringParam - :: forall f out - . (Applicative f) - => String -- ^ short flag chars, i.e. "v" for -v - -> [String] -- ^ list of long names, i.e. ["verbose"] - -> String -- ^ param name - -> Flag String -- ^ properties - -> CmdParser f out String - -#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 --- a -func -- b - :: -- c - a -- d - -> -- e - ( -- f - c -- g - , -- h - d -- i - ) -- j --- k - -############################################################################### -############################################################################### -############################################################################### -#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 noinline pragma 1 -{-# NOINLINE func #-} -func :: Int - -#test inline pragma 4 -func = f - where - {-# INLINE [~1] f #-} - f = id - - -############################################################################### -############################################################################### -############################################################################### -#group data type declarations -############################################################################### -############################################################################### -############################################################################### - -#test nullary data type -data Foo = Bar {} - -data Biz = Baz - -#test single record -data Foo = Bar - { foo :: Baz - } - -#test record multiple names -data Foo = Bar - { foo, bar :: Baz - } - -#test record multiple types -data Foo = Bar - { foo :: Baz - , bars :: Bizzz - } - -#test record multiple types and names -data Foo = Bar - { foo, biz :: Baz - , bar :: Bizzz - } - -#test record multiple types deriving -data Foo = Bar - { fooz :: Baz - , bar :: Bizzz - } - deriving Show - -#test record long field names -data MyRecord = MyConstructor - { bar1, bar2 - :: Loooooooooooooooooooooooooooooooong - -> Loooooooooooooooooooooooooooooooong - , foo1, foo2 - :: Loooooooooooooooooooooooooooooooonger - -> Loooooooooooooooooooooooooooooooonger - } - -#test record with DataTypeContexts -{-# LANGUAGE DatatypeContexts #-} -data - ( LooooooooooooooooooooongConstraint a - , LooooooooooooooooooooongConstraint b - ) => - MyRecord a b - = MyConstructor - { foo1, foo2 - :: loooooooooooooooooooooooooooooooong - -> loooooooooooooooooooooooooooooooong - , bar :: a - , bazz :: b - } - -#test record single line layout -#pending config flag is disabled for now -{-# LANGUAGE ScopedTypeVariables #-} --- brittany { lconfig_allowSinglelineRecord: true } -data MyRecord = forall a . Show a => MyCons { foo :: a -> a, i :: Int } - -#test record no matching single line layout -{-# LANGUAGE ScopedTypeVariables #-} --- brittany { lconfig_allowSinglelineRecord: true } -data MyRecord = forall a . Show a => Bar - { foo :: abittoolongbutnotvery -> abittoolongbutnotvery - } - -#test record forall constraint multiline -{-# LANGUAGE ScopedTypeVariables #-} -data MyRecord - = forall a - . LooooooooooooooooooooongConstraint a => - LoooooooooooongConstructor - { foo :: abittoolongbutnotvery -> abittoolongbutnotvery - } - -#test record forall constraint multiline more -{-# LANGUAGE ScopedTypeVariables #-} -data MyRecord - = forall a b - . ( Loooooooooooooooooooooooooooooooong a - , Loooooooooooooooooooooooooooooooong b - ) => - MyConstructor - { a :: a - , b :: b - } - -#test plain with forall and constraint -{-# LANGUAGE ScopedTypeVariables #-} -data MyStruct - = forall a b - . ( Loooooooooooooooooooooooooooooooong a - , Loooooooooooooooooooooooooooooooong b - ) => - MyConstructor (ToBriDocM BriDocNumbered) - (ToBriDocM BriDocNumbered) - (ToBriDocM BriDocNumbered) - -#test record with many features -{-# LANGUAGE ScopedTypeVariables #-} -data MyRecord - = forall a b - . ( Loooooooooooooooooooooooooooooooong a - , Loooooooooooooooooooooooooooooooong b - ) => - MyConstructor - { foo, foo2 - :: loooooooooooooooooooooooooooooooong - -> loooooooooooooooooooooooooooooooong - , bar :: a - , bazz :: b - } - deriving Show - -#test record multiple types deriving -data Foo = Bar - { foo :: Baz - , bars :: Bizzz - } - deriving (Show, Eq, Monad, Functor, Traversable, Foldable) - -#test record multiple deriving strategies -data Foo = Bar - { foo :: Baz - , bars :: Bizzz - } - deriving Show - deriving (Eq, Ord) - deriving stock Show - deriving stock (Eq, Ord) - deriving anyclass Show - deriving anyclass (Show, Eq, Monad, Functor) - deriving newtype Show - deriving newtype (Traversable, Foldable) - -#test record deriving via -data Foo = Bar - { foo :: Baz - , bars :: Bizzz - } - deriving ToJSON via (SomeType) - deriving (ToJSON, FromJSON) via (SomeType) - -#test single record existential -{-# LANGUAGE ExistentialQuantification #-} - -data Foo = forall a . Show a => Bar - { foo :: a - } - -#test record multiple types existential -{-# LANGUAGE ExistentialQuantification #-} - -data Foo = forall a b . (Show a, Eq b) => Bar - { foo :: a - , bars :: b - } - -#test plain comment simple --- before -data MyData = MyData Int --- after - -#test record newline comment -data MyRecord = MyRecord - { a :: Int - -- comment - , b :: Int - } - -#test record comments simple -data Foo = Bar -- a - { foo :: Baz -- b - , bars :: Bizzz -- c - } -- d - deriving (Show, Eq, Monad, Functor, Traversable, Foldable) -- e - -#test record comments strange inline -data Foo = Bar - { -- a - foo -- b - :: -- c - Baz -- d - , -- e - bars :: Bizzz - } - deriving (Show, Eq, Monad, Functor, Traversable, Foldable) - -#test record comments in deriving -## maybe we want to switch to a differnt layout when there are such comments. -## Don't hesitate to modify this testcase, it clearly is not the ideal layout -## for this. - -data Foo = Bar - { foo :: Baz - , bars :: Bizzz - } - -- a - deriving --b - ( -- c - ToJSON -- d - , -- e - FromJSON --f - ) -- g - -#test record comments in deriving via -## maybe we want to switch to a differnt layout when there are such comments. -## Don't hesitate to modify this testcase, it clearly is not the ideal layout -## for this. - -data Foo = Bar - { foo :: Baz - , bars :: Bizzz - } - -- a - deriving --a - ToJSON --b - via -- c - ( -- d - SomeType --e - , -- f - ABC --g - ) - -#test comment before equal sign -{-# LANGUAGE ExistentialQuantification #-} -data MyRecord - -- test comment - = forall a b - . ( Loooooooooooooooooooooooooooooooong a - , Loooooooooooooooooooooooooooooooong b - ) => - MyConstructor a b - -#test normal records on multi line indent policy left --- brittany {lconfig_indentPolicy: IndentPolicyLeft } -data EnterpriseGrantsForCompanyResponse = EnterpriseGrantsForCompanyResponse - Types.Company - [EnterpriseGrantResponse] - -#test normal records on multi line indent policy free --- brittany {lconfig_indentPolicy: IndentPolicyFree } -data GrantsForCompanyResp = GrantsForCompanyResp Types.Company - [EnterpriseGrantResponse] - -#test normal records on multi line indent policy free 2 --- brittany {lconfig_indentPolicy: IndentPolicyFree } -data EnterpriseGrantsForCompanyResponse = EnterpriseGrantsForCompanyResponse - Types.Company - [EnterpriseGrantResponse] - -#test normal records on multi line indent policy multiple --- brittany {lconfig_indentPolicy: IndentPolicyMultiple } -data GrantsForCompanyResp = GrantsForCompanyResp Types.Company - [EnterpriseGrantResponse] - -#test large record with a comment -data XIILqcacwiuNiu = XIILqcacwiuNiu - { oyyFtvbepgbOge_pebzVmuftEijwuj :: Jgtoyuh HessJvNlo - , wloQsiskdoxJop_xatiKrwedOxtu :: Jgtoyuh [Inotg] - , mmmJjcqtemyIyo_ovosDoreKeeoyamvove :: Jgtoyuh Eujo - , mbiIatelofxOzr_uluxNngiiMjah :: Jgtoyuh HessJvNlo - , obxIskfcxpkIkb_uuviTuevcSkrgo :: Jgtoyuh Int - , wqrAtuvuecoHwr_ilotNxbuPleo :: Jgtoyuh Ufaxdeq - , lofAfuebdhpLuv_cnekPoyFxmg :: Jgtoyuh Ufaxdeq - , ouoFugtawzvUpk_oupiLzptugy :: Jgtoyuh Eujo - , iqiXjtziwogNsa_uiyvSunaTtgUsf3 :: Jgtoyuh Oaivn - , odbIriaqnojUlz_onotoWuunehIpuy :: Jgtoyuh Eujo - , opjUxtkxzkiKse_luqjuZazt - :: Jgtoyuh [(Eujo, Int, Int, Int, Int, Int, NELUxro)] - -- , jcqRaqznxfhIpa_ywevMezmoYkutuwa :: Jgtoyuh () - , vayOmuasyphOfd_bcsVljmvt :: Jgtoyuh Eujo - , rifArahilooRax_ufikecqdImsv :: Jgtoyuh Oaivn - , raqKtopcpszDwb_oqocubasZuqjcryoDojGkw :: Jgtoyuh Oaivn - , mluJiilpcijUtt_gaisklifVekfeyagRmfbyzz :: Jgtoyuh Oaivn - , oqhPaahjupaSmi_gamwwoovKyxznecvEayluc :: Jgtoyuh Oaivn - , mazFubimwebZpa_itidehDodiDlboz :: Jgtoyuh Vrep - , jeyOcuesexaYoy_vpqn :: Jgtoyuh () - } - -############################################################################### -############################################################################### -############################################################################### -#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 - -#test infix more args simple -(f >=> g) k = f k >>= g - -#test infix more args alignment -(Left a <$$> Left dd) e f = True -(Left a <$$> Right d ) e f = True -(Right a <$$> Left d ) e f = False -(Right a <$$> Right dd) e f = True - - -############################################################################### -############################################################################### -############################################################################### -#group equation.patterns -############################################################################### -############################################################################### -############################################################################### - -#test wildcard -func _ = x - -#test simple long pattern -func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable = - x - -#test simple multiline pattern -func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable - = x - -#test another multiline pattern -func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable a b - = x - -#test simple constructor -func (A a) = a - -#test list constructor -func (x : xr) = x - -#test some other constructor symbol -func (x :+: xr) = x - -#test normal infix constructor -func (x `Foo` 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 long guard, another rather long guard that refers to x - = nontrivialexpression foo bar alsdkjlasdjlasj - | otherwise - = 0 - -#test multiple-clauses-5 -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 -func = - mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj - + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj - -#test long keep linemode 1 -func = - mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj - + mweroiuxlskdfjlksj - + mweroiuxlskdfjlksj - -#test long keep linemode 2 -func = - mweroiuxlskdfjlksj - + mweroiuxlskdfjlksj - + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj - -#test literals -func = 1 -func = "abc" -func = 1.1e5 -func = 'x' -func = 981409823458910394810928414192837123987123987123 - -#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 -func = (1 `abc`) - -#test right inf -func = (`abc` 1) - -### -#group tuples -### - -#test pair -func = (abc, def) - -#test pair section left -func = (abc, ) - -#test pair section right -func = (, abc) - -#test quintuple section long -myTupleSection = - ( verylaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaargefirstelement - , - , verylaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaargethirdelement - , - ) - -#test 2 -func = - ( lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd - , lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd - ) - -#test comment-after-then -foo = if True - then - -- iiiiii - "a " - else - "b " - -#test comment-after-if-else-do -func = if cond - then pure 42 - else do - -- test - abc - -#test nonempty-case-short -func = case x of - False -> False - True -> True - -#test nonempty-case-long -func = - case - lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd - lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd - of - False -> False - True -> True - -#test nonempty-case-long-do -func = do - case - lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd - lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd - of - False -> False - True -> True - -#test empty-case-short -func = case x of {} - -#test empty-case-long -func = - case - lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd - lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd - of {} - -#test empty-case-long-do -func = do - case - lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd - lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd - of {} - -############################################################################### -############################################################################### -############################################################################### -#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 expression.let -############################################################################### -############################################################################### -############################################################################### - -#test single-bind-comment-long -testMethod foo bar baz qux = - let x = undefined foo bar baz qux qux baz bar :: String - -- some comment explaining the in expression - in undefined foo x :: String - -#test single-bind-comment-short -testMethod foo bar baz qux = - let x = undefined :: String - -- some comment explaining the in expression - in undefined :: String - -#test single-bind-comment-before -testMethod foo bar baz qux = - -- some comment explaining the in expression - let x = undefined :: String in undefined :: String - -#test multiple-binds-comment -foo foo bar baz qux = - let a = 1 - b = 2 - c = 3 - -- some comment explaining the in expression - in undefined :: String - - -############################################################################### -############################################################################### -############################################################################### -#group stylisticspecialcases -############################################################################### -############################################################################### -############################################################################### - -#test operatorprefixalignment-even-with-multiline-alignbreak -func = - foo - $ [ aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa - , bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb - ] - ++ [ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc] - - -############################################################################### -############################################################################### -############################################################################### -#group module -############################################################################### -############################################################################### -############################################################################### - -#test simple -module Main where - -#test no-exports -module Main () where - -#test one-export -module Main (main) where - -#test several-exports -module Main (main, test1, test2) where - -#test many-exports -module Main - ( main - , test1 - , test2 - , test3 - , test4 - , test5 - , test6 - , test7 - , test8 - , test9 - ) where - -#test exports-with-comments -module Main - ( main - -- main - , test1 - , test2 - -- Test 3 - , test3 - , test4 - -- Test 5 - , test5 - -- Test 6 - ) where - -#test simple-export-with-things -module Main (Test(..)) where - -#test simple-export-with-module-contents -module Main (module Main) where - -#test export-with-things -module Main (Test(Test, a, b)) where - -#test export-with-things-comment --- comment1 - -module Main - ( Test(Test, a, b) - , foo -- comment2 - ) -- comment3 - where - -#test export-with-empty-thing -module Main (Test()) where - -#test empty-with-comment --- Intentionally left empty - -############################################################################### -############################################################################### -############################################################################### -#group module.import -############################################################################### -############################################################################### -############################################################################### - -#test simple-import -import Data.List - -#test simple-import-alias -import Data.List as L - -#test simple-qualified-import -import qualified Data.List - -#test simple-qualified-import-alias -import qualified Data.List as L - -#test simple-safe -import safe Data.List as L - -#test simple-source -import {-# SOURCE #-} Data.List ( ) - -#test simple-safe-qualified -import safe qualified Data.List - -#test simple-safe-qualified-source -import {-# SOURCE #-} safe qualified Data.List - -#test simple-qualified-package -import qualified "base" Data.List - -#test qualifier-effect -import {-# SOURCE #-} safe qualified "base" Data.List as L -import {-# SOURCE #-} safe qualified "base" Data.List ( ) -import {-# SOURCE #-} safe qualified Data.List hiding ( ) - -#test instances-only -import qualified Data.List ( ) - -#test one-element -import Data.List ( nub ) - -#test several-elements -import Data.List ( foldl' - , indexElem - , nub - ) - -#test a-ridiculous-amount-of-elements -import Test ( Long - , anymore - , fit - , items - , line - , list - , not - , onA - , quite - , single - , that - , will - , with - ) - -#test with-things -import Test ( (+) - , (:!)(..) - , (:*)((:.), T7, t7) - , (:.) - , T - , T2() - , T3(..) - , T4(T4) - , T5(T5, t5) - , T6((<|>)) - ) - -#test hiding -import Test hiding ( ) -import Test as T - hiding ( ) - -#test import-hiding-many -import Prelude as X - hiding ( head - , init - , last - , maximum - , minimum - , pred - , read - , readFile - , succ - , tail - , undefined - ) - -#test long-module-name-simple -import TestJustAbitToLongModuleNameLikeThisOneIs - ( ) -import TestJustShortEnoughModuleNameLikeThisOne ( ) - -#test long-module-name-as -import TestJustAbitToLongModuleNameLikeThisOneI - as T -import TestJustShortEnoughModuleNameLikeThisOn as T - -#test long-module-name-hiding -import TestJustAbitToLongModuleNameLikeTh - hiding ( ) -import TestJustShortEnoughModuleNameLike hiding ( ) - -#test long-module-name-simple-items -import MoreThanSufficientlyLongModuleNameWithSome - ( compact - , fit - , inA - , items - , layout - , not - , that - , will - ) - -#test long-module-name-hiding-items -import TestJustAbitToLongModuleNameLikeTh - hiding ( abc - , def - , ghci - , jklm - ) -import TestJustShortEnoughModuleNameLike hiding ( abc - , def - , ghci - , jklm - ) - -#test long-module-name-other -import {-# SOURCE #-} safe qualified "qualifier" A hiding ( ) -import {-# SOURCE #-} safe qualified "qualifiers" A - hiding ( ) -import {-# SOURCE #-} safe qualified "qualifiers" AlsoAf as T -import {-# SOURCE #-} safe qualified "qualifiers" AlsoAff ( ) -import {-# SOURCE #-} safe qualified "qualifiers" AlsoAff - as T -import {-# SOURCE #-} safe qualified "qualifiers" AlsoAffe - ( ) - -#test import-with-comments --- Test -import Data.List ( nub ) -- Test -{- Test -} -import qualified Data.List as L - ( foldl' ) {- Test -} - --- Test -import Test ( test ) - -#test import-with-comments-2 - -import Test ( abc - , def - -- comment - ) - -#test import-with-comments-3 - -import Test ( abc - -- comment - ) - -#test import-with-comments-4 -import Test ( abc - -- comment - , def - , ghi - {- comment -} - , jkl - -- comment - ) - -#test import-with-comments-5 -import Test ( -- comment - ) - -#test long-bindings -import Test ( longbindingNameThatoverflowsColum - ) -import Test ( Long - ( List - , Of - , Things - ) - ) - -#test things-with-with-comments -import Test ( Thing - ( -- Comments - ) - ) -import Test ( Thing - ( Item - -- and Comment - ) - ) -import Test ( Thing - ( With - -- Comments - , and - -- also - , items - -- ! - ) - ) -#test prefer-dense-empty-list -import VeryLongModuleNameThatCouldEvenCauseAnEmptyBindingListToExpandIntoMultipleLine - ( ) - -#test preamble full-preamble -{-# LANGUAGE BangPatterns #-} - -{- - - Test module - -} -module Test - ( test1 - -- ^ test - , test2 - -- | test - , test3 - , test4 - , test5 - , test6 - , test7 - , test8 - , test9 - , test10 - -- Test 10 - ) where - --- Test -import Data.List ( nub ) -- Test -{- Test -} -import qualified Data.List as L - ( foldl' ) {- Test -} - --- Test -import Test ( test ) - -#test sorted-imports -import Aaa -import Baa - -#test sorted-import-groups -import Zaa -import Zab - -import Aaa -import Baa - -#test sorted-qualified-imports -import Boo -import qualified Zoo - -#test imports-groups-same-module -import Boo ( a ) - -import Boo ( b ) - -#test sorted-imports-nested -import A.B.C -import A.B.D - -############################################################################### -############################################################################### -############################################################################### -#group type synonyms -############################################################################### -############################################################################### -############################################################################### - -#test simple-synonym - -type MySynonym = String - -#test parameterised-synonym - -type MySynonym a = [a] - -#test long-function-synonym - --- | Important comment thrown in -type MySynonym b a - = MySynonym a b -> MySynonym a b -> MyParamType a b -> MyParamType a b - -#test overflowing-function-synonym - -type MySynonym3 b a - = MySynonym a b - -> MySynonym a b - -- ^ RandomComment - -> MyParamType a b - -> MyParamType a b - -> MySynonym2 b a - -#test synonym-with-kind-sig - -{-# LANGUAGE StarIsType #-} - -type MySynonym (a :: * -> *) - = MySynonym a b - -> MySynonym a b - -> MyParamType a b - -> MyParamType a b - -> MySynonym2 b a - -#test synonym-with-constraint - -type MySynonym a = Num a => a -> Int - -#test synonym-overflowing-with-constraint - -type MySynonym a - = Num a - => AReallyLongTypeName - -> AnotherReallyLongTypeName - -> AThirdTypeNameToOverflow - -#test synonym-forall - -{-# LANGUAGE RankNTypes #-} - -type MySynonym = forall a . [a] - -#test synonym-operator - -type (:+:) a b = (a, b) - -#test synonym-infix - -type a `MySynonym` b = a -> b - -#test synonym-infix-operator - -type a :+: b = (a, b) - -#test synonym-infix-parens - -type (a `Foo` b) c = (a, b, c) - -#test synonym-comments - -type Foo a -- fancy type comment - = -- strange comment - Int - -#test synonym-type-operators -type (a :+: b) = (a, b) - -#test synonym-multi-parens -#pending loses extra parens - -type ((a :+: b) c) = (a, c) - -#test synonym-tuple-type-many-comments - -type Foo - = ( -- t1 - A -- t2 - , -- t3 - B -- t4 - ) -- t5 - -############################################################################### -############################################################################### -############################################################################### -#group class.instance -############################################################################### -############################################################################### -############################################################################### - -#test simple-instance - -instance MyClass Int where - myMethod x = x + 1 - -#test simple-method-comment - -instance MyClass Int where - myMethod x = - -- insightful comment - x + 1 - -#test simple-method-signature - -instance MyClass Int where - myMethod :: Int -> Int - myMethod x = x + 1 - -#test simple-long-method-signature - -instance MyClass Int where - myMethod - :: Int - -> Int - -> AReallyLongType - -> AReallyLongType - -> AReallyLongType - -> Int - myMethod x = x + 1 - -#test simple-two-methods - -instance MyClass Int where - myMethod x = x + 1 - myMethod2 x = x + 1 - -#test simple-two-signatures - -instance MyClass Int where - myMethod - :: Int - -> Int - -> AReallyLongType - -> AReallyLongType - -> AReallyLongType - -> Int - myMethod x = x + 1 - - myMethod2 :: Int -> Int - myMethod2 x = x + 1 - -#test simple-instance-comment - --- | This instance should be commented on -instance MyClass Int where - - -- | This method is also comment-worthy - myMethod x = x + 1 - -#test instance-with-type-family - -instance MyClass Int where - type MyType = Int - - myMethod :: MyType -> Int - myMethod x = x + 1 - -#test instance-with-type-family-below-method - -instance MyClass Int where - - type MyType = String - - myMethod :: MyType -> Int - myMethod x = x + 1 - - type MyType = Int - -#test instance-with-data-family - -instance MyClass Int where - - -- | This data is very important - data MyData = IntData - { intData :: String - , intData2 :: Int - } - - myMethod :: MyData -> Int - myMethod = intData2 - -#test instance-with-data-family-below-method - -instance MyClass Int where - -- | This data is important - data MyData = Test Int Int - - myMethod :: MyData -> Int - myMethod = intData2 - - -- | This data is also important - data MyData2 = IntData - { intData :: String - -- ^ Interesting field - , intData2 :: Int - } - -#test instance-with-newtype-family-and-deriving - -{-# LANGUAGE TypeFamilies #-} - -module Lib where - -instance Foo () where - newtype Bar () = Baz () - deriving (Eq, Ord, Show) - bar = Baz - -#test instance-with-newtype-family-and-record - -instance Foo Int where - newtype Bar Int = BarInt - { unBarInt :: Int - } - -############################################################################### -############################################################################### -############################################################################### -#group gh-357 -############################################################################### -############################################################################### -############################################################################### - -#test type-instance-without-comment - -{-# language TypeFamilies #-} -type family F a -type instance F Int = IO Int - -#test type-instance-with-comment - -{-# language TypeFamilies #-} -type family F a -type instance F Int = IO Int -- x - -#test type-instance-with-module-header - -{-# language TypeFamilies #-} -module M where -type family F a -type instance F Int = IO Int - -#test newtype-instance-without-comment - -{-# language TypeFamilies #-} -data family F a -newtype instance F Int = N Int - -#test newtype-instance-with-comment - -{-# language TypeFamilies #-} -data family F a -newtype instance F Int = N Int -- x - -#test newtype-instance-with-module-header - -{-# language TypeFamilies #-} -module M where -data family F a -newtype instance F Int = N Int - -#test data-instance-without-comment - -{-# language TypeFamilies #-} -data family F a -data instance F Int = D Int - -#test data-instance-with-comment - -{-# language TypeFamilies #-} -data family F a -data instance F Int = D Int -- x - -#test data-instance-with-module-header - -{-# language TypeFamilies #-} -module M where -data family F a -data instance F Int = D Int - -#test instance-type-without-comment - -{-# language TypeFamilies #-} -class C a where - type family F a -instance C Int where - type F Int = IO Int - -#test instance-type-with-comment - -{-# language TypeFamilies #-} -class C a where - type family F a -instance C Int where - type F Int = IO Int -- x - -#test instance-type-with-module-header - -{-# language TypeFamilies #-} -module M where -class C a where - type family F a -instance C Int where - type F Int = IO Int - -#test instance-newtype-without-comment - -{-# language TypeFamilies #-} -class C a where - data family F a -instance C Int where - newtype F Int = N Int - -#test instance-newtype-with-comment - -{-# language TypeFamilies #-} -class C a where - data family F a -instance C Int where - newtype F Int = N Int -- x - -#test instance-newtype-with-module-header - -{-# language TypeFamilies #-} -module M where -class C a where - data family F a -instance C Int where - newtype F Int = N Int - -#test instance-data-without-comment - -{-# language TypeFamilies #-} -class C a where - data family F a -instance C Int where - data F Int = D Int - -#test instance-data-with-comment - -{-# language TypeFamilies #-} -class C a where - data family F a -instance C Int where - data F Int = D Int -- x - -#test instance-data-with-module-header - -{-# language TypeFamilies #-} -module M where -class C a where - data family F a -instance C Int where - data F Int = D Int - -############################################################################### -############################################################################### -############################################################################### -#group whitespace-newlines -############################################################################### -############################################################################### -############################################################################### - -#test module-import-newlines - -module Main where - -import Prelude - -firstDecl = True - -#test function-where-newlines - -func = do - - -- complex first step - aaa - - -- complex second step - bbb - - where - - helper :: Helper - helper = helpful - - other :: Other - other = True - - -############################################################################### -############################################################################### -############################################################################### -#group typefam.instance -############################################################################### -############################################################################### -############################################################################### - -#test simple-typefam-instance - -type instance MyFam Bool = String - -#test simple-typefam-instance-param-type - -type instance MyFam (Maybe a) = a -> Bool - -#test simple-typefam-instance-parens -#pending the parens cause problems since ghc-8.8 - -type instance (MyFam (String -> Int)) = String - -#test simple-typefam-instance-overflow - -type instance MyFam ALongishType - = AMuchLongerTypeThanThat - -> AnEvenLongerTypeThanTheLastOne - -> ShouldDefinitelyOverflow - -#test simple-typefam-instance-comments - --- | A happy family -type instance MyFam Bool -- This is an odd one - = AnotherType -- Here's another - -#test simple-typefam-instance-parens-comment -#pending the parens cause problems since ghc-8.8 - --- | A happy family -type instance (MyFam Bool) -- This is an odd one - = -- Here's another - AnotherType diff --git a/data/11-extensions/implicitparams.blt b/data/11-extensions/implicitparams.blt new file mode 100644 index 0000000..e63c16c --- /dev/null +++ b/data/11-extensions/implicitparams.blt @@ -0,0 +1,28 @@ +#group extensions/implicitparams + + +#test ImplicitParams 1 +{-# LANGUAGE ImplicitParams #-} +func :: (?asd::Int) -> () + +#test ImplicitParams 2 +{-# LANGUAGE ImplicitParams #-} +func + :: ( ?asd + :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + ) + -> () + +#test IP usage +{-# LANGUAGE ImplicitParams #-} +foo = ?bar + +#test IP binding +{-# LANGUAGE ImplicitParams #-} +foo = let ?bar = Foo in value + +#test IP type signature +{-# LANGUAGE ImplicitParams #-} +foo :: (?bar::Bool) => () +foo = () diff --git a/data/11-extensions/lambdacase.blt b/data/11-extensions/lambdacase.blt new file mode 100644 index 0000000..23274cb --- /dev/null +++ b/data/11-extensions/lambdacase.blt @@ -0,0 +1,8 @@ +#group extensions/lambdacase + + +#test lambdacase 1 +{-# LANGUAGE LambdaCase #-} +func = \case + FooBar -> x + Baz -> y diff --git a/data/11-extensions/multiwayif.blt b/data/11-extensions/multiwayif.blt new file mode 100644 index 0000000..7c796d2 --- /dev/null +++ b/data/11-extensions/multiwayif.blt @@ -0,0 +1,16 @@ +#group extensions/multiwayif + + +#test multiwayif 1 +{-# LANGUAGE MultiWayIf #-} +func = if + | cond1 -> loooooooooooooooooooooooooooooong expr1 + | cond2 -> loooooooooooooooooooooooooooooong expr2 + +#test multiwayif 2 +{-# LANGUAGE MultiWayIf #-} +func = do + foo + bar $ if + | cond1 -> loooooooooooooooooooooooooooooong expr1 + | cond2 -> loooooooooooooooooooooooooooooong expr2 diff --git a/data/11-extensions/overloadedlabels.blt b/data/11-extensions/overloadedlabels.blt new file mode 100644 index 0000000..ed18093 --- /dev/null +++ b/data/11-extensions/overloadedlabels.blt @@ -0,0 +1,10 @@ +#group extensions/overloadedlabels + + +#test bare label +{-# LANGUAGE OverloadedLabels #-} +foo = #bar + +#test applied and composed label +{-# LANGUAGE OverloadedLabels #-} +foo = #bar . #baz $ fmap #foo xs diff --git a/data/11-extensions/patternsynonyms.blt b/data/11-extensions/patternsynonyms.blt new file mode 100644 index 0000000..e5d4f1b --- /dev/null +++ b/data/11-extensions/patternsynonyms.blt @@ -0,0 +1,100 @@ +#group extensions/patternsynonyms + + +#test bidirectional pattern +{-# LANGUAGE PatternSynonyms #-} +pattern J x = Just x + +#test unidirection pattern +{-# LANGUAGE PatternSynonyms #-} +pattern F x <- (x, _) + +#test explicitly bidirectional pattern +{-# LANGUAGE PatternSynonyms #-} +pattern HeadC x <- x : xs where + HeadC x = [x] + +#test Multiple arguments +{-# LANGUAGE PatternSynonyms #-} +pattern Head2 x y <- x : y : xs where + Head2 x y = [x, y] + +#test Infix argument +{-# LANGUAGE PatternSynonyms #-} +pattern x :> y = [x, y] + +#test Record argument +{-# LANGUAGE PatternSynonyms #-} +pattern MyData { a, b, c } = [a, b, c] + +#test long pattern match +{-# LANGUAGE PatternSynonyms #-} +pattern myLongLeftVariableName `MyLongInfixPatternMatcher` myLongRightVariableName = + [myLongLeftVariableName, myLongRightVariableName] + +#test long explicitly bidirectional match +{-# LANGUAGE PatternSynonyms #-} +pattern myLeftVariableName `MyInfixPatternMatcher` myRightVariableName <- + [myLongLeftVariableName, myLongRightVariableName] where + MyInfixPatternMatcher x y = [x, x, y] + +#test Pattern synonym types +{-# LANGUAGE PatternSynonyms #-} +pattern J :: a -> Maybe a +pattern J x = Just x + +#test pattern synonym bidirectional multiple cases +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} +pattern Signed x <- (asSigned -> x) where + Signed (Neg x) = -x + Signed Zero = 0 + Signed (Pos x) = x + +#test pattern synonym bidirectional multiple cases long +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} +pattern Signed xxxxxxxxxxxxxxxxxxxxxxxx <- + (asSigned -> xxxxxxxxxxxxxxxxxxxxxxxx) where + Signed (Neg x) = -x + Signed Zero = 0 + Signed (Pos x) = x + +#test pattern synonym bidirectional multiple cases with comments +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} +pattern Signed x <- (asSigned -> x) where + Signed (Neg x) = -x -- negative comment + Signed Zero = 0 -- zero comment + Signed (Pos x) = x -- positive comment + +#test Pattern synonym types multiple names +{-# LANGUAGE PatternSynonyms #-} +pattern J, K :: a -> Maybe a + +#test Pattern synonym type sig wrapped +{-# LANGUAGE PatternSynonyms #-} +pattern LongMatcher + :: longlongtypevar + -> longlongtypevar + -> longlongtypevar + -> Maybe [longlongtypevar] +pattern LongMatcher x y z = Just [x, y, z] + + +#group extensions/patternsynonyms+explicitnamespaces + + +#test explicitnamespaces_patternsynonyms export +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE PatternSynonyms #-} +module Test (type (++), (++), pattern Foo) where + +#test explicitnamespaces_patternsynonyms import +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE PatternSynonyms #-} +import Test ( type (++) + , (++) + , pattern (:.) + , pattern Foo + ) diff --git a/data/11-extensions/quasiquotes.blt b/data/11-extensions/quasiquotes.blt new file mode 100644 index 0000000..ed27aee --- /dev/null +++ b/data/11-extensions/quasiquotes.blt @@ -0,0 +1,34 @@ +#group extensions/quasiquotes + + +#test quasi-quotes simple 1 +{-# LANGUAGE QuasiQuotes #-} +func = [blub| + asd + qwe + |] + +#test quasi-quotes simple 2 +{-# LANGUAGE QuasiQuotes #-} +func = [blub| + asd + qwe|] + +#test quasi-quotes ignoring layouting +{-# LANGUAGE QuasiQuotes #-} +func = do + let body = [json| + hello + |] + pure True + +#test quasi-quotes ignoring layouting, strict mode +-- brittany { lconfig_allowHangingQuasiQuotes: False } +{-# LANGUAGE QuasiQuotes #-} +func = do + let + body = + [json| + hello + |] + pure True diff --git a/data/11-extensions/recursivedo.blt b/data/11-extensions/recursivedo.blt new file mode 100644 index 0000000..30ddb12 --- /dev/null +++ b/data/11-extensions/recursivedo.blt @@ -0,0 +1,17 @@ +#group extensions/recursivedo + + +#test recursivedo 1 +{-# LANGUAGE RecursiveDo #-} +foo = do + rec a <- f b + b <- g a + return (a, b) + +#test recursivedo 2 +{-# LANGUAGE RecursiveDo #-} +foo = do + rec -- comment + a <- f b + b <- g a + return (a, b) diff --git a/data/11-extensions/unboxedtuples.blt b/data/11-extensions/unboxedtuples.blt new file mode 100644 index 0000000..1f43f6d --- /dev/null +++ b/data/11-extensions/unboxedtuples.blt @@ -0,0 +1,14 @@ +#group extensions/unboxedtuples + + +#test unboxed-tuple and vanilla names +{-# LANGUAGE UnboxedTuples #-} +spanKey :: (# Int, Int #) -> (# Int, Int #) +spanKey = case foo of + (# bar, baz #) -> (# baz, bar #) + +#test unboxed-tuple and hashed name +{-# LANGUAGE MagicHash, UnboxedTuples #-} +spanKey :: (# Int#, Int# #) -> (# Int#, Int# #) +spanKey = case foo of + (# bar#, baz# #) -> (# baz# +# bar#, bar# #) diff --git a/data/12-other.blt b/data/12-other.blt new file mode 100644 index 0000000..8cfb681 --- /dev/null +++ b/data/12-other.blt @@ -0,0 +1,27 @@ +#group other/whitespace-newlines + +#test module-import-newlines + +module Main where + +import Prelude + +firstDecl = True + +#test function-where-newlines + +func = do + + -- complex first step + aaa + + -- complex second step + bbb + + where + + helper :: Helper + helper = helpful + + other :: Other + other = True diff --git a/data/14-extensions.blt b/data/14-extensions.blt deleted file mode 100644 index 18fc24f..0000000 --- a/data/14-extensions.blt +++ /dev/null @@ -1,241 +0,0 @@ -############################################################################### -############################################################################### -############################################################################### -#group extensions -############################################################################### -############################################################################### -############################################################################### - -############################################################################### -## MultiWayIf -#test multiwayif 1 -{-# LANGUAGE MultiWayIf #-} -func = if - | cond1 -> loooooooooooooooooooooooooooooong expr1 - | cond2 -> loooooooooooooooooooooooooooooong expr2 - -#test multiwayif 2 -{-# LANGUAGE MultiWayIf #-} -func = do - foo - bar $ if - | cond1 -> loooooooooooooooooooooooooooooong expr1 - | cond2 -> loooooooooooooooooooooooooooooong expr2 - - -############################################################################### -## LambdaCase -#test lambdacase 1 -{-# LANGUAGE LambdaCase #-} -func = \case - FooBar -> x - Baz -> y - - - -############################################################################### -## ImplicitParams -#test ImplicitParams 1 -{-# LANGUAGE ImplicitParams #-} -func :: (?asd::Int) -> () - -#test ImplicitParams 2 -{-# LANGUAGE ImplicitParams #-} -func - :: ( ?asd - :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd - -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd - ) - -> () - - -############################################################################### -## RecursiveDo -#test recursivedo 1 -{-# LANGUAGE RecursiveDo #-} -foo = do - rec a <- f b - b <- g a - return (a, b) - -#test recursivedo 2 -{-# LANGUAGE RecursiveDo #-} -foo = do - rec -- comment - a <- f b - b <- g a - return (a, b) - -############################################################################### -## ExplicitNamespaces + PatternSynonyms -#test explicitnamespaces_patternsynonyms export -{-# LANGUAGE ExplicitNamespaces #-} -{-# LANGUAGE PatternSynonyms #-} -module Test (type (++), (++), pattern Foo) where - -#test explicitnamespaces_patternsynonyms import -{-# LANGUAGE ExplicitNamespaces #-} -{-# LANGUAGE PatternSynonyms #-} -import Test ( type (++) - , (++) - , pattern (:.) - , pattern Foo - ) - -############################################################################### -## PatternSynonyms -#test bidirectional pattern -{-# LANGUAGE PatternSynonyms #-} -pattern J x = Just x - -#test unidirection pattern -{-# LANGUAGE PatternSynonyms #-} -pattern F x <- (x, _) - -#test explicitly bidirectional pattern -{-# LANGUAGE PatternSynonyms #-} -pattern HeadC x <- x : xs where - HeadC x = [x] - -#test Multiple arguments -{-# LANGUAGE PatternSynonyms #-} -pattern Head2 x y <- x : y : xs where - Head2 x y = [x, y] - -#test Infix argument -{-# LANGUAGE PatternSynonyms #-} -pattern x :> y = [x, y] - -#test Record argument -{-# LANGUAGE PatternSynonyms #-} -pattern MyData { a, b, c } = [a, b, c] - -#test long pattern match -{-# LANGUAGE PatternSynonyms #-} -pattern myLongLeftVariableName `MyLongInfixPatternMatcher` myLongRightVariableName = - [myLongLeftVariableName, myLongRightVariableName] - -#test long explicitly bidirectional match -{-# LANGUAGE PatternSynonyms #-} -pattern myLeftVariableName `MyInfixPatternMatcher` myRightVariableName <- - [myLongLeftVariableName, myLongRightVariableName] where - MyInfixPatternMatcher x y = [x, x, y] - -#test Pattern synonym types -{-# LANGUAGE PatternSynonyms #-} -pattern J :: a -> Maybe a -pattern J x = Just x - -#test pattern synonym bidirectional multiple cases -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE ViewPatterns #-} -pattern Signed x <- (asSigned -> x) where - Signed (Neg x) = -x - Signed Zero = 0 - Signed (Pos x) = x - -#test pattern synonym bidirectional multiple cases long -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE ViewPatterns #-} -pattern Signed xxxxxxxxxxxxxxxxxxxxxxxx <- - (asSigned -> xxxxxxxxxxxxxxxxxxxxxxxx) where - Signed (Neg x) = -x - Signed Zero = 0 - Signed (Pos x) = x - -#test pattern synonym bidirectional multiple cases with comments -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE ViewPatterns #-} -pattern Signed x <- (asSigned -> x) where - Signed (Neg x) = -x -- negative comment - Signed Zero = 0 -- zero comment - Signed (Pos x) = x -- positive comment - -#test Pattern synonym types multiple names -{-# LANGUAGE PatternSynonyms #-} -pattern J, K :: a -> Maybe a - -#test Pattern synonym type sig wrapped -{-# LANGUAGE PatternSynonyms #-} -pattern LongMatcher - :: longlongtypevar - -> longlongtypevar - -> longlongtypevar - -> Maybe [longlongtypevar] -pattern LongMatcher x y z = Just [x, y, z] - - -############################################################################### -## UnboxedTuples + MagicHash -#test unboxed-tuple and vanilla names -{-# LANGUAGE UnboxedTuples #-} -spanKey :: (# Int, Int #) -> (# Int, Int #) -spanKey = case foo of - (# bar, baz #) -> (# baz, bar #) - -#test unboxed-tuple and hashed name -{-# LANGUAGE MagicHash, UnboxedTuples #-} -spanKey :: (# Int#, Int# #) -> (# Int#, Int# #) -spanKey = case foo of - (# bar#, baz# #) -> (# baz# +# bar#, bar# #) - - -############################################################################### -## QuasiQuotes -#test quasi-quotes simple 1 -{-# LANGUAGE QuasiQuotes #-} -func = [blub| - asd - qwe - |] - -#test quasi-quotes simple 2 -{-# LANGUAGE QuasiQuotes #-} -func = [blub| - asd - qwe|] - -#test quasi-quotes ignoring layouting -{-# LANGUAGE QuasiQuotes #-} -func = do - let body = [json| - hello - |] - pure True - -#test quasi-quotes ignoring layouting, strict mode --- brittany { lconfig_allowHangingQuasiQuotes: False } -{-# LANGUAGE QuasiQuotes #-} -func = do - let - body = - [json| - hello - |] - pure True - -############################################################################### -## OverloadedLabels -#test bare label -{-# LANGUAGE OverloadedLabels #-} -foo = #bar - -#test applied and composed label -{-# LANGUAGE OverloadedLabels #-} -foo = #bar . #baz $ fmap #foo xs - -############################################################################### -## ImplicitParams - -#test IP usage -{-# LANGUAGE ImplicitParams #-} -foo = ?bar - -#test IP binding -{-# LANGUAGE ImplicitParams #-} -foo = let ?bar = Foo in value - -#test IP type signature -{-# LANGUAGE ImplicitParams #-} -foo :: (?bar::Bool) => () -foo = () diff --git a/data/30-tests-context-free.blt b/data/30-tests-context-free.blt index d73e6d4..56a779d 100644 --- a/data/30-tests-context-free.blt +++ b/data/30-tests-context-free.blt @@ -2,7 +2,7 @@ ############################################################################### ############################################################################### ############################################################################### -#group type signatures +#group context-free/type signatures ############################################################################### ############################################################################### ############################################################################### @@ -279,7 +279,7 @@ func ############################################################################### ############################################################################### ############################################################################### -#group type signatures pragmas +#group context-free/type signatures pragmas ############################################################################### ############################################################################### ############################################################################### @@ -312,7 +312,7 @@ func = f ############################################################################### ############################################################################### ############################################################################### -#group data type declarations +#group context-free/data type declarations ############################################################################### ############################################################################### ############################################################################### @@ -357,7 +357,7 @@ data Foo = Bar ############################################################################### ############################################################################### ############################################################################### -#group equation.basic +#group context-free/equation.basic ############################################################################### ############################################################################### ############################################################################### @@ -378,7 +378,7 @@ x *** y = x ############################################################################### ############################################################################### ############################################################################### -#group equation.patterns +#group context-free/equation.patterns ############################################################################### ############################################################################### ############################################################################### @@ -411,7 +411,7 @@ func (x :+: xr) = x ############################################################################### ############################################################################### ############################################################################### -#group equation.guards +#group context-free/equation.guards ############################################################################### ############################################################################### ############################################################################### @@ -456,7 +456,7 @@ func x ############################################################################### ############################################################################### ############################################################################### -#group expression.basic +#group context-free/expression.basic ############################################################################### ############################################################################### ############################################################################### @@ -517,7 +517,7 @@ func = lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd lakjsdlajsdljas ### -#group expression.basic.sections +#group context-free/expression.basic.sections ### #test left @@ -534,7 +534,7 @@ func = (1 `abc`) func = (`abc` 1) ### -#group tuples +#group context-free/tuples ### #test 1 @@ -556,7 +556,7 @@ foo = ############################################################################### ############################################################################### ############################################################################### -#group expression.do statements +#group context-free/expression.do statements ############################################################################### ############################################################################### ############################################################################### @@ -580,7 +580,7 @@ func = do ############################################################################### ############################################################################### ############################################################################### -#group expression.lists +#group context-free/expression.lists ############################################################################### ############################################################################### ############################################################################### @@ -598,7 +598,7 @@ func = ############################################################################### ############################################################################### ############################################################################### -#group expression.multiwayif +#group context-free/expression.multiwayif ############################################################################### ############################################################################### ############################################################################### @@ -621,7 +621,7 @@ func = do ############################################################################### ############################################################################### ############################################################################### -#group stylisticspecialcases +#group context-free/stylisticspecialcases ############################################################################### ############################################################################### ############################################################################### @@ -637,7 +637,7 @@ func = ############################################################################### ############################################################################### ############################################################################### -#group module +#group context-free/module ############################################################################### ############################################################################### ############################################################################### @@ -700,7 +700,7 @@ module Main (Test()) where ############################################################################### ############################################################################### ############################################################################### -#group import +#group context-free/import ############################################################################### ############################################################################### ############################################################################### @@ -915,7 +915,7 @@ import Test (test) ############################################################################### ############################################################################### ############################################################################### -#group regression +#group context-free/regression ############################################################################### ############################################################################### ############################################################################### @@ -1428,7 +1428,7 @@ record = Record ############################################################################### ############################################################################### ############################################################################### -#group pending +#group context-free/pending ############################################################################### ############################################################################### ############################################################################### diff --git a/source/test-suite/Main.hs b/source/test-suite/Main.hs index 36e79ef..056e025 100644 --- a/source/test-suite/Main.hs +++ b/source/test-suite/Main.hs @@ -9,6 +9,8 @@ import qualified Data.Semigroup as Semigroup import qualified Data.Text as Text import qualified Data.Text.IO as Text.IO import qualified GHC.OldList as List +import qualified Data.Map.Strict as Map +import Data.These import Language.Haskell.Brittany.Internal import Language.Haskell.Brittany.Internal.Config import Language.Haskell.Brittany.Internal.Config.Types @@ -73,15 +75,33 @@ data TestCase = TestCase main :: IO () main = do - files <- System.Directory.listDirectory "data/" - let blts = - List.sort - $ filter (\x -> not ("tests-context-free.blt" `isSuffixOf` x)) - $ filter (".blt" `isSuffixOf`) files - inputs <- blts `forM` \blt -> Text.IO.readFile ("data" blt) + let + getFiles :: FilePath -> IO [FilePath] + getFiles path = do + candidates <- System.Directory.listDirectory path + fmap join + $ sequence + $ [ do + isDir <- System.Directory.doesDirectoryExist (path c) + if + | isDir -> getFiles (path c) + | ".blt" `isSuffixOf` c -> pure [path c] + | otherwise -> pure [] + | c <- candidates + ] + blts <- getFiles "data/" + inputs <- sequence + [ Text.IO.readFile (blt) + | blt <- blts + , not ("tests-context-free.blt" `isSuffixOf` blt) + ] let groups = createChunks =<< inputs - inputCtxFree <- Text.IO.readFile "data/30-tests-context-free.blt" - let groupsCtxFree = createChunks inputCtxFree + inputCtxFree <- sequence + [ Text.IO.readFile (blt) + | blt <- blts + , "tests-context-free.blt" `isSuffixOf` blt + ] + let groupsCtxFree = createChunks =<< inputCtxFree hspec $ do describe "asymptotic perf roundtrips" $ asymptoticPerfTest describe "library interface basic functionality" $ do @@ -97,22 +117,43 @@ main = do , " , 00000000000000000000000" , " ]" ] - output <- liftIO $ parsePrintModule staticDefaultConfig input + output <- liftIO $ parsePrintModule + (TraceFunc $ \_ -> pure ()) + staticDefaultConfig + input hush output `shouldBe` Just expected - groups `forM_` \(groupname, tests) -> do - describe (Text.unpack groupname) $ do - tests `forM_` \test -> do - (if isPending test then before_ pending else id) - $ it (Text.unpack $ testName test) - $ roundTripEqual defaultTestConfig - $ content test - groupsCtxFree `forM_` \(groupname, tests) -> do - describe ("context free: " ++ Text.unpack groupname) $ do - tests `forM_` \test -> do - (if isPending test then before_ pending else id) - $ it (Text.unpack $ testName test) - $ roundTripEqual contextFreeTestConfig - $ content test + let + runWithConfig grps conf = do + -- This is a quick-and-dirty solution for merging groups, because hspec + -- isn't clever enough to merge "describe foo (item x); describe (item y)" + -- into "describe foo (item; item y)". + -- This is a messy solution that works for the first two layers only. + -- TODO: Ideally we'd have some proper data-structure to represent + -- something similar in shape to a nested directory/file structure. + -- e.g. data Dir a = Map String (Either (Dir a) a) + let groupTree = Map.unionsWith (Map.unionWith $ Map.unionWith (++)) [ case splitGroups of + (a:b:rs) -> Map.singleton a (Map.singleton (Just b) $ Map.singleton rs tests) + [a] -> Map.singleton a (Map.singleton Nothing (Map.singleton [] tests)) + [] -> error "empty test group name, should not happen" + | (groupname, tests) <- grps, let splitGroups = Text.splitOn (Text.pack "/") groupname] + Map.toList groupTree `forM_` \(k, m2) -> + describe (Text.unpack k) $ Map.toList m2 `forM_` \(k2, m3) -> + (case k2 of + Nothing -> id + Just grp -> describe (Text.unpack grp)) + (Map.toList m3 `forM_` \(ks, tests) -> + foldr + (\grp -> describe (Text.unpack grp)) + (tests `forM_` \test -> do + (if isPending test then before_ pending else id) + $ it (Text.unpack $ testName test) + $ roundTripEqual conf + $ content test + ) + ks + ) + runWithConfig groups defaultTestConfig + runWithConfig groupsCtxFree contextFreeTestConfig where -- this function might be implemented in a weirdly complex fashion; the -- reason being that it was copied from a somewhat more complex variant.