diff --git a/src-literatetests/10-tests.blt b/src-literatetests/10-tests.blt index e04887c..c6d4203 100644 --- a/src-literatetests/10-tests.blt +++ b/src-literatetests/10-tests.blt @@ -227,7 +227,7 @@ func {-# LANGUAGE ScopedTypeVariables #-} func :: forall m - . ColMap2 + . ColMap2 -> ColInfo -> ColInfo -> ColInfo diff --git a/src-literatetests/15-regressions.blt b/src-literatetests/15-regressions.blt index 0876dc3..029caa1 100644 --- a/src-literatetests/15-regressions.blt +++ b/src-literatetests/15-regressions.blt @@ -31,7 +31,7 @@ func = do func = do s <- mGet mSet $ s { _lstate_indent = _lstate_indent state - , _lstate_indent = _lstate_indent state + , _lstate_foo = _lstate_foo state } #test record update indentation 3 @@ -39,7 +39,23 @@ func = do s <- mGet mSet $ s { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd - , _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + , _lstate_foo = _lstate_foo lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + } + +#test record construction 1 +func = Foo {_lstate_indent = _lstate_indent state} + +#test record construction 2 +func = Foo + { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + , _lstate_fooo = _lstate_foo lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + } + +#test record construction 3 +func = do + Foo + { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + , _lstate_foo = _lstate_foo lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd } #test post-indent comment diff --git a/src-literatetests/Main.hs b/src-literatetests/Main.hs index 34b4e4e..938aca6 100644 --- a/src-literatetests/Main.hs +++ b/src-literatetests/Main.hs @@ -40,14 +40,27 @@ data InputLine main :: IO () main = do files <- System.Directory.listDirectory "src-literatetests/" - let blts = List.sort $ filter (".blt" `isSuffixOf`) files + let blts = + List.sort + $ filter (\x -> not ("tests-context-free.blt" `isSuffixOf` x)) + $ filter (".blt"`isSuffixOf`) files inputs <- blts `forM` \blt -> Text.IO.readFile ("src-literatetests" blt) let groups = createChunks =<< inputs - hspec $ groups `forM_` \(groupname, tests) -> do - describe (Text.unpack groupname) $ tests `forM_` \(name, pend, inp) -> do - (if pend then before_ pending else id) - $ it (Text.unpack name) - $ roundTripEqual inp + inputCtxFree <- Text.IO.readFile "src-literatetests/tests-context-free.blt" + let groupsCtxFree = createChunks inputCtxFree + hspec $ do + groups `forM_` \(groupname, tests) -> do + describe (Text.unpack groupname) $ tests `forM_` \(name, pend, inp) -> do + (if pend then before_ pending else id) + $ it (Text.unpack name) + $ roundTripEqual defaultTestConfig inp + groupsCtxFree `forM_` \(groupname, tests) -> do + describe ("context free: " ++ Text.unpack groupname) + $ tests + `forM_` \(name, pend, inp) -> do + (if pend then before_ pending else id) + $ it (Text.unpack name) + $ roundTripEqual contextFreeTestConfig inp where -- this function might be implemented in a weirdly complex fashion; the -- reason being that it was copied from a somewhat more complex variant. @@ -132,10 +145,10 @@ main = do -------------------- -- past this line: copy-pasta from other test (meh..) -------------------- -roundTripEqual :: Text -> Expectation -roundTripEqual t = +roundTripEqual :: Config -> Text -> Expectation +roundTripEqual c t = fmap (fmap PPTextWrapper) - (parsePrintModuleTests defaultTestConfig "TestFakeFileName.hs" t) + (parsePrintModuleTests c "TestFakeFileName.hs" t) `shouldReturn` Right (PPTextWrapper t) newtype PPTextWrapper = PPTextWrapper Text @@ -170,3 +183,12 @@ defaultTestConfig = Config } } +contextFreeTestConfig :: Config +contextFreeTestConfig = + defaultTestConfig + { _conf_layout = (_conf_layout defaultTestConfig) + {_lconfig_indentPolicy = coerce IndentPolicyLeft + ,_lconfig_alignmentLimit = coerce (1 :: Int) + ,_lconfig_columnAlignMode = coerce ColumnAlignModeDisabled + } + } diff --git a/src-literatetests/tests-context-free.blt b/src-literatetests/tests-context-free.blt new file mode 100644 index 0000000..7700adb --- /dev/null +++ b/src-literatetests/tests-context-free.blt @@ -0,0 +1,1131 @@ + +############################################################################### +############################################################################### +############################################################################### +#group type signatures +############################################################################### +############################################################################### +############################################################################### + +#test simple001 +func :: a -> a + +#test long typeVar +func + :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + +#test keep linebreak mode +func + :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + -> lakjsdlkjasldkj + -> lakjsdlkjasldkj + +#test simple parens 1 +func :: ((a)) + +#test simple parens 2 +func :: (a -> a) -> a + +#test simple parens 3 +func :: a -> (a -> a) + +#test did anyone say parentheses? +func :: (((((((((()))))))))) + +-- current output is.. funny. wonder if that can/needs to be improved.. +#test give me more! +#pending +func :: ((((((((((((((((((((((((((((((((((((((((((())))))))))))))))))))))))))))))))))))))))))) + +#test unit +func :: () + + +############################################################################### + +#test paren'd func 1 +func + :: ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + -> lakjsdlkjasldkj + -> lakjsdlkjasldkj + ) + +#test paren'd func 2 +func + :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + -> (lakjsdlkjasldkj -> lakjsdlkjasldkj) + +#test paren'd func 3 +func + :: (lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd -> lakjsdlkjasldkj) + -> lakjsdlkjasldkj + +#test paren'd func 4 +func + :: ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + ) + -> lakjsdlkjasldkj + +#test paren'd func 5 +func + :: ( ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + ) + ) + +############################################################################### + +#test type application 1 +func :: asd -> Either a b + +#test type application 2 +func + :: asd + -> Either + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + +#test type application 3 +func + :: asd + -> Trither + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + +#test type application 4 +func + :: Trither + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + -> asd + +#test type application 5 +func + :: Trither + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + (lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd -> asd) + +#test type application 6 +func + :: Trither + asd + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + ) + +#test type application paren 1 +func + :: asd + -> ( Trither + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + ) + +#test type application paren 2 +func + :: asd + -> ( Trither + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + ) + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + +#test type application paren 3 +func + :: ( Trither + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + ) + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + -> asd + +############################################################################### + +#test list simple +func :: [a -> b] + +#test list func +func + :: [ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + ] + +#test list paren +func + :: [ ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + ) + ] + +################################################################## -- ############# + +#test tuple type 1 +func :: (a, b, c) + +#test tuple type 2 +func :: ((a, b, c), (a, b, c), (a, b, c)) + +#test tuple type long +func + :: ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + ) + +#test tuple type nested +func + :: ( ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + , (lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd) + , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + ) + ) + +#test tuple type function +func + :: [ ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + ) + ] +############################################################################### +#test type operator stuff +#pending +test050 :: a :+: b +test051 + :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + :+: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd +test052 + :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + :+: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + +############################################################################### + +#test forall oneliner +{-# LANGUAGE ScopedTypeVariables #-} +func :: forall (a :: *) b . a -> b + +#test forall context multiline +{-# LANGUAGE ScopedTypeVariables #-} +func + :: forall m + . Foo + => ColMap2 + -> ColInfo + -> ColInfo + -> ColInfo + -> ColInfo + -> m () + +#test forall no-context multiline +{-# LANGUAGE ScopedTypeVariables #-} +func + :: forall m + . ColMap2 + -> ColInfo + -> ColInfo + -> ColInfo + -> ColInfo + -> ColInfo + -> m () + +#test language pragma issue +{-# LANGUAGE ScopedTypeVariables #-} +func :: forall (a :: *) b . a -> b + +#test comments 1 +func :: a -> b -- comment + +#test comments 2 +funcA :: a -> b -- comment A +funcB :: a -> b -- comment B + +#test comments all +#pending +-- a +func -- b + :: -- c + a -- d + -> -- e + ( -- f + c -- g + , -- h + d -- i + ) -- j +-- k + +############################################################################### + +#test ImplicitParams 1 +{-# LANGUAGE ImplicitParams #-} +func :: (?asd::Int) -> () + +#test ImplicitParams 2 +{-# LANGUAGE ImplicitParams #-} +func + :: ( ?asd + :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + ) + -> () + + +############################################################################### +############################################################################### +############################################################################### +#group type signatures pragmas +############################################################################### +############################################################################### +############################################################################### + +#test inline pragma 1 +func = f + where + {-# INLINE f #-} + f = id + +#test inline pragma 2 +func = ($) + where + {-# INLINE ($) #-} + ($) = id + +#test inline pragma 3 +func = f + where + {-# INLINE CONLIKE [1] f #-} + f = id + +#test inline pragma 4 +#pending this does not work with the compiler version we currently use yet (i think). should work with ghc-8.0.2. +func = f + where + {-# INLINE [~] f #-} + f = id + + +############################################################################### +############################################################################### +############################################################################### +#group equation.basic +############################################################################### +############################################################################### +############################################################################### +## some basic testing of different kinds of equations. +## some focus on column layouting for multiple-equation definitions. +## (that part probably is not implemented in any way yet.) + +#test basic 1 +func x = x + +#test infix 1 +x *** y = x + +#test symbol prefix +(***) x y = x + + +############################################################################### +############################################################################### +############################################################################### +#group equation.patterns +############################################################################### +############################################################################### +############################################################################### + +#test wildcard +func _ = x + +#test simple long pattern +#pending +func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable + = x + +#test simple multiline pattern +#pending +func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable + reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable + = x + +#test another multiline pattern +#pending +func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable + a + b + = x + +#test simple constructor +func (A a) = a + +#test list constructor +func (x:xr) = x + +#test some other constructor symbol +#pending +func (x:+:xr) = x + + +############################################################################### +############################################################################### +############################################################################### +#group equation.guards +############################################################################### +############################################################################### +############################################################################### +#test simple guard +func | True = x + +#test multiple-clauses-1 +func x + | x = simple expression + | otherwise = 0 + +#test multiple-clauses-2 +func x + | a somewhat longer guard x = "and a somewhat longer expession that does not" + | otherwise = "fit without putting the guards in new lines" + +#test multiple-clauses-3 +func x + | very long guard, another rather long guard that refers to x = nontrivial + expression + foo + bar + alsdkjlasdjlasj + | otherwise = 0 + +#test multiple-clauses-4 +func x + | very 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 +#pending +func = mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj + + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj + +#test long keep linemode 1 +#pending +func = mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj + + mweroiuxlskdfjlksj + + mweroiuxlskdfjlksj + +#test long keep linemode 2 +#pending +func = mweroiuxlskdfjlksj + + mweroiuxlskdfjlksj + + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj + +#test literals +func = 1 +func = "abc" +func = 1.1e5 +func = 'x' +func = 981409823458910394810928414192837123987123987123 + +#test lambdacase +{-# LANGUAGE LambdaCase #-} +func = \case + FooBar -> x + Baz -> y + +#test lambda +func = \x -> abc + +describe "app" $ do +#test 1 +func = klajsdas klajsdas klajsdas + +#test 2 +func = lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd + lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd + lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd + +#test 3 +func = lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd + lakjsdlajsdljas + lakjsdlajsdljas + lakjsdlajsdljas + +### +#group expression.basic.sections +### + +#test left +func = (1 +) + +#test right +func = (+ 1) + +#test left inf +## TODO: this could be improved.. +func = (1 `abc`) + +#test right inf +func = (`abc` 1) + +### +#group tuples +### + +#test 1 +func = (abc, def) + +#test 2 +#pending +func = (lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd + , lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd) + + + +############################################################################### +############################################################################### +############################################################################### +#group expression.do statements +############################################################################### +############################################################################### +############################################################################### + +#test simple +func = do + stmt + stmt + +#test bind +func = do + x <- stmt + stmt x + +#test let +func = do + let x = 13 + stmt x + + +############################################################################### +############################################################################### +############################################################################### +#group expression.lists +############################################################################### +############################################################################### +############################################################################### + +#test monad-comprehension-case-of +func = + foooooo + $ [ case + foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + of + _ -> True + ] + + +############################################################################### +############################################################################### +############################################################################### +#group expression.multiwayif +############################################################################### +############################################################################### +############################################################################### + +#test simple +{-# LANGUAGE MultiWayIf #-} +func = if + | cond1 -> loooooooooooooooooooooooooooooong expr1 + | cond2 -> loooooooooooooooooooooooooooooong expr2 + +#test simplenested +{-# LANGUAGE MultiWayIf #-} +func = do + foo + bar $ if + | cond1 -> loooooooooooooooooooooooooooooong expr1 + | cond2 -> loooooooooooooooooooooooooooooong expr2 + + +############################################################################### +############################################################################### +############################################################################### +#group stylisticspecialcases +############################################################################### +############################################################################### +############################################################################### + +#test operatorprefixalignment-even-with-multiline-alignbreak +func = + foo + $ [ aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + , bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb + ] + ++ [ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc] + + +############################################################################### +############################################################################### +############################################################################### +#group regression +############################################################################### +############################################################################### +############################################################################### + +#test newlines-comment +func = do + abc <- foo + +--abc +return () + +#test parenthesis-around-unit +func = (()) + +#test let-defs indentation +func = do + let + foo True = True + foo _ = False + return () + +#test let-defs no indent +func = do + let + foo True = True + foo _ = False + return () + +#test let-defs no indent +func = do + let + foo = True + b = False + return () + +#test let-defs no indent +func = + let + foo = True + b = False + in return () + +#test record update indentation 1 +func = do + s <- mGet + mSet $ s { _lstate_indent = _lstate_indent state } + +#test record update indentation 2 +func = do + s <- mGet + mSet $ s + { _lstate_indent = _lstate_indent state + , _lstate_foo = _lstate_foo state + } + +#test record update indentation 3 +func = do + s <- mGet + mSet $ s + { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + , _lstate_foo = _lstate_foo kasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + } + +#test record construction 1 +func = Foo {_lstate_indent = _lstate_indent state} + +#test record construction 2 +func = Foo + { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + , _lstate_foo = _lstate_foo lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + } + +#test record construction 3 +func = do + Foo + { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + , _lstate_foo = _lstate_foo lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + } + +#test post-indent comment +func = do +-- abc + -- def + return () + +#test post-unindent comment +func = do + do + return () + -- abc + -- def + return () + +#test CPP empty comment case +#pending CPP parsing needs fixing for roundTripEqual +{-# LANGUAGE CPP #-} +module Test where +func = do +#if FOO + let x = 13 +#endif + stmt x + +## really, the following should be handled by forcing the Alt to multiline +## because there are comments. as long as this is not implemented though, +## we should ensure the trivial solution works. +#test comment inline placement (temporary) +func + :: Int -- basic indentation amount + -> Int -- currently used width in current line (after indent) + -- used to accurately calc placing of the current-line + -> LayoutDesc + -> Int + +#test some indentation thingy +func = + ( lkjadljasldjalskdjaldjalsdjkalsdjlaksdjlasjdlajsaldskj + $ abc + $ def + $ ghi + $ jkl + ) + +#test parenthesized operator +buildG bounds0 edges0 = accumArray (flip (:)) [] bounds0 (map reassoc edges0) + where reassoc (v, e, w) = (v, (e, w)) + +#test record pattern matching stuff +downloadRepoPackage = case repo of + RepoLocal {..} -> return () + RepoLocal { abc } -> return () + RepoLocal{} -> return () + +#test do let comment indentation level problem +func = do + let + (primaryPkg, otherPkgs) = selectPrimaryLocalPackage pwd pkgs' + (bproblems, x) = resolveBuildTargets primaryPkg otherPkgs utargets'' + -- default local dir target if there's no given target + utargets'' = "foo" + return () + +#test list comprehension comment placement +func = + [ (thing, take 10 alts) --TODO: select best ones + | (thing, _got, alts@(_:_)) <- nosuchFooThing + , gast <- award + ] + +#test if-then-else comment placement +func = if x + then if y -- y is important + then foo + else bar + else Nothing + +#test qualified infix pattern +#pending "TODO" +wrapPatPrepend pat prepElem = do + patDocs <- layoutPat pat + case Seq.viewl patDocs of + Seq.EmptyL -> return $ Seq.empty + x1 Seq.:< xR -> do + x1' <- docSeq [prepElem, return x1] + return $ x1' Seq.<| xR + +#test type signature multiline forcing issue +layoutWriteNewlineBlock + :: ( MonadMultiWriter Text.Builder.Builder m + , MonadMultiState LayoutState m + , MonadMultiWriter (Seq String) m + ) + => m () + +#test multiwayif proper indentation +{-# LANGUAGE MultiWayIf #-} +readMergePersConfig path shouldCreate conf = do + exists <- liftIO $ System.Directory.doesFileExist path + if + | exists -> do + contents <- liftIO $ ByteString.readFile path -- no lazy IO, tyvm. + fileConf <- case Data.Yaml.decodeEither contents of + Left e -> do + liftIO + $ putStrErrLn + $ "error reading in brittany config from " + ++ path + ++ ":" + liftIO $ putStrErrLn e + mzero + Right x -> return x + return $ fileConf Semigroup.<> conf + | shouldCreate -> do + liftIO $ ByteString.writeFile path $ Data.Yaml.encode $ cMap + (Option . Just . runIdentity) + staticDefaultConfig + return $ conf + | otherwise -> do + return conf + +#test nested pattern alignment issue" +func = BuildReport + where + convertInstallOutcome = case result of + Left BR.PlanningFailed -> PlanningFailed + Left (BR.DependentFailed p) -> DependencyFailed p + Left (BR.DownloadFailed _) -> DownloadFailed + Left (BR.UnpackFailed _) -> UnpackFailed + Left (BR.ConfigureFailed _) -> ConfigureFailed + Left (BR.BuildFailed _) -> BuildFailed + Left (BR.TestsFailed _) -> TestsFailed + Left (BR.InstallFailed _) -> InstallFailed + Right (BR.BuildOk _ _ _) -> InstallOk + +#test nested pattern alignment issue" +func = BuildReport + where + convertInstallOutcome = case result of + Left BR.PlanningFailed -> PlanningFailed + Left (BR.DependentFailed p) -> DependencyFailed p + Left (BR.DownloadFailed _) -> DownloadFailed + Left (BR.UnpackFailed _) -> UnpackFailed + Left (BR.ConfigureFailed _) -> ConfigureFailed + Left (BR.BuildFailed _) -> BuildFailed + Left (BR.TestsFailed _) -> TestsFailed + Left (BR.InstallFailed _) -> InstallFailed + Right (BR.BuildOk _ _ _) -> InstallOk + +#test partially overflowing alignment issue" +showPackageDetailedInfo pkginfo = + renderStyle (style { lineLength = 80, ribbonsPerLine = 1 }) + $ char '*' + $+$ something + [ entry "Synopsis" synopsis hideIfNull reflowParagraphs + , entry + "Versions available" + sourceVersions + (altText null "[ Not available from server ]") + (dispTopVersions 9 (preferredVersions pkginfo)) + , entry + "Versions installed" + installedVersions + ( altText + null + (if hasLib pkginfo then "[ Not installed ]" else "[ Unknown ]") + ) + (dispTopVersions 4 (preferredVersions pkginfo)) + , entry "Homepage" homepage orNotSpecified text + , entry "Bug reports" bugReports orNotSpecified text + , entry "Description" description hideIfNull reflowParagraphs + , entry "Category" category hideIfNull text + , entry "License" license alwaysShow disp + , entry "Author" author hideIfNull reflowLines + , entry "Maintainer" maintainer hideIfNull reflowLines + , entry "Source repo" sourceRepo orNotSpecified text + , entry "Executables" executables hideIfNull (commaSep text) + , entry "Flags" flags hideIfNull (commaSep dispFlag) + , entry "Dependencies" dependencies hideIfNull (commaSep dispExtDep) + , entry "Documentation" haddockHtml showIfInstalled text + , entry "Cached" haveTarball alwaysShow dispYesNo + , if not (hasLib pkginfo) + then empty + else text "Modules:" + $+$ nest 4 (vcat (map disp . sort . modules $ pkginfo)) + ] + +#test issue 7a +isValidPosition position + | validX && validY = Just position + | otherwise = Nothing + +#test issue-6-pattern-linebreak-validity +## this is ugly, but at least syntactically valid. +foo = Reflex.runSpiderHost $ ReflexHost.hostApp $ do + (inputEvent :: Reflex.Event Reflex.Spider String, inputFire :: String + -> IO Bool) <- + ReflexHost.newExternalEvent + liftIO . forkIO . forever $ getLine >>= inputFire + ReflexHost.performEvent_ $ fmap (liftIO . putStrLn) inputEvent + +#test issue 16 +foldrDesc f z = unSwitchQueue $ \q -> + switch (Min.foldrDesc (f unTaggedF) z q) (Min.foldrAsc (f unTaggedF) z q) + +#test issue 18 +autocheckCases = + [ ("Never Deadlocks", representative deadlocksNever) + , ("No Exceptions", representative exceptionsNever) + , ("Consistent Result", alwaysSame) -- already representative + ] + +#test issue 18b +autocheckCases = + [ ("Never Deadlocks", representative deadlocksNever) + , ("No Exceptions", representative exceptionsNever) + , ( "Consistent Result" + , alwaysSame -- already representative + ) + ] + +#test issue 18c +func = + [ (abc, (1111, 1111)) + , (def, (2, 2)) + , foo -- comment + ] + +#test issue 26 +foo a b = g a b -- fooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + where g a b = b + b * a + +#test issue 26b +foo a b = g a b where g a b = b + b * a -- fooooooooooooooooooooooooooooooooooo + +#test aggressive alignment 1 +func = do + abc <- expr + abcccccccccccccccccc <- expr + abcccccccccccccccccccccccccccccccccccccccccc <- expr + abccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc <- expr + +#test example alignment 1 +func (MyLongFoo abc def) = 1 +func (Bar a d) = 2 +func _ = 3 + +#test listcomprehension-case-of +parserCompactLocation = + [ try + $ [ ParseRelAbs (Text.Read.read digits) _ _ + | digits <- many1 digit + , rel1 :: Maybe (Either Int (Ratio Int)) <- optionMaybe + [ case divPart of + Nothing -> Left $ Text.Read.read digits + Just ddigits -> + Right $ Text.Read.read digits % Text.Read.read ddigits + | digits <- many1 digit + , divPart <- optionMaybe (string "/" *> many1 digit) + ] + ] + ] + +#test opapp-specialcasing-1 +func = fooooooooooooooooooooooooooooooooo $ foooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooo + +#test opapp-specialcasing-2 +func = + fooooooooooooooooooooooooooooooooo + + foooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooo + +#test opapp-specialcasing-3 +func = fooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooo + [ foooooooooooooooooooooooooooooooo + , foooooooooooooooooooooooooooooooo + , foooooooooooooooooooooooooooooooo + ] + +#test opapp-indenting +parserPrim = + [ r + | r <- + [ SGPPrimFloat $ bool id (0 -) minus $ readGnok + "parserPrim" + (d1 ++ d2 ++ d3 ++ d4) + | d2 <- string "." + , d3 <- many1 (oneOf "0123456789") + , _ <- string "f" + ] + <|> [ SGPPrimFloat $ bool id (0 -) minus $ fromIntegral + (readGnok "parserPrim" d1 :: Integer) + | _ <- string "f" + ] + <|> [ SGPPrimInt $ bool id (0 -) minus $ fromIntegral + (readGnok "parserPrim" d1 :: Integer) + | _ <- string "i" + ] + ] + +#test another-parspacing-testcase + +samples = (SV.unpackaaaaadat) <&> \f -> + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + +#test recordupd-singleline-bug + +runBrittany tabSize text = do + let + config' = staticDefaultConfig + config = config' + { _conf_layout = (_conf_layout config') + { _lconfig_indentAmount = coerce tabSize + } + , _conf_forward = forwardOptionsSyntaxExtsEnabled + } + parsePrintModule config text + +#test issue 38 + +{-# LANGUAGE TypeApplications #-} +foo = bar @Baz + +#test comment-before-BDCols +{-# LANGUAGE TypeApplications #-} +layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do + docAlt + $ -- one-line solution + [ docCols + (ColBindingLine alignmentToken) + [ docSeq (patPartInline ++ [guardPart]) + , docSeq + [ appSep $ return binderDoc + , docForceSingleline $ return body + , wherePart + ] + ] + | not hasComments + , [(guards, body, _bodyRaw)] <- [clauseDocs] + , let guardPart = singleLineGuardsDoc guards + , wherePart <- case mWhereDocs of + Nothing -> return @[] $ docEmpty + Just [w] -> return @[] $ docSeq + [ docSeparator + , appSep $ docLit $ Text.pack "where" + , docSetIndentLevel $ docForceSingleline $ return w + ] + _ -> [] + ] + ++ -- one-line solution + where in next line(s) + [ docLines + $ [ docCols + (ColBindingLine alignmentToken) + [ docSeq (patPartInline ++ [guardPart]) + , docSeq + [appSep $ return binderDoc, docForceParSpacing $ return body] + ] + ] + ++ wherePartMultiLine + | [(guards, body, _bodyRaw)] <- [clauseDocs] + , let guardPart = singleLineGuardsDoc guards + , Data.Maybe.isJust mWhereDocs + ] + ++ -- two-line solution + where in next line(s) + [ docLines + $ [ docForceSingleline + $ docSeq (patPartInline ++ [guardPart, return binderDoc]) + , docEnsureIndent BrIndentRegular $ docForceSingleline $ return + body + ] + ++ wherePartMultiLine + | [(guards, body, _bodyRaw)] <- [clauseDocs] + , let guardPart = singleLineGuardsDoc guards + ] + +#test comment-testcase-17 +{-# LANGUAGE MultiWayIf #-} +func = do + let + foo = if + | Constuctoooooooooooooooooooooooooooooooooooor `elem` artics -- TODO + -> max + (defLen - 0.2) -- TODO + (defLen * 0.8) + | otherwise -> max (defLen - 0.05) (defLen * 0.95) -- TODO + return True + +#test issue 49 + +foo n = case n of + 1 -> True + -1 -> False + +bar n = case n of + (-2, -2) -> (-2, -2) + +#test issue 48 a + +foo = + let + a = b@1 + cccc = () + in foo + +#test issue 48 b + +{-# LANGUAGE TypeApplications #-} +foo = + let + a = b @1 + cccc = () + in foo + + +############################################################################### +############################################################################### +############################################################################### +#group pending +############################################################################### +############################################################################### +############################################################################### + + + +## this testcase is not about idempotency, but about _how_ the output differs +## from the input; i cannot really express this yet with the current +## test-suite. +## #test ayaz +## +## myManageHook = +## composeOne [isFullscreen -?> doFullFloat, isDialog -?> doFloat, transience] +## <+> composeAll +## [ className =? "Pidgin" --> doFloat +## , className =? "XCalc" --> doFloat +## -- plan9port's acme +## , className =? "acme" --> doFloat +## -- Acme with Vi bindings editor +## , title =? "ED" --> doFloat +## , title =? "wlc-x11" --> doFloat +## , className =? "Skype" --> doFloat +## , className =? "ffplay" --> doFloat +## , className =? "mpv" --> doFloat +## , className =? "Plugin-container" --> doFloat -- Firefox flash, etc. +## -- Firefox works well tiled, but it has dialog windows we want to float. +## , appName =? "Browser" --> doFloat +## ] +## where +## role = stringProperty "WM_WINDOW_ROLE" + diff --git a/src/Language/Haskell/Brittany/Internal/Config/Types.hs b/src/Language/Haskell/Brittany/Internal/Config/Types.hs index 4fd4765..d726d8a 100644 --- a/src/Language/Haskell/Brittany/Internal/Config/Types.hs +++ b/src/Language/Haskell/Brittany/Internal/Config/Types.hs @@ -191,7 +191,7 @@ data IndentPolicy = IndentPolicyLeft -- never create a new indentation at more | IndentPolicyFree -- can create new indentations whereever | IndentPolicyMultiple -- can create indentations only -- at any n * amount. - deriving (Show, Generic, Data) + deriving (Eq, Show, Generic, Data) data AltChooser = AltChooserSimpleQuick -- always choose last alternative. -- leads to tons of sparsely filled diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs index 5073eab..30e26c2 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs @@ -265,9 +265,15 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha gs -> docSeq $ [appSep $ docLit $ Text.pack "|"] ++ List.intersperse docCommaSep (return <$> gs) - docAlt + + indentPolicy <- mAsk + <&> _conf_layout + .> _lconfig_indentPolicy + .> confUnpack + docAltFilter $ -- one-line solution - [ docCols + [ ( True + , docCols (ColBindingLine alignmentToken) [ docSeq (patPartInline ++ [guardPart]) , docSeq @@ -276,6 +282,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha , wherePart ] ] + ) | not hasComments , [(guards, body, _bodyRaw)] <- [clauseDocs] , let guardPart = singleLineGuardsDoc guards @@ -289,7 +296,8 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha _ -> [] ] ++ -- one-line solution + where in next line(s) - [ docLines + [ ( True + , docLines $ [ docCols (ColBindingLine alignmentToken) [ docSeq (patPartInline ++ [guardPart]) @@ -298,23 +306,27 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha ] ] ++ wherePartMultiLine + ) | [(guards, body, _bodyRaw)] <- [clauseDocs] , let guardPart = singleLineGuardsDoc guards , Data.Maybe.isJust mWhereDocs ] ++ -- two-line solution + where in next line(s) - [ docLines + [ ( True + , docLines $ [ docForceSingleline $ docSeq (patPartInline ++ [guardPart, return binderDoc]) , docEnsureIndent BrIndentRegular $ docForceSingleline $ return body ] ++ wherePartMultiLine + ) | [(guards, body, _bodyRaw)] <- [clauseDocs] , let guardPart = singleLineGuardsDoc guards ] ++ -- pattern and exactly one clause in single line, body as par; -- where in following lines - [ docLines + [ ( True + , docLines $ [ docCols (ColBindingLine alignmentToken) [ docSeq (patPartInline ++ [guardPart]) @@ -329,24 +341,28 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha -- , docAddBaseY BrIndentRegular $ return body -- ] ++ wherePartMultiLine + ) | [(guards, body, _bodyRaw)] <- [clauseDocs] , let guardPart = singleLineGuardsDoc guards ] ++ -- pattern and exactly one clause in single line, body in new line. - [ docLines + [ ( True + , docLines $ [ docSeq (patPartInline ++ [guardPart, return binderDoc]) , docEnsureIndent BrIndentRegular $ docNonBottomSpacing $ (docAddBaseY BrIndentRegular $ return body) ] ++ wherePartMultiLine + ) | [(guards, body, _)] <- [clauseDocs] , let guardPart = singleLineGuardsDoc guards ] ++ -- multiple clauses added in-paragraph, each in a single line -- example: foo | bar = baz -- | lll = asd - [ docLines + [ ( indentPolicy /= IndentPolicyLeft + , docLines $ [ docSeq [ appSep $ docForceSingleline $ return patDoc , docSetBaseY @@ -370,10 +386,12 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha ] ] ++ wherePartMultiLine + ) | Just patDoc <- [mPatDoc] ] ++ -- multiple clauses, each in a separate, single line - [ docLines + [ ( True + , docLines $ [ docAddBaseY BrIndentRegular $ patPartParWrap $ docLines @@ -396,10 +414,12 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha ] ] ++ wherePartMultiLine + ) ] ++ -- multiple clauses, each with the guard(s) in a single line, body -- as a paragraph - [ docLines + [ ( True + , docLines $ [ docAddBaseY BrIndentRegular $ patPartParWrap $ docLines @@ -431,10 +451,12 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha ] ] ++ wherePartMultiLine + ) ] ++ -- multiple clauses, each with the guard(s) in a single line, body -- in a new line as a paragraph - [ docLines + [ ( True + , docLines $ [ docAddBaseY BrIndentRegular $ patPartParWrap $ docLines @@ -464,9 +486,11 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha ] ] ++ wherePartMultiLine + ) ] ++ -- conservative approach: everything starts on the left. - [ docLines + [ ( True + , docLines $ [ docAddBaseY BrIndentRegular $ patPartParWrap $ docLines @@ -494,4 +518,5 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha ] ] ++ wherePartMultiLine + ) ] diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs index 0e36a21..0ed8a31 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs @@ -13,6 +13,7 @@ where import Language.Haskell.Brittany.Internal.Types import Language.Haskell.Brittany.Internal.LayouterBasics +import Language.Haskell.Brittany.Internal.Config.Types import RdrName ( RdrName(..) ) import GHC ( runGhc, GenLocated(L), moduleNameString, AnnKeywordId(..) ) @@ -30,973 +31,1033 @@ import Language.Haskell.Brittany.Internal.Layouters.Type layoutExpr :: ToBriDoc HsExpr -layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of - HsVar vname -> do - docLit =<< lrdrNameToTextAnn vname - HsUnboundVar var -> case var of - OutOfScope oname _ -> docLit $ Text.pack $ occNameString oname - TrueExprHole oname -> docLit $ Text.pack $ occNameString oname - HsRecFld{} -> do - -- TODO - briDocByExactInlineOnly "HsRecFld" lexpr - HsOverLabel{} -> do - -- TODO - briDocByExactInlineOnly "HsOverLabel{}" lexpr - HsIPVar{} -> do - -- TODO - briDocByExactInlineOnly "HsOverLabel{}" lexpr - HsOverLit (OverLit olit _ _ _) -> do - allocateNode $ overLitValBriDoc olit - HsLit lit -> do - allocateNode $ litBriDoc lit - HsLam (MG (L _ [lmatch@(L _ (Match _ pats _ (GRHSs [lgrhs@(L _ (GRHS [] body))] (L _ EmptyLocalBinds))))]) _ _ _) -> do - patDocs <- pats `forM` \p -> fmap return $ colsWrapPat =<< layoutPat p - bodyDoc <- docAddBaseY BrIndentRegular <$> docSharedWrapper layoutExpr body - let funcPatternPartLine = - docCols ColCasePattern - $ (patDocs <&> (\p -> docSeq [docForceSingleline p, docSeparator])) - docAlt - [ -- single line - docSeq - [ docLit $ Text.pack "\\" - , docWrapNode lmatch $ docForceSingleline funcPatternPartLine - , appSep $ docLit $ Text.pack "->" - , docWrapNode lgrhs $ docForceSingleline bodyDoc - ] - -- double line - , docSetParSpacing - $ docAddBaseY BrIndentRegular - $ docPar - (docSeq +layoutExpr lexpr@(L _ expr) = do + indentPolicy <- mAsk + <&> _conf_layout + .> _lconfig_indentPolicy + .> confUnpack + let allowFreeIndent = indentPolicy == IndentPolicyFree + docWrapNode lexpr $ case expr of + HsVar vname -> do + docLit =<< lrdrNameToTextAnn vname + HsUnboundVar var -> case var of + OutOfScope oname _ -> docLit $ Text.pack $ occNameString oname + TrueExprHole oname -> docLit $ Text.pack $ occNameString oname + HsRecFld{} -> do + -- TODO + briDocByExactInlineOnly "HsRecFld" lexpr + HsOverLabel{} -> do + -- TODO + briDocByExactInlineOnly "HsOverLabel{}" lexpr + HsIPVar{} -> do + -- TODO + briDocByExactInlineOnly "HsOverLabel{}" lexpr + HsOverLit (OverLit olit _ _ _) -> do + allocateNode $ overLitValBriDoc olit + HsLit lit -> do + allocateNode $ litBriDoc lit + HsLam (MG (L _ [lmatch@(L _ (Match _ pats _ (GRHSs [lgrhs@(L _ (GRHS [] body))] (L _ EmptyLocalBinds))))]) _ _ _) -> do + patDocs <- pats `forM` \p -> fmap return $ colsWrapPat =<< layoutPat p + bodyDoc <- docAddBaseY BrIndentRegular <$> docSharedWrapper layoutExpr body + let funcPatternPartLine = + docCols ColCasePattern + $ (patDocs <&> (\p -> docSeq [docForceSingleline p, docSeparator])) + docAlt + [ -- single line + docSeq [ docLit $ Text.pack "\\" - , docWrapNode lmatch $ appSep $ docForceSingleline funcPatternPartLine - , docLit $ Text.pack "->" - ]) - (docWrapNode lgrhs $ docForceSingleline bodyDoc) - -- wrapped par spacing - , docSetParSpacing - $ docSeq - [ docLit $ Text.pack "\\" - , docWrapNode lmatch $ docForceSingleline funcPatternPartLine - , appSep $ docLit $ Text.pack "->" - , docWrapNode lgrhs $ docForceParSpacing bodyDoc - ] - -- conservative - , docSetParSpacing - $ docAddBaseY BrIndentRegular - $ docPar - (docSeq - [ docLit $ Text.pack "\\" - , docWrapNode lmatch $ appSep $ docForceSingleline funcPatternPartLine - , docLit $ Text.pack "->" - ]) - (docWrapNode lgrhs $ docNonBottomSpacing bodyDoc) - ] - HsLam{} -> - unknownNodeError "HsLam too complex" lexpr -#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ - HsLamCase (MG lmatches@(L _ matches) _ _ _) -> do -#else /* ghc-8.0 */ - HsLamCase _ (MG lmatches@(L _ matches) _ _ _) -> do -#endif - binderDoc <- docLit $ Text.pack "->" - funcPatDocs <- docWrapNode lmatches $ layoutPatternBind Nothing binderDoc `mapM` matches - docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar - (docLit $ Text.pack "\\case") - (docSetBaseAndIndent $ docNonBottomSpacing $ docLines $ return <$> funcPatDocs) - HsApp exp1@(L _ HsApp{}) exp2 -> do - let gather :: [LHsExpr RdrName] -> LHsExpr RdrName -> (LHsExpr RdrName, [LHsExpr RdrName]) - gather list = \case - (L _ (HsApp l r)) -> gather (r:list) l - x -> (x, list) - let (headE, paramEs) = gather [exp2] exp1 - headDoc <- docSharedWrapper layoutExpr headE - paramDocs <- docSharedWrapper layoutExpr `mapM` paramEs - docAlt - [ -- foo x y - docCols ColApp - $ appSep (docForceSingleline headDoc) - : spacifyDocs (docForceSingleline <$> paramDocs) - , -- foo x - -- y - docSeq - [ appSep (docForceSingleline headDoc) - , docSetBaseY + , docWrapNode lmatch $ docForceSingleline funcPatternPartLine + , appSep $ docLit $ Text.pack "->" + , docWrapNode lgrhs $ docForceSingleline bodyDoc + ] + -- double line + , docSetParSpacing $ docAddBaseY BrIndentRegular - $ docLines - $ (docForceSingleline <$> paramDocs) + $ docPar + (docSeq + [ docLit $ Text.pack "\\" + , docWrapNode lmatch $ appSep $ docForceSingleline funcPatternPartLine + , docLit $ Text.pack "->" + ]) + (docWrapNode lgrhs $ docForceSingleline bodyDoc) + -- wrapped par spacing + , docSetParSpacing + $ docSeq + [ docLit $ Text.pack "\\" + , docWrapNode lmatch $ docForceSingleline funcPatternPartLine + , appSep $ docLit $ Text.pack "->" + , docWrapNode lgrhs $ docForceParSpacing bodyDoc + ] + -- conservative + , docSetParSpacing + $ docAddBaseY BrIndentRegular + $ docPar + (docSeq + [ docLit $ Text.pack "\\" + , docWrapNode lmatch $ appSep $ docForceSingleline funcPatternPartLine + , docLit $ Text.pack "->" + ]) + (docWrapNode lgrhs $ docNonBottomSpacing bodyDoc) ] - , -- foo - -- x - -- y - docSetParSpacing - $ docAddBaseY BrIndentRegular - $ docPar - (docForceSingleline headDoc) - ( docNonBottomSpacing - $ docLines paramDocs - ) - , -- ( multi - -- line - -- function - -- ) - -- x - -- y - docAddBaseY BrIndentRegular - $ docPar - headDoc - ( docNonBottomSpacing - $ docLines paramDocs - ) - ] - HsApp exp1 exp2 -> do - -- TODO: if expDoc1 is some literal, we may want to create a docCols here. - expDoc1 <- docSharedWrapper layoutExpr exp1 - expDoc2 <- docSharedWrapper layoutExpr exp2 - docAlt - [ -- func arg - docSeq [appSep $ docForceSingleline expDoc1, docForceSingleline expDoc2] - , -- func argline1 - -- arglines - -- e.g. - -- func if x - -- then 1 - -- else 2 - docSetParSpacing - $ docAddBaseY BrIndentRegular - $ docSeq - [ appSep $ docForceSingleline expDoc1 - , docForceParSpacing expDoc2 - ] - , -- func - -- arg - docSetParSpacing - $ docAddBaseY BrIndentRegular - $ docPar - (docForceSingleline expDoc1) - (docNonBottomSpacing expDoc2) - , -- fu - -- nc - -- ar - -- gument - docAddBaseY BrIndentRegular - $ docPar - expDoc1 - expDoc2 - ] + HsLam{} -> + unknownNodeError "HsLam too complex" lexpr #if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ - HsAppType exp1 (HsWC _ ty1) -> do + HsLamCase (MG lmatches@(L _ matches) _ _ _) -> do #else /* ghc-8.0 */ - HsAppType exp1 (HsWC _ _ ty1) -> do + HsLamCase _ (MG lmatches@(L _ matches) _ _ _) -> do #endif - t <- docSharedWrapper layoutType ty1 - e <- docSharedWrapper layoutExpr exp1 - docAlt - [ docSeq - [ docForceSingleline e - , docSeparator - , docLit $ Text.pack "@" - , docForceSingleline t - ] - , docPar - e - (docSeq [docLit $ Text.pack "@", t ]) - ] - HsAppTypeOut{} -> do - -- TODO - briDocByExactInlineOnly "HsAppTypeOut{}" lexpr - OpApp expLeft@(L _ OpApp{}) expOp _ expRight -> do - let gather :: [(LHsExpr RdrName, LHsExpr RdrName)] -> LHsExpr RdrName -> (LHsExpr RdrName, [(LHsExpr RdrName, LHsExpr RdrName)]) - gather opExprList = \case - (L _ (OpApp l1 op1 _ r1)) -> gather ((op1, r1): opExprList) l1 - final -> (final, opExprList) - (leftOperand, appList) = gather [] expLeft - leftOperandDoc <- docSharedWrapper layoutExpr leftOperand - appListDocs <- appList `forM` \(x,y) -> [ (xD, yD) - | xD <- docSharedWrapper layoutExpr x - , yD <- docSharedWrapper layoutExpr y - ] - opLastDoc <- docSharedWrapper layoutExpr expOp - expLastDoc <- docSharedWrapper layoutExpr expRight - let allowPar = case (expOp, expRight) of - (L _ (HsVar (L _ (Unqual occname))), _) - | occNameString occname == "$" -> True - (_, L _ (HsApp _ (L _ HsVar{}))) -> False - _ -> True - docAlt - [ docSeq - [ appSep $ docForceSingleline leftOperandDoc - , docSeq - $ (appListDocs <&> \(od, ed) -> docSeq - [ appSep $ docForceSingleline od - , appSep $ docForceSingleline ed + binderDoc <- docLit $ Text.pack "->" + funcPatDocs <- docWrapNode lmatches $ layoutPatternBind Nothing binderDoc `mapM` matches + docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar + (docLit $ Text.pack "\\case") + (docSetBaseAndIndent $ docNonBottomSpacing $ docLines $ return <$> funcPatDocs) + HsApp exp1@(L _ HsApp{}) exp2 -> do + let gather :: [LHsExpr RdrName] -> LHsExpr RdrName -> (LHsExpr RdrName, [LHsExpr RdrName]) + gather list = \case + (L _ (HsApp l r)) -> gather (r:list) l + x -> (x, list) + let (headE, paramEs) = gather [exp2] exp1 + headDoc <- docSharedWrapper layoutExpr headE + paramDocs <- docSharedWrapper layoutExpr `mapM` paramEs + docAltFilter + [ -- foo x y + ( True + , docCols ColApp + $ appSep (docForceSingleline headDoc) + : spacifyDocs (docForceSingleline <$> paramDocs) + ) + , -- foo x + -- y + ( allowFreeIndent + , docSeq + [ appSep (docForceSingleline headDoc) + , docSetBaseY + $ docAddBaseY BrIndentRegular + $ docLines + $ (docForceSingleline <$> paramDocs) ] ) - , appSep $ docForceSingleline opLastDoc - , (if allowPar then docForceParSpacing else docForceSingleline) - expLastDoc - ] - -- this case rather leads to some unfortunate layouting than to anything - -- useful; disabling for now. (it interfers with cols stuff.) - -- , docSetBaseY - -- - $ docPar - -- leftOperandDoc - -- ( docLines - -- - $ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed]) - -- ++ [docCols ColOpPrefix [appSep opLastDoc, docSetBaseY expLastDoc]] - -- ) - , docPar - leftOperandDoc - ( docLines - $ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed]) - ++ [docCols ColOpPrefix [appSep opLastDoc, docSetBaseY expLastDoc]] + , -- foo + -- x + -- y + ( True + , docSetParSpacing + $ docAddBaseY BrIndentRegular + $ docPar + (docForceSingleline headDoc) + ( docNonBottomSpacing + $ docLines paramDocs + ) ) - ] - OpApp expLeft expOp _ expRight -> do - expDocLeft <- docSharedWrapper layoutExpr expLeft - expDocOp <- docSharedWrapper layoutExpr expOp - expDocRight <- docSharedWrapper layoutExpr expRight - let allowPar = case (expOp, expRight) of - (L _ (HsVar (L _ (Unqual occname))), _) - | occNameString occname == "$" -> True - (_, L _ (HsApp _ (L _ HsVar{}))) -> False - _ -> True - docAltFilter - $ [ -- one-line - (,) True - $ docSeq - [ appSep $ docForceSingleline expDocLeft - , appSep $ docForceSingleline expDocOp - , docForceSingleline expDocRight - ] - -- , -- line + freely indented block for right expression - -- docSeq - -- [ appSep $ docForceSingleline expDocLeft - -- , appSep $ docForceSingleline expDocOp - -- , docSetBaseY $ docAddBaseY BrIndentRegular expDocRight - -- ] - , -- two-line - (,) True - $ docAddBaseY BrIndentRegular + , -- ( multi + -- line + -- function + -- ) + -- x + -- y + ( True + , docAddBaseY BrIndentRegular $ docPar - expDocLeft - ( docForceSingleline - $ docCols ColOpPrefix [appSep $ expDocOp, docSetBaseY expDocRight] - ) - , -- one-line + par - (,) allowPar - $ docSeq - [ appSep $ docForceSingleline expDocLeft - , appSep $ docForceSingleline expDocOp - , docForceParSpacing expDocRight + headDoc + ( docNonBottomSpacing + $ docLines paramDocs + ) + ) + ] + HsApp exp1 exp2 -> do + -- TODO: if expDoc1 is some literal, we may want to create a docCols here. + expDoc1 <- docSharedWrapper layoutExpr exp1 + expDoc2 <- docSharedWrapper layoutExpr exp2 + docAlt + [ -- func arg + docSeq [appSep $ docForceSingleline expDoc1, docForceSingleline expDoc2] + , -- func argline1 + -- arglines + -- e.g. + -- func if x + -- then 1 + -- else 2 + docSetParSpacing + $ docAddBaseY BrIndentRegular + $ docSeq + [ appSep $ docForceSingleline expDoc1 + , docForceParSpacing expDoc2 + ] + , -- func + -- arg + docSetParSpacing + $ docAddBaseY BrIndentRegular + $ docPar + (docForceSingleline expDoc1) + (docNonBottomSpacing expDoc2) + , -- fu + -- nc + -- ar + -- gument + docAddBaseY BrIndentRegular + $ docPar + expDoc1 + expDoc2 + ] +#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ + HsAppType exp1 (HsWC _ ty1) -> do +#else /* ghc-8.0 */ + HsAppType exp1 (HsWC _ _ ty1) -> do +#endif + t <- docSharedWrapper layoutType ty1 + e <- docSharedWrapper layoutExpr exp1 + docAlt + [ docSeq + [ docForceSingleline e + , docSeparator + , docLit $ Text.pack "@" + , docForceSingleline t ] - , -- more lines - (,) True - $ docAddBaseY BrIndentRegular - $ docPar - expDocLeft - (docCols ColOpPrefix [appSep $ expDocOp, docSetBaseY expDocRight]) + , docPar + e + (docSeq [docLit $ Text.pack "@", t ]) + ] + HsAppTypeOut{} -> do + -- TODO + briDocByExactInlineOnly "HsAppTypeOut{}" lexpr + OpApp expLeft@(L _ OpApp{}) expOp _ expRight -> do + let gather :: [(LHsExpr RdrName, LHsExpr RdrName)] -> LHsExpr RdrName -> (LHsExpr RdrName, [(LHsExpr RdrName, LHsExpr RdrName)]) + gather opExprList = \case + (L _ (OpApp l1 op1 _ r1)) -> gather ((op1, r1): opExprList) l1 + final -> (final, opExprList) + (leftOperand, appList) = gather [] expLeft + leftOperandDoc <- docSharedWrapper layoutExpr leftOperand + appListDocs <- appList `forM` \(x,y) -> [ (xD, yD) + | xD <- docSharedWrapper layoutExpr x + , yD <- docSharedWrapper layoutExpr y + ] + opLastDoc <- docSharedWrapper layoutExpr expOp + expLastDoc <- docSharedWrapper layoutExpr expRight + let allowPar = case (expOp, expRight) of + (L _ (HsVar (L _ (Unqual occname))), _) + | occNameString occname == "$" -> True + (_, L _ (HsApp _ (L _ HsVar{}))) -> False + _ -> True + docAlt + [ docSeq + [ appSep $ docForceSingleline leftOperandDoc + , docSeq + $ (appListDocs <&> \(od, ed) -> docSeq + [ appSep $ docForceSingleline od + , appSep $ docForceSingleline ed + ] + ) + , appSep $ docForceSingleline opLastDoc + , (if allowPar then docForceParSpacing else docForceSingleline) + expLastDoc ] - NegApp op _ -> do - opDoc <- docSharedWrapper layoutExpr op - docSeq $ [ docLit $ Text.pack "-" - , opDoc - ] - HsPar innerExp -> do - innerExpDoc <- docSharedWrapper layoutExpr innerExp - docAlt - [ docSeq - [ docLit $ Text.pack "(" - , docForceSingleline innerExpDoc - , docLit $ Text.pack ")" + -- this case rather leads to some unfortunate layouting than to anything + -- useful; disabling for now. (it interfers with cols stuff.) + -- , docSetBaseY + -- - $ docPar + -- leftOperandDoc + -- ( docLines + -- - $ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed]) + -- ++ [docCols ColOpPrefix [appSep opLastDoc, docSetBaseY expLastDoc]] + -- ) + , docPar + leftOperandDoc + ( docLines + $ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed]) + ++ [docCols ColOpPrefix [appSep opLastDoc, docSetBaseY expLastDoc]] + ) ] - , docSetBaseY $ docLines - [ docCols ColOpPrefix - [ docParenLSep - , docAddBaseY (BrIndentSpecial 2) innerExpDoc - ] - , docLit $ Text.pack ")" - ] - ] - SectionL left op -> do -- TODO: add to testsuite - leftDoc <- docSharedWrapper layoutExpr left - opDoc <- docSharedWrapper layoutExpr op - docSeq [leftDoc, docSeparator, opDoc] - SectionR op right -> do -- TODO: add to testsuite - opDoc <- docSharedWrapper layoutExpr op - rightDoc <- docSharedWrapper layoutExpr right - docSeq [opDoc, docSeparator, rightDoc] - ExplicitTuple args boxity - | Just argExprs <- args `forM` (\case (L _ (Present e)) -> Just e; _ -> Nothing) -> do - argDocs <- docSharedWrapper layoutExpr `mapM` argExprs - hasComments <- hasAnyCommentsBelow lexpr - let (openLit, closeLit) = case boxity of - Boxed -> (docLit $ Text.pack "(", docLit $ Text.pack ")") - Unboxed -> (docLit $ Text.pack "(#", docLit $ Text.pack "#)") - case splitFirstLast argDocs of - FirstLastEmpty -> docSeq - [ openLit - , docNodeAnnKW lexpr (Just AnnOpenP) $ closeLit - ] - FirstLastSingleton e -> docAlt - [ docCols ColTuple - [ openLit - , docNodeAnnKW lexpr (Just AnnOpenP) $ docForceSingleline e - , closeLit + OpApp expLeft expOp _ expRight -> do + expDocLeft <- docSharedWrapper layoutExpr expLeft + expDocOp <- docSharedWrapper layoutExpr expOp + expDocRight <- docSharedWrapper layoutExpr expRight + let allowPar = case (expOp, expRight) of + (L _ (HsVar (L _ (Unqual occname))), _) + | occNameString occname == "$" -> True + (_, L _ (HsApp _ (L _ HsVar{}))) -> False + _ -> True + docAltFilter + $ [ -- one-line + (,) True + $ docSeq + [ appSep $ docForceSingleline expDocLeft + , appSep $ docForceSingleline expDocOp + , docForceSingleline expDocRight + ] + -- , -- line + freely indented block for right expression + -- docSeq + -- [ appSep $ docForceSingleline expDocLeft + -- , appSep $ docForceSingleline expDocOp + -- , docSetBaseY $ docAddBaseY BrIndentRegular expDocRight + -- ] + , -- two-line + (,) True + $ docAddBaseY BrIndentRegular + $ docPar + expDocLeft + ( docForceSingleline + $ docCols ColOpPrefix [appSep $ expDocOp, docSetBaseY expDocRight] + ) + , -- one-line + par + (,) allowPar + $ docSeq + [ appSep $ docForceSingleline expDocLeft + , appSep $ docForceSingleline expDocOp + , docForceParSpacing expDocRight + ] + , -- more lines + (,) True + $ docAddBaseY BrIndentRegular + $ docPar + expDocLeft + (docCols ColOpPrefix [appSep $ expDocOp, docSetBaseY expDocRight]) + ] + NegApp op _ -> do + opDoc <- docSharedWrapper layoutExpr op + docSeq $ [ docLit $ Text.pack "-" + , opDoc + ] + HsPar innerExp -> do + innerExpDoc <- docSharedWrapper layoutExpr innerExp + docAlt + [ docSeq + [ docLit $ Text.pack "(" + , docForceSingleline innerExpDoc + , docLit $ Text.pack ")" ] , docSetBaseY $ docLines - [ docSeq + [ docCols ColOpPrefix + [ docParenLSep + , docAddBaseY (BrIndentSpecial 2) innerExpDoc + ] + , docLit $ Text.pack ")" + ] + ] + SectionL left op -> do -- TODO: add to testsuite + leftDoc <- docSharedWrapper layoutExpr left + opDoc <- docSharedWrapper layoutExpr op + docSeq [leftDoc, docSeparator, opDoc] + SectionR op right -> do -- TODO: add to testsuite + opDoc <- docSharedWrapper layoutExpr op + rightDoc <- docSharedWrapper layoutExpr right + docSeq [opDoc, docSeparator, rightDoc] + ExplicitTuple args boxity + | Just argExprs <- args `forM` (\case (L _ (Present e)) -> Just e; _ -> Nothing) -> do + argDocs <- docSharedWrapper layoutExpr `mapM` argExprs + hasComments <- hasAnyCommentsBelow lexpr + let (openLit, closeLit) = case boxity of + Boxed -> (docLit $ Text.pack "(", docLit $ Text.pack ")") + Unboxed -> (docLit $ Text.pack "(#", docLit $ Text.pack "#)") + case splitFirstLast argDocs of + FirstLastEmpty -> docSeq + [ openLit + , docNodeAnnKW lexpr (Just AnnOpenP) $ closeLit + ] + FirstLastSingleton e -> docAlt + [ docCols ColTuple [ openLit , docNodeAnnKW lexpr (Just AnnOpenP) $ docForceSingleline e + , closeLit + ] + , docSetBaseY $ docLines + [ docSeq + [ openLit + , docNodeAnnKW lexpr (Just AnnOpenP) $ docForceSingleline e + ] + , closeLit ] - , closeLit ] - ] - FirstLast e1 ems eN -> - docAltFilter - [ (,) (not hasComments) - $ docCols ColTuple - ( [docSeq [openLit, docForceSingleline e1]] - ++ (ems <&> \e -> docSeq [docCommaSep, docForceSingleline e]) - ++ [docSeq [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) (docForceSingleline eN), closeLit]] + FirstLast e1 ems eN -> + docAltFilter + [ (,) (not hasComments) + $ docCols ColTuple + ( [docSeq [openLit, docForceSingleline e1]] + ++ (ems <&> \e -> docSeq [docCommaSep, docForceSingleline e]) + ++ [docSeq [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) (docForceSingleline eN), closeLit]] + ) + , (,) True + $ let + start = docCols ColTuples + [appSep $ openLit, e1] + linesM = ems <&> \d -> + docCols ColTuples [docCommaSep, d] + lineN = docCols ColTuples [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) eN] + end = closeLit + in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end] + ] + ExplicitTuple{} -> + unknownNodeError "ExplicitTuple|.." lexpr + HsCase cExp (MG lmatches@(L _ matches) _ _ _) -> do + cExpDoc <- docSharedWrapper layoutExpr cExp + binderDoc <- docLit $ Text.pack "->" + funcPatDocs <- docWrapNode lmatches $ layoutPatternBind Nothing binderDoc `mapM` matches + docAlt + [ docSetParSpacing + $ docAddBaseY BrIndentRegular + $ docPar + ( docSeq + [ appSep $ docLit $ Text.pack "case" + , appSep $ docForceSingleline cExpDoc + , docLit $ Text.pack "of" + ]) + (docSetBaseAndIndent $ docNonBottomSpacing $ docLines $ return <$> funcPatDocs) + , docPar + ( docAddBaseY BrIndentRegular + $ docPar (docLit $ Text.pack "case") cExpDoc + ) + ( docAddBaseY BrIndentRegular + $ docPar (docLit $ Text.pack "of") + (docSetBaseAndIndent $ docNonBottomSpacing $ docLines $ return <$> funcPatDocs) ) - , (,) True - $ let - start = docCols ColTuples - [appSep $ openLit, e1] - linesM = ems <&> \d -> - docCols ColTuples [docCommaSep, d] - lineN = docCols ColTuples [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) eN] - end = closeLit - in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end] - ] - ExplicitTuple{} -> - unknownNodeError "ExplicitTuple|.." lexpr - HsCase cExp (MG lmatches@(L _ matches) _ _ _) -> do - cExpDoc <- docSharedWrapper layoutExpr cExp - binderDoc <- docLit $ Text.pack "->" - funcPatDocs <- docWrapNode lmatches $ layoutPatternBind Nothing binderDoc `mapM` matches - docAlt - [ docSetParSpacing - $ docAddBaseY BrIndentRegular - $ docPar - ( docSeq - [ appSep $ docLit $ Text.pack "case" - , appSep $ docForceSingleline cExpDoc - , docLit $ Text.pack "of" - ]) - (docSetBaseAndIndent $ docNonBottomSpacing $ docLines $ return <$> funcPatDocs) - , docPar - ( docAddBaseY BrIndentRegular - $ docPar (docLit $ Text.pack "case") cExpDoc - ) - ( docAddBaseY BrIndentRegular - $ docPar (docLit $ Text.pack "of") - (docSetBaseAndIndent $ docNonBottomSpacing $ docLines $ return <$> funcPatDocs) - ) - ] - HsIf _ ifExpr thenExpr elseExpr -> do - ifExprDoc <- docSharedWrapper layoutExpr ifExpr - thenExprDoc <- docSharedWrapper layoutExpr thenExpr - elseExprDoc <- docSharedWrapper layoutExpr elseExpr - hasComments <- hasAnyCommentsBelow lexpr - docAltFilter - [ -- if _ then _ else _ - (,) (not hasComments) - $ docSeq - [ appSep $ docLit $ Text.pack "if" - , appSep $ docForceSingleline ifExprDoc - , appSep $ docLit $ Text.pack "then" - , appSep $ docForceSingleline thenExprDoc - , appSep $ docLit $ Text.pack "else" - , docForceSingleline elseExprDoc ] - , -- either - -- if expr - -- then foo - -- bar - -- else foo - -- bar - -- or - -- if expr - -- then - -- stuff - -- else - -- stuff - -- note that this has par-spacing - (,) True - $ docSetParSpacing - $ docAddBaseY BrIndentRegular - $ docPar - ( docAddBaseY (BrIndentSpecial 3) - $ docSeq - [ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if" - , docNodeAnnKW lexpr (Just AnnIf) $ docForceSingleline ifExprDoc - ]) - (docLines - [ docAddBaseY BrIndentRegular - $ docNodeAnnKW lexpr (Just AnnThen) - $ docAlt - [ docSeq [appSep $ docLit $ Text.pack "then", docForceParSpacing thenExprDoc] + HsIf _ ifExpr thenExpr elseExpr -> do + ifExprDoc <- docSharedWrapper layoutExpr ifExpr + thenExprDoc <- docSharedWrapper layoutExpr thenExpr + elseExprDoc <- docSharedWrapper layoutExpr elseExpr + hasComments <- hasAnyCommentsBelow lexpr + let maySpecialIndent = + case indentPolicy of + IndentPolicyLeft -> BrIndentRegular + _ -> BrIndentSpecial 3 + -- TODO: some of the alternatives (especially last and last-but-one) + -- overlap. + docAltFilter + [ -- if _ then _ else _ + (,) (not hasComments) + $ docSeq + [ appSep $ docLit $ Text.pack "if" + , appSep $ docForceSingleline ifExprDoc + , appSep $ docLit $ Text.pack "then" + , appSep $ docForceSingleline thenExprDoc + , appSep $ docLit $ Text.pack "else" + , docForceSingleline elseExprDoc + ] + , -- either + -- if expr + -- then foo + -- bar + -- else foo + -- bar + -- or + -- if expr + -- then + -- stuff + -- else + -- stuff + -- note that this has par-spacing + (,) True + $ docSetParSpacing + $ docAddBaseY BrIndentRegular + $ docPar + ( docSeq + [ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if" + , docNodeAnnKW lexpr (Just AnnIf) $ docForceSingleline ifExprDoc + ]) + (docLines + [ docAddBaseY BrIndentRegular + $ docNodeAnnKW lexpr (Just AnnThen) + $ docAlt + [ docSeq [appSep $ docLit $ Text.pack "then", docForceParSpacing thenExprDoc] + , docAddBaseY BrIndentRegular + $ docPar (docLit $ Text.pack "then") thenExprDoc + ] , docAddBaseY BrIndentRegular - $ docPar (docLit $ Text.pack "then") thenExprDoc - ] - , docAddBaseY BrIndentRegular - $ docAlt - [ docSeq [appSep $ docLit $ Text.pack "else", docForceParSpacing elseExprDoc] + $ docAlt + [ docSeq [appSep $ docLit $ Text.pack "else", docForceParSpacing elseExprDoc] + , docAddBaseY BrIndentRegular + $ docPar (docLit $ Text.pack "else") elseExprDoc + ] + ]) + , -- either + -- if multi + -- line + -- condition + -- then foo + -- bar + -- else foo + -- bar + -- or + -- if multi + -- line + -- condition + -- then + -- stuff + -- else + -- stuff + -- note that this does _not_ have par-spacing + (,) True + $ docAddBaseY BrIndentRegular + $ docPar + ( docAddBaseY maySpecialIndent + $ docSeq + [ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if" + , docNodeAnnKW lexpr (Just AnnIf) $ ifExprDoc + ]) + (docLines + [ docAddBaseY BrIndentRegular + $ docNodeAnnKW lexpr (Just AnnThen) + $ docAlt + [ docSeq [appSep $ docLit $ Text.pack "then", docForceParSpacing thenExprDoc] + , docAddBaseY BrIndentRegular + $ docPar (docLit $ Text.pack "then") thenExprDoc + ] , docAddBaseY BrIndentRegular - $ docPar (docLit $ Text.pack "else") elseExprDoc - ] - ]) - , -- either - -- if multi - -- line - -- condition - -- then foo - -- bar - -- else foo - -- bar - -- or - -- if multi - -- line - -- condition - -- then - -- stuff - -- else - -- stuff - -- note that this does _not_ have par-spacing - (,) True - $ docAddBaseY BrIndentRegular - $ docPar - ( docAddBaseY (BrIndentSpecial 3) + $ docAlt + [ docSeq [appSep $ docLit $ Text.pack "else", docForceParSpacing elseExprDoc] + , docAddBaseY BrIndentRegular + $ docPar (docLit $ Text.pack "else") elseExprDoc + ] + ]) + , (,) True + $ docSetBaseY + $ docLines + [ docAddBaseY maySpecialIndent $ docSeq [ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if" , docNodeAnnKW lexpr (Just AnnIf) $ ifExprDoc - ]) - (docLines - [ docAddBaseY BrIndentRegular - $ docNodeAnnKW lexpr (Just AnnThen) - $ docAlt - [ docSeq [appSep $ docLit $ Text.pack "then", docForceParSpacing thenExprDoc] - , docAddBaseY BrIndentRegular - $ docPar (docLit $ Text.pack "then") thenExprDoc - ] - , docAddBaseY BrIndentRegular - $ docAlt - [ docSeq [appSep $ docLit $ Text.pack "else", docForceParSpacing elseExprDoc] - , docAddBaseY BrIndentRegular - $ docPar (docLit $ Text.pack "else") elseExprDoc - ] - ]) - , (,) True - $ docSetBaseY - $ docLines - [ docAddBaseY (BrIndentSpecial 3) - $ docSeq - [ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if" - , docNodeAnnKW lexpr (Just AnnIf) $ ifExprDoc + ] + , docNodeAnnKW lexpr (Just AnnThen) + $ docAddBaseY BrIndentRegular + $ docPar (docLit $ Text.pack "then") thenExprDoc + , docAddBaseY BrIndentRegular + $ docPar (docLit $ Text.pack "else") elseExprDoc ] - , docNodeAnnKW lexpr (Just AnnThen) + ] + HsMultiIf _ cases -> do + clauseDocs <- cases `forM` layoutGrhs + binderDoc <- docLit $ Text.pack "->" + hasComments <- hasAnyCommentsBelow lexpr + docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar + (docLit $ Text.pack "if") + (layoutPatternBindFinal Nothing binderDoc Nothing clauseDocs Nothing hasComments) + HsLet binds exp1 -> do + expDoc1 <- docSharedWrapper layoutExpr exp1 + mBindDocs <- layoutLocalBinds binds + -- this `docSetIndentLevel` might seem out of place, but is here due to + -- ghc-exactprint's DP handling of "let" in particular. + -- Just pushing another indentation level is a straightforward approach + -- to making brittany idempotent, even though the result is non-optimal + -- if "let" is moved horizontally as part of the transformation, as the + -- comments before the first let item are moved horizontally with it. + docSetIndentLevel $ case mBindDocs of + Just [bindDoc] -> docAltFilter + [ ( True + , docSeq + [ appSep $ docLit $ Text.pack "let" + , appSep $ docForceSingleline $ return bindDoc + , appSep $ docLit $ Text.pack "in" + , docForceSingleline $ expDoc1 + ] + ) + , ( indentPolicy /= IndentPolicyLeft + , docLines + [ docSeq + [ appSep $ docLit $ Text.pack "let" + , docSetBaseAndIndent $ return bindDoc + ] + , docSeq + [ appSep $ docLit $ Text.pack "in " + , docSetBaseY $ expDoc1 + ] + ] + ) + , ( True + , docLines + [ docAddBaseY BrIndentRegular + $ docPar + (appSep $ docLit $ Text.pack "let") + (docSetBaseAndIndent $ return bindDoc) + , docAddBaseY BrIndentRegular + $ docPar + (appSep $ docLit $ Text.pack "in") + (docSetBaseY $ expDoc1) + ] + ) + ] + Just bindDocs@(_:_) -> docAltFilter + --either + -- let + -- a = b + -- c = d + -- in foo + -- bar + -- baz + --or + -- let + -- a = b + -- c = d + -- in + -- fooooooooooooooooooo + [ ( indentPolicy == IndentPolicyLeft + , docLines + [ docAddBaseY BrIndentRegular + $ docPar + (docLit $ Text.pack "let") + (docSetBaseAndIndent $ docLines $ return <$> bindDocs) + , docSeq + [ docLit $ Text.pack "in " + , docAddBaseY BrIndentRegular $ expDoc1 + ] + ] + ) + , ( indentPolicy /= IndentPolicyLeft + , docLines + [ docSeq + [ appSep $ docLit $ Text.pack "let" + , docSetBaseAndIndent $ docLines $ return <$> bindDocs + ] + , docSeq + [ appSep $ docLit $ Text.pack "in " + , docSetBaseY $ expDoc1 + ] + ] + ) + , ( True + , docLines + [ docAddBaseY BrIndentRegular + $ docPar + (docLit $ Text.pack "let") + (docSetBaseAndIndent $ docLines $ return <$> bindDocs) + , docAddBaseY BrIndentRegular + $ docPar + (docLit $ Text.pack "in") + (docSetBaseY $ expDoc1) + ] + ) + ] + _ -> docSeq [appSep $ docLit $ Text.pack "let in", expDoc1] + -- docSeq [appSep $ docLit "let in", expDoc1] + HsDo DoExpr (L _ stmts) _ -> do + stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts + docSetParSpacing $ docAddBaseY BrIndentRegular - $ docPar (docLit $ Text.pack "then") thenExprDoc - , docAddBaseY BrIndentRegular - $ docPar (docLit $ Text.pack "else") elseExprDoc - ] - ] - HsMultiIf _ cases -> do - clauseDocs <- cases `forM` layoutGrhs - binderDoc <- docLit $ Text.pack "->" - hasComments <- hasAnyCommentsBelow lexpr - docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar - (docLit $ Text.pack "if") - (layoutPatternBindFinal Nothing binderDoc Nothing clauseDocs Nothing hasComments) - HsLet binds exp1 -> do - expDoc1 <- docSharedWrapper layoutExpr exp1 - mBindDocs <- layoutLocalBinds binds - -- this `docSetIndentLevel` might seem out of place, but is here due to - -- ghc-exactprint's DP handling of "let" in particular. - -- Just pushing another indentation level is a straightforward approach - -- to making brittany idempotent, even though the result is non-optimal - -- if "let" is moved horizontally as part of the transformation, as the - -- comments before the first let item are moved horizontally with it. - docSetIndentLevel $ case mBindDocs of - Just [bindDoc] -> docAlt - [ docSeq - [ appSep $ docLit $ Text.pack "let" - , appSep $ docForceSingleline $ return bindDoc - , appSep $ docLit $ Text.pack "in" - , docForceSingleline $ expDoc1 - ] - , docLines - [ docSeq - [ appSep $ docLit $ Text.pack "let" - , docSetBaseAndIndent $ return bindDoc - ] - , docSeq - [ appSep $ docLit $ Text.pack "in " - , docSetBaseY $ expDoc1 - ] - ] - , docLines - [ docAddBaseY BrIndentRegular - $ docPar - (appSep $ docLit $ Text.pack "let") - (docSetBaseAndIndent $ return bindDoc) - , docAddBaseY BrIndentRegular - $ docPar - (appSep $ docLit $ Text.pack "in") - (docSetBaseY $ expDoc1) + $ docPar + (docLit $ Text.pack "do") + (docSetBaseAndIndent $ docNonBottomSpacing $ docLines stmtDocs) + HsDo MDoExpr (L _ stmts) _ -> do + stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts + docSetParSpacing + $ docAddBaseY BrIndentRegular + $ docPar + (docLit $ Text.pack "mdo") + (docSetBaseAndIndent $ docNonBottomSpacing $ docLines stmtDocs) + HsDo x (L _ stmts) _ | case x of { ListComp -> True + ; MonadComp -> True + ; _ -> False } -> do + stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts + hasComments <- hasAnyCommentsBelow lexpr + docAltFilter + [ (,) (not hasComments) + $ docSeq + [ docNodeAnnKW lexpr Nothing + $ appSep + $ docLit + $ Text.pack "[" + , docNodeAnnKW lexpr (Just AnnOpenS) + $ appSep + $ docForceSingleline + $ List.last stmtDocs + , appSep $ docLit $ Text.pack "|" + , docSeq $ List.intersperse docCommaSep + $ fmap docForceSingleline $ List.init stmtDocs + , docLit $ Text.pack " ]" ] + , (,) True + $ let + start = docCols ColListComp + [ docNodeAnnKW lexpr Nothing + $ appSep $ docLit $ Text.pack "[" + , docSetBaseY + $ docNodeAnnKW lexpr (Just AnnOpenS) + $ List.last stmtDocs + ] + (s1:sM) = List.init stmtDocs + line1 = docCols ColListComp + [appSep $ docLit $ Text.pack "|", s1] + lineM = sM <&> \d -> + docCols ColListComp [docCommaSep, d] + end = docLit $ Text.pack "]" + in docSetBaseY $ docLines $ [start, line1] ++ lineM ++ [end] ] - Just bindDocs@(_:_) -> docAlt - [ docLines - [ docSeq - [ appSep $ docLit $ Text.pack "let" - , docSetBaseAndIndent $ docLines $ return <$> bindDocs - ] - , docSeq - [ appSep $ docLit $ Text.pack "in " - , docSetBaseY $ expDoc1 - ] - ] - , docLines - [ docAddBaseY BrIndentRegular - $ docPar - (docLit $ Text.pack "let") - (docSetBaseAndIndent $ docLines $ return <$> bindDocs) - , docAddBaseY BrIndentRegular - $ docPar - (docLit $ Text.pack "in") - (docSetBaseY $ expDoc1) - ] - ] - _ -> docSeq [appSep $ docLit $ Text.pack "let in", expDoc1] - -- docSeq [appSep $ docLit "let in", expDoc1] - HsDo DoExpr (L _ stmts) _ -> do - stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts - docSetParSpacing - $ docAddBaseY BrIndentRegular - $ docPar - (docLit $ Text.pack "do") - (docSetBaseAndIndent $ docNonBottomSpacing $ docLines stmtDocs) - HsDo MDoExpr (L _ stmts) _ -> do - stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts - docSetParSpacing - $ docAddBaseY BrIndentRegular - $ docPar - (docLit $ Text.pack "mdo") - (docSetBaseAndIndent $ docNonBottomSpacing $ docLines stmtDocs) - HsDo x (L _ stmts) _ | case x of { ListComp -> True - ; MonadComp -> True - ; _ -> False } -> do - stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts - hasComments <- hasAnyCommentsBelow lexpr - docAltFilter - [ (,) (not hasComments) - $ docSeq - [ docNodeAnnKW lexpr Nothing - $ appSep - $ docLit - $ Text.pack "[" - , docNodeAnnKW lexpr (Just AnnOpenS) - $ appSep - $ docForceSingleline - $ List.last stmtDocs - , appSep $ docLit $ Text.pack "|" - , docSeq $ List.intersperse docCommaSep - $ fmap docForceSingleline $ List.init stmtDocs - , docLit $ Text.pack " ]" - ] - , (,) True - $ let - start = docCols ColListComp - [ docNodeAnnKW lexpr Nothing - $ appSep $ docLit $ Text.pack "[" - , docSetBaseY - $ docNodeAnnKW lexpr (Just AnnOpenS) - $ List.last stmtDocs - ] - (s1:sM) = List.init stmtDocs - line1 = docCols ColListComp - [appSep $ docLit $ Text.pack "|", s1] - lineM = sM <&> \d -> - docCols ColListComp [docCommaSep, d] - end = docLit $ Text.pack "]" - in docSetBaseY $ docLines $ [start, line1] ++ lineM ++ [end] - ] - HsDo{} -> do - -- TODO - unknownNodeError "HsDo{} no comp" lexpr - ExplicitList _ _ elems@(_:_) -> do - elemDocs <- elems `forM` docSharedWrapper layoutExpr - hasComments <- hasAnyCommentsBelow lexpr - case splitFirstLast elemDocs of - FirstLastEmpty -> docSeq - [ docLit $ Text.pack "[" - , docNodeAnnKW lexpr (Just AnnOpenS) $ docLit $ Text.pack "]" - ] - FirstLastSingleton e -> docAlt - [ docSeq + HsDo{} -> do + -- TODO + unknownNodeError "HsDo{} no comp" lexpr + ExplicitList _ _ elems@(_:_) -> do + elemDocs <- elems `forM` docSharedWrapper layoutExpr + hasComments <- hasAnyCommentsBelow lexpr + case splitFirstLast elemDocs of + FirstLastEmpty -> docSeq [ docLit $ Text.pack "[" - , docNodeAnnKW lexpr (Just AnnOpenS) $ docForceSingleline e - , docLit $ Text.pack "]" + , docNodeAnnKW lexpr (Just AnnOpenS) $ docLit $ Text.pack "]" ] - , docSetBaseY $ docLines + FirstLastSingleton e -> docAlt [ docSeq [ docLit $ Text.pack "[" - , docSeparator - , docSetBaseY $ docNodeAnnKW lexpr (Just AnnOpenS) $ e + , docNodeAnnKW lexpr (Just AnnOpenS) $ docForceSingleline e + , docLit $ Text.pack "]" + ] + , docSetBaseY $ docLines + [ docSeq + [ docLit $ Text.pack "[" + , docSeparator + , docSetBaseY $ docNodeAnnKW lexpr (Just AnnOpenS) $ e + ] + , docLit $ Text.pack "]" ] - , docLit $ Text.pack "]" ] - ] - FirstLast e1 ems eN -> - docAltFilter - [ (,) (not hasComments) - $ docSeq - $ [docLit $ Text.pack "["] - ++ List.intersperse docCommaSep (docForceSingleline <$> (e1:ems ++ [docNodeAnnKW lexpr (Just AnnOpenS) eN])) - ++ [docLit $ Text.pack "]"] - , (,) True - $ let - start = docCols ColList - [appSep $ docLit $ Text.pack "[", e1] - linesM = ems <&> \d -> - docCols ColList [docCommaSep, d] - lineN = docCols ColList [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenS) eN] - end = docLit $ Text.pack "]" - in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end] - ] - ExplicitList _ _ [] -> - docLit $ Text.pack "[]" - ExplicitPArr{} -> do - -- TODO - briDocByExactInlineOnly "ExplicitPArr{}" lexpr - RecordCon lname _ _ (HsRecFields [] Nothing) -> do - let t = lrdrNameToText lname - docWrapNode lname $ docSeq - [ docNodeAnnKW lexpr (Just AnnOpenC) $ docLit $ t <> Text.pack "{" - , docLit $ Text.pack "}" - ] - RecordCon lname _ _ (HsRecFields fs@(_:_) Nothing) -> do - let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname - ((fd1l, fd1n, fd1e):fdr) <- fs `forM` \fieldl@(L _ (HsRecField (L _ (FieldOcc lnameF _)) fExpr pun)) -> do - fExpDoc <- if pun - then return Nothing - else Just <$> docSharedWrapper layoutExpr fExpr - return $ (fieldl, lrdrNameToText lnameF, fExpDoc) - let line1 appender wrapper = - [ appender $ docLit $ Text.pack "{" - , docWrapNodePrior fd1l $ appSep $ docLit $ fd1n - , case fd1e of - Just x -> docSeq - [ appSep $ docLit $ Text.pack "=" - , docWrapNodeRest fd1l $ wrapper $ x - ] - Nothing -> docEmpty - ] - let lineR wrapper = fdr <&> \(lfield, fText, fDoc) -> - [ docCommaSep - , appSep $ docLit $ fText - , case fDoc of - Just x -> docWrapNode lfield $ docSeq - [ appSep $ docLit $ Text.pack "=" - , wrapper x - ] - Nothing -> docEmpty - ] - let lineN = - [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty - , docLit $ Text.pack "}" - ] - docAlt - [ docSeq - $ [docNodeAnnKW lexpr Nothing $ nameDoc, docSeparator] - ++ line1 id docForceSingleline - ++ join (lineR docForceSingleline) - ++ lineN - , docSetParSpacing - $ docAddBaseY BrIndentRegular - $ docPar - (docNodeAnnKW lexpr Nothing $ nameDoc) - ( docNonBottomSpacing - $ docLines - $ [docCols ColRecUpdate $ line1 appSep (docAddBaseY BrIndentRegular)] - ++ (docCols ColRecUpdate <$> lineR (docAddBaseY BrIndentRegular)) - ++ [docSeq lineN] - ) - ] - RecordCon lname _ _ (HsRecFields [] (Just 0)) -> do - let t = lrdrNameToText lname - docWrapNode lname $ docLit $ t <> Text.pack " {..}" - RecordCon lname _ _ (HsRecFields fs@(_:_) (Just dotdoti)) | dotdoti == length fs -> do - let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname - ((fd1l, fd1n, fd1e):fdr) <- fs `forM` \fieldl@(L _ (HsRecField (L _ (FieldOcc lnameF _)) fExpr pun)) -> do - fExpDoc <- if pun - then return Nothing - else Just <$> docSharedWrapper layoutExpr fExpr - return $ (fieldl, lrdrNameToText lnameF, fExpDoc) - let line1 appender wrapper = - [ appender $ docLit $ Text.pack "{" - , docWrapNodePrior fd1l $ appSep $ docLit $ fd1n - , case fd1e of - Just x -> docSeq - [ appSep $ docLit $ Text.pack "=" - , docWrapNodeRest fd1l $ wrapper $ x - ] - Nothing -> docEmpty - ] - let lineR wrapper = fdr <&> \(lfield, fText, fDoc) -> - [ docCommaSep - , appSep $ docLit $ fText - , case fDoc of - Just x -> docWrapNode lfield $ docSeq - [ appSep $ docLit $ Text.pack "=" - , wrapper x - ] - Nothing -> docEmpty - ] - let lineDot = - [ docCommaSep - , docLit $ Text.pack ".." - ] - let lineN = - [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty - , docLit $ Text.pack "}" - ] - docAlt - [ docSeq - $ [docNodeAnnKW lexpr Nothing $ nameDoc, docSeparator] - ++ line1 id docForceSingleline - ++ join (lineR docForceSingleline) - ++ lineDot - ++ lineN - , docSetParSpacing - $ docAddBaseY BrIndentRegular - $ docPar - (docNodeAnnKW lexpr Nothing $ nameDoc) - ( docNonBottomSpacing - $ docLines - $ [docCols ColRecUpdate $ line1 appSep (docAddBaseY BrIndentRegular)] - ++ (docCols ColRecUpdate <$> lineR (docAddBaseY BrIndentRegular)) - ++ [docSeq lineDot, docSeq lineN] - ) - ] - RecordCon{} -> - unknownNodeError "RecordCon with puns" lexpr - RecordUpd rExpr [] _ _ _ _ -> do - rExprDoc <- docSharedWrapper layoutExpr rExpr - docSeq [rExprDoc, docLit $ Text.pack "{}"] - RecordUpd rExpr fields@(_:_) _ _ _ _ -> do - rExprDoc <- docSharedWrapper layoutExpr rExpr - rFs@((rF1f, rF1n, rF1e):rFr) <- fields - `forM` \lfield@(L _ (HsRecField (L _ ambName) rFExpr pun)) -> do - rFExpDoc <- if pun - then return Nothing - else Just <$> docSharedWrapper layoutExpr rFExpr - return $ case ambName of - Unambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc) - Ambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc) - docAlt - -- singleline - [ docSeq - [ docNodeAnnKW lexpr Nothing $ appSep $ docForceSingleline rExprDoc - , appSep $ docLit $ Text.pack "{" - , appSep $ docSeq $ List.intersperse docCommaSep - $ rFs <&> \case - (lfield, fieldStr, Just fieldDoc) -> - docWrapNode lfield $ docSeq - [ appSep $ docLit fieldStr - , appSep $ docLit $ Text.pack "=" - , docForceSingleline fieldDoc - ] - (lfield, fieldStr, Nothing) -> - docWrapNode lfield $ docLit fieldStr + FirstLast e1 ems eN -> + docAltFilter + [ (,) (not hasComments) + $ docSeq + $ [docLit $ Text.pack "["] + ++ List.intersperse docCommaSep (docForceSingleline <$> (e1:ems ++ [docNodeAnnKW lexpr (Just AnnOpenS) eN])) + ++ [docLit $ Text.pack "]"] + , (,) True + $ let + start = docCols ColList + [appSep $ docLit $ Text.pack "[", e1] + linesM = ems <&> \d -> + docCols ColList [docCommaSep, d] + lineN = docCols ColList [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenS) eN] + end = docLit $ Text.pack "]" + in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end] + ] + ExplicitList _ _ [] -> + docLit $ Text.pack "[]" + ExplicitPArr{} -> do + -- TODO + briDocByExactInlineOnly "ExplicitPArr{}" lexpr + RecordCon lname _ _ (HsRecFields [] Nothing) -> do + let t = lrdrNameToText lname + docWrapNode lname $ docSeq + [ docNodeAnnKW lexpr (Just AnnOpenC) $ docLit $ t <> Text.pack "{" , docLit $ Text.pack "}" ] - -- wild-indentation block - , docSeq - [ docNodeAnnKW lexpr Nothing $ appSep rExprDoc - , docSetBaseY $ docLines $ let - line1 = docCols ColRecUpdate - [ appSep $ docLit $ Text.pack "{" - , docWrapNodePrior rF1f $ appSep $ docLit $ rF1n - , case rF1e of - Just x -> docWrapNodeRest rF1f $ docSeq - [ appSep $ docLit $ Text.pack "=" - , docForceSingleline $ x - ] - Nothing -> docEmpty - ] - lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield $ docCols ColRecUpdate - [ docCommaSep - , appSep $ docLit $ fText - , case fDoc of - Just x -> docSeq [ appSep $ docLit $ Text.pack "=" - , docForceSingleline x - ] - Nothing -> docEmpty - ] - lineN = docSeq - [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty - , docLit $ Text.pack "}" - ] - in [line1] ++ lineR ++ [lineN] + RecordCon lname _ _ (HsRecFields fs@(_:_) Nothing) -> do + let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname + ((fd1l, fd1n, fd1e):fdr) <- fs `forM` \fieldl@(L _ (HsRecField (L _ (FieldOcc lnameF _)) fExpr pun)) -> do + fExpDoc <- if pun + then return Nothing + else Just <$> docSharedWrapper layoutExpr fExpr + return $ (fieldl, lrdrNameToText lnameF, fExpDoc) + let line1 appender wrapper = + [ appender $ docLit $ Text.pack "{" + , docWrapNodePrior fd1l $ appSep $ docLit $ fd1n + , case fd1e of + Just x -> docSeq + [ appSep $ docLit $ Text.pack "=" + , docWrapNodeRest fd1l $ wrapper $ x + ] + Nothing -> docEmpty + ] + let lineR wrapper = fdr <&> \(lfield, fText, fDoc) -> + [ docCommaSep + , appSep $ docLit $ fText + , case fDoc of + Just x -> docWrapNode lfield $ docSeq + [ appSep $ docLit $ Text.pack "=" + , wrapper x + ] + Nothing -> docEmpty + ] + let lineN = + [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty + , docLit $ Text.pack "}" + ] + docAlt + [ docSeq + $ [docNodeAnnKW lexpr Nothing $ nameDoc, docSeparator] + ++ line1 id docForceSingleline + ++ join (lineR docForceSingleline) + ++ lineN + , docSetParSpacing + $ docAddBaseY BrIndentRegular + $ docPar + (docNodeAnnKW lexpr Nothing $ nameDoc) + ( docNonBottomSpacing + $ docLines + $ [docCols ColRecUpdate $ line1 appSep (docAddBaseY BrIndentRegular)] + ++ (docCols ColRecUpdate <$> lineR (docAddBaseY BrIndentRegular)) + ++ [docSeq lineN] + ) + ] + RecordCon lname _ _ (HsRecFields [] (Just 0)) -> do + let t = lrdrNameToText lname + docWrapNode lname $ docLit $ t <> Text.pack " {..}" + RecordCon lname _ _ (HsRecFields fs@(_:_) (Just dotdoti)) | dotdoti == length fs -> do + let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname + ((fd1l, fd1n, fd1e):fdr) <- fs `forM` \fieldl@(L _ (HsRecField (L _ (FieldOcc lnameF _)) fExpr pun)) -> do + fExpDoc <- if pun + then return Nothing + else Just <$> docSharedWrapper layoutExpr fExpr + return $ (fieldl, lrdrNameToText lnameF, fExpDoc) + let line1 appender wrapper = + [ appender $ docLit $ Text.pack "{" + , docWrapNodePrior fd1l $ appSep $ docLit $ fd1n + , case fd1e of + Just x -> docSeq + [ appSep $ docLit $ Text.pack "=" + , docWrapNodeRest fd1l $ wrapper $ x + ] + Nothing -> docEmpty + ] + let lineR wrapper = fdr <&> \(lfield, fText, fDoc) -> + [ docCommaSep + , appSep $ docLit $ fText + , case fDoc of + Just x -> docWrapNode lfield $ docSeq + [ appSep $ docLit $ Text.pack "=" + , wrapper x + ] + Nothing -> docEmpty + ] + let lineDot = + [ docCommaSep + , docLit $ Text.pack ".." + ] + let lineN = + [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty + , docLit $ Text.pack "}" + ] + docAlt + [ docSeq + $ [docNodeAnnKW lexpr Nothing $ nameDoc, docSeparator] + ++ line1 id docForceSingleline + ++ join (lineR docForceSingleline) + ++ lineDot + ++ lineN + , docSetParSpacing + $ docAddBaseY BrIndentRegular + $ docPar + (docNodeAnnKW lexpr Nothing $ nameDoc) + ( docNonBottomSpacing + $ docLines + $ [docCols ColRecUpdate $ line1 appSep (docAddBaseY BrIndentRegular)] + ++ (docCols ColRecUpdate <$> lineR (docAddBaseY BrIndentRegular)) + ++ [docSeq lineDot, docSeq lineN] + ) + ] + RecordCon{} -> + unknownNodeError "RecordCon with puns" lexpr + RecordUpd rExpr [] _ _ _ _ -> do + rExprDoc <- docSharedWrapper layoutExpr rExpr + docSeq [rExprDoc, docLit $ Text.pack "{}"] + RecordUpd rExpr fields@(_:_) _ _ _ _ -> do + rExprDoc <- docSharedWrapper layoutExpr rExpr + rFs@((rF1f, rF1n, rF1e):rFr) <- fields + `forM` \lfield@(L _ (HsRecField (L _ ambName) rFExpr pun)) -> do + rFExpDoc <- if pun + then return Nothing + else Just <$> docSharedWrapper layoutExpr rFExpr + return $ case ambName of + Unambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc) + Ambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc) + docAltFilter + -- singleline + [ ( True + , docSeq + [ docNodeAnnKW lexpr Nothing $ appSep $ docForceSingleline rExprDoc + , appSep $ docLit $ Text.pack "{" + , appSep $ docSeq $ List.intersperse docCommaSep + $ rFs <&> \case + (lfield, fieldStr, Just fieldDoc) -> + docWrapNode lfield $ docSeq + [ appSep $ docLit fieldStr + , appSep $ docLit $ Text.pack "=" + , docForceSingleline fieldDoc + ] + (lfield, fieldStr, Nothing) -> + docWrapNode lfield $ docLit fieldStr + , docLit $ Text.pack "}" + ] + ) + -- wild-indentation block + , ( indentPolicy /= IndentPolicyLeft + , docSeq + [ docNodeAnnKW lexpr Nothing $ appSep rExprDoc + , docSetBaseY $ docLines $ let + line1 = docCols ColRecUpdate + [ appSep $ docLit $ Text.pack "{" + , docWrapNodePrior rF1f $ appSep $ docLit $ rF1n + , case rF1e of + Just x -> docWrapNodeRest rF1f $ docSeq + [ appSep $ docLit $ Text.pack "=" + , docForceSingleline $ x + ] + Nothing -> docEmpty + ] + lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield $ docCols ColRecUpdate + [ docCommaSep + , appSep $ docLit $ fText + , case fDoc of + Just x -> docSeq [ appSep $ docLit $ Text.pack "=" + , docForceSingleline x + ] + Nothing -> docEmpty + ] + lineN = docSeq + [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty + , docLit $ Text.pack "}" + ] + in [line1] ++ lineR ++ [lineN] + ] + ) + -- strict indentation block + , ( True + , docSetParSpacing + $ docAddBaseY BrIndentRegular + $ docPar + (docNodeAnnKW lexpr Nothing $ rExprDoc) + (docNonBottomSpacing $ docLines $ let + line1 = docCols ColRecUpdate + [ appSep $ docLit $ Text.pack "{" + , docWrapNodePrior rF1f $ appSep $ docLit $ rF1n + , docWrapNodeRest rF1f $ case rF1e of + Just x -> docSeq [ appSep $ docLit $ Text.pack "=" + , docAddBaseY BrIndentRegular $ x + ] + Nothing -> docEmpty + ] + lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield $ docCols ColRecUpdate + [ docCommaSep + , appSep $ docLit $ fText + , case fDoc of + Just x -> docSeq [ appSep $ docLit $ Text.pack "=" + , docAddBaseY BrIndentRegular x + ] + Nothing -> docEmpty + ] + lineN = docSeq + [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty + , docLit $ Text.pack "}" + ] + in [line1] ++ lineR ++ [lineN]) + ) ] - -- strict indentation block - , docSetParSpacing - $ docAddBaseY BrIndentRegular - $ docPar - (docNodeAnnKW lexpr Nothing $ rExprDoc) - (docNonBottomSpacing $ docLines $ let - line1 = docCols ColRecUpdate - [ appSep $ docLit $ Text.pack "{" - , docWrapNodePrior rF1f $ appSep $ docLit $ rF1n - , docWrapNodeRest rF1f $ case rF1e of - Just x -> docSeq [ appSep $ docLit $ Text.pack "=" - , docAddBaseY BrIndentRegular $ x - ] - Nothing -> docEmpty - ] - lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield $ docCols ColRecUpdate - [ docCommaSep - , appSep $ docLit $ fText - , case fDoc of - Just x -> docSeq [ appSep $ docLit $ Text.pack "=" - , docAddBaseY BrIndentRegular x - ] - Nothing -> docEmpty - ] - lineN = docSeq - [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty - , docLit $ Text.pack "}" - ] - in [line1] ++ lineR ++ [lineN]) - ] #if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ - ExprWithTySig exp1 (HsWC _ (HsIB _ typ1 _)) -> do + ExprWithTySig exp1 (HsWC _ (HsIB _ typ1 _)) -> do #else /* ghc-8.0 */ - ExprWithTySig exp1 (HsIB _ (HsWC _ _ typ1)) -> do + ExprWithTySig exp1 (HsIB _ (HsWC _ _ typ1)) -> do #endif - expDoc <- docSharedWrapper layoutExpr exp1 - typDoc <- docSharedWrapper layoutType typ1 - docSeq - [ appSep expDoc - , appSep $ docLit $ Text.pack "::" - , typDoc - ] - ExprWithTySigOut{} -> do - -- TODO - briDocByExactInlineOnly "ExprWithTySigOut{}" lexpr - ArithSeq _ Nothing info -> - case info of - From e1 -> do - e1Doc <- docSharedWrapper layoutExpr e1 - docSeq - [ docLit $ Text.pack "[" - , appSep $ docForceSingleline e1Doc - , docLit $ Text.pack "..]" - ] - FromThen e1 e2 -> do - e1Doc <- docSharedWrapper layoutExpr e1 - e2Doc <- docSharedWrapper layoutExpr e2 - docSeq - [ docLit $ Text.pack "[" - , docForceSingleline e1Doc - , docCommaSep - , appSep $ docForceSingleline e2Doc - , docLit $ Text.pack "..]" - ] - FromTo e1 eN -> do - e1Doc <- docSharedWrapper layoutExpr e1 - eNDoc <- docSharedWrapper layoutExpr eN - docSeq - [ docLit $ Text.pack "[" - , appSep $ docForceSingleline e1Doc - , appSep $ docLit $ Text.pack ".." - , docForceSingleline eNDoc - , docLit $ Text.pack "]" - ] - FromThenTo e1 e2 eN -> do - e1Doc <- docSharedWrapper layoutExpr e1 - e2Doc <- docSharedWrapper layoutExpr e2 - eNDoc <- docSharedWrapper layoutExpr eN - docSeq - [ docLit $ Text.pack "[" - , docForceSingleline e1Doc - , docCommaSep - , appSep $ docForceSingleline e2Doc - , appSep $ docLit $ Text.pack ".." - , docForceSingleline eNDoc - , docLit $ Text.pack "]" - ] - ArithSeq{} -> - briDocByExactInlineOnly "ArithSeq" lexpr - PArrSeq{} -> do - -- TODO - briDocByExactInlineOnly "PArrSeq{}" lexpr - HsSCC{} -> do - -- TODO - briDocByExactInlineOnly "HsSCC{}" lexpr - HsCoreAnn{} -> do - -- TODO - briDocByExactInlineOnly "HsCoreAnn{}" lexpr - HsBracket{} -> do - -- TODO - briDocByExactInlineOnly "HsBracket{}" lexpr - HsRnBracketOut{} -> do - -- TODO - briDocByExactInlineOnly "HsRnBracketOut{}" lexpr - HsTcBracketOut{} -> do - -- TODO - briDocByExactInlineOnly "HsTcBracketOut{}" lexpr - HsSpliceE{} -> do - -- TODO - briDocByExactInlineOnly "HsSpliceE{}" lexpr - HsProc{} -> do - -- TODO - briDocByExactInlineOnly "HsProc{}" lexpr - HsStatic{} -> do - -- TODO - briDocByExactInlineOnly "HsStatic{}" lexpr - HsArrApp{} -> do - -- TODO - briDocByExactInlineOnly "HsArrApp{}" lexpr - HsArrForm{} -> do - -- TODO - briDocByExactInlineOnly "HsArrForm{}" lexpr - HsTick{} -> do - -- TODO - briDocByExactInlineOnly "HsTick{}" lexpr - HsBinTick{} -> do - -- TODO - briDocByExactInlineOnly "HsBinTick{}" lexpr - HsTickPragma{} -> do - -- TODO - briDocByExactInlineOnly "HsTickPragma{}" lexpr - EWildPat{} -> do - docLit $ Text.pack "_" - EAsPat asName asExpr -> do - docSeq - [ docLit $ (lrdrNameToText asName) <> Text.pack "@" - , layoutExpr asExpr - ] - EViewPat{} -> do - -- TODO - briDocByExactInlineOnly "EViewPat{}" lexpr - ELazyPat{} -> do - -- TODO - briDocByExactInlineOnly "ELazyPat{}" lexpr - HsWrap{} -> do - -- TODO - briDocByExactInlineOnly "HsWrap{}" lexpr + expDoc <- docSharedWrapper layoutExpr exp1 + typDoc <- docSharedWrapper layoutType typ1 + docSeq + [ appSep expDoc + , appSep $ docLit $ Text.pack "::" + , typDoc + ] + ExprWithTySigOut{} -> do + -- TODO + briDocByExactInlineOnly "ExprWithTySigOut{}" lexpr + ArithSeq _ Nothing info -> + case info of + From e1 -> do + e1Doc <- docSharedWrapper layoutExpr e1 + docSeq + [ docLit $ Text.pack "[" + , appSep $ docForceSingleline e1Doc + , docLit $ Text.pack "..]" + ] + FromThen e1 e2 -> do + e1Doc <- docSharedWrapper layoutExpr e1 + e2Doc <- docSharedWrapper layoutExpr e2 + docSeq + [ docLit $ Text.pack "[" + , docForceSingleline e1Doc + , appSep $ docLit $ Text.pack "," + , appSep $ docForceSingleline e2Doc + , docLit $ Text.pack "..]" + ] + FromTo e1 eN -> do + e1Doc <- docSharedWrapper layoutExpr e1 + eNDoc <- docSharedWrapper layoutExpr eN + docSeq + [ docLit $ Text.pack "[" + , appSep $ docForceSingleline e1Doc + , appSep $ docLit $ Text.pack ".." + , docForceSingleline eNDoc + , docLit $ Text.pack "]" + ] + FromThenTo e1 e2 eN -> do + e1Doc <- docSharedWrapper layoutExpr e1 + e2Doc <- docSharedWrapper layoutExpr e2 + eNDoc <- docSharedWrapper layoutExpr eN + docSeq + [ docLit $ Text.pack "[" + , docForceSingleline e1Doc + , appSep $ docLit $ Text.pack "," + , appSep $ docForceSingleline e2Doc + , appSep $ docLit $ Text.pack ".." + , docForceSingleline eNDoc + , docLit $ Text.pack "]" + ] + ArithSeq{} -> + briDocByExactInlineOnly "ArithSeq" lexpr + PArrSeq{} -> do + -- TODO + briDocByExactInlineOnly "PArrSeq{}" lexpr + HsSCC{} -> do + -- TODO + briDocByExactInlineOnly "HsSCC{}" lexpr + HsCoreAnn{} -> do + -- TODO + briDocByExactInlineOnly "HsCoreAnn{}" lexpr + HsBracket{} -> do + -- TODO + briDocByExactInlineOnly "HsBracket{}" lexpr + HsRnBracketOut{} -> do + -- TODO + briDocByExactInlineOnly "HsRnBracketOut{}" lexpr + HsTcBracketOut{} -> do + -- TODO + briDocByExactInlineOnly "HsTcBracketOut{}" lexpr + HsSpliceE{} -> do + -- TODO + briDocByExactInlineOnly "HsSpliceE{}" lexpr + HsProc{} -> do + -- TODO + briDocByExactInlineOnly "HsProc{}" lexpr + HsStatic{} -> do + -- TODO + briDocByExactInlineOnly "HsStatic{}" lexpr + HsArrApp{} -> do + -- TODO + briDocByExactInlineOnly "HsArrApp{}" lexpr + HsArrForm{} -> do + -- TODO + briDocByExactInlineOnly "HsArrForm{}" lexpr + HsTick{} -> do + -- TODO + briDocByExactInlineOnly "HsTick{}" lexpr + HsBinTick{} -> do + -- TODO + briDocByExactInlineOnly "HsBinTick{}" lexpr + HsTickPragma{} -> do + -- TODO + briDocByExactInlineOnly "HsTickPragma{}" lexpr + EWildPat{} -> do + docLit $ Text.pack "_" + EAsPat asName asExpr -> do + docSeq + [ docLit $ (lrdrNameToText asName) <> Text.pack "@" + , layoutExpr asExpr + ] + EViewPat{} -> do + -- TODO + briDocByExactInlineOnly "EViewPat{}" lexpr + ELazyPat{} -> do + -- TODO + briDocByExactInlineOnly "ELazyPat{}" lexpr + HsWrap{} -> do + -- TODO + briDocByExactInlineOnly "HsWrap{}" lexpr #if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ - HsConLikeOut{} -> do - -- TODO - briDocByExactInlineOnly "HsWrap{}" lexpr - ExplicitSum{} -> do - -- TODO - briDocByExactInlineOnly "ExplicitSum{}" lexpr + HsConLikeOut{} -> do + -- TODO + briDocByExactInlineOnly "HsWrap{}" lexpr + ExplicitSum{} -> do + -- TODO + briDocByExactInlineOnly "ExplicitSum{}" lexpr #endif diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs index a8d95aa..b8814cd 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs @@ -11,6 +11,7 @@ where import Language.Haskell.Brittany.Internal.Types import Language.Haskell.Brittany.Internal.LayouterBasics +import Language.Haskell.Brittany.Internal.Config.Types import RdrName ( RdrName(..) ) import GHC ( runGhc, GenLocated(L), moduleNameString ) @@ -26,57 +27,91 @@ import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Expr layoutStmt :: ToBriDoc' (StmtLR RdrName RdrName (LHsExpr RdrName)) -layoutStmt lstmt@(L _ stmt) = docWrapNode lstmt $ case stmt of - LastStmt body False _ -> do - layoutExpr body - BindStmt lPat expr _ _ _ -> do - patDoc <- fmap return $ colsWrapPat =<< layoutPat lPat - expDoc <- docSharedWrapper layoutExpr expr - docAlt - [ docCols - ColBindStmt - [ appSep patDoc - , docSeq [appSep $ docLit $ Text.pack "<-", docForceParSpacing expDoc] +layoutStmt lstmt@(L _ stmt) = do + indentPolicy <- mAsk <&> _conf_layout .> _lconfig_indentPolicy .> confUnpack + docWrapNode lstmt $ case stmt of + LastStmt body False _ -> do + layoutExpr body + BindStmt lPat expr _ _ _ -> do + patDoc <- fmap return $ colsWrapPat =<< layoutPat lPat + expDoc <- docSharedWrapper layoutExpr expr + docAlt + [ docCols + ColBindStmt + [ appSep patDoc + , docSeq [appSep $ docLit $ Text.pack "<-", docForceParSpacing expDoc] + ] + , docCols + ColBindStmt + [ appSep patDoc + , docAddBaseY BrIndentRegular + $ docPar (docLit $ Text.pack "<-") (expDoc) + ] ] - , docCols - ColBindStmt - [ appSep patDoc + LetStmt binds -> layoutLocalBinds binds >>= \case + Nothing -> docLit $ Text.pack "let" -- i just tested + -- it, and it is + -- indeed allowed. + -- heh. + Just [] -> docLit $ Text.pack "let" -- this probably never happens + Just [bindDoc] -> docAlt + [ -- let bind = expr + docCols + ColDoLet + [ appSep $ docLit $ Text.pack "let" + , ( if indentPolicy == IndentPolicyLeft + then docForceSingleline + else docSetBaseAndIndent + ) + $ return bindDoc + ] + , -- let + -- bind = expr + docAddBaseY BrIndentRegular $ docPar + (docLit $ Text.pack "let") + (docSetBaseAndIndent $ return bindDoc) + ] + Just bindDocs -> docAltFilter + [ -- let aaa = expra + -- bbb = exprb + -- ccc = exprc + ( indentPolicy /= IndentPolicyLeft + , docSeq + [ appSep $ docLit $ Text.pack "let" + , docSetBaseAndIndent $ docLines $ return <$> bindDocs + ] + ) + , -- let + -- aaa = expra + -- bbb = exprb + -- ccc = exprc + ( True + , docAddBaseY BrIndentRegular $ docPar + (docLit $ Text.pack "let") + (docSetBaseAndIndent $ docLines $ return <$> bindDocs) + ) + ] + RecStmt stmts _ _ _ _ _ _ _ _ _ -> docAltFilter + [ -- rec stmt1 + -- stmt2 + -- stmt3 + ( indentPolicy /= IndentPolicyLeft + , docSeq + [ docLit (Text.pack "rec") + , docSeparator + , docSetBaseAndIndent $ docLines $ layoutStmt <$> stmts + ] + ) + , -- rec + -- stmt1 + -- stmt2 + -- stmt3 + ( True , docAddBaseY BrIndentRegular - $ docPar (docLit $ Text.pack "<-") (expDoc) - ] + $ docPar (docLit (Text.pack "rec")) (docLines $ layoutStmt <$> stmts) + ) ] - LetStmt binds -> layoutLocalBinds binds >>= \case - Nothing -> docLit $ Text.pack "let" -- i just tested - -- it, and it is - -- indeed allowed. - -- heh. - Just [] -> docLit $ Text.pack "let" -- this probably never happens - Just [bindDoc] -> docAlt - [ docCols - ColDoLet - [ appSep $ docLit $ Text.pack "let" - , docSetBaseAndIndent $ return bindDoc - ] - , docAddBaseY BrIndentRegular - $ docPar (docLit $ Text.pack "let") - (docSetBaseAndIndent $ return bindDoc) - ] - Just bindDocs -> docAlt - [ docSeq - [ appSep $ docLit $ Text.pack "let" - , docSetBaseAndIndent $ docLines $ return <$> bindDocs - ] - , docAddBaseY BrIndentRegular $ docPar - (docLit $ Text.pack "let") - (docSetBaseAndIndent $ docLines $ return <$> bindDocs) - ] - RecStmt stmts _ _ _ _ _ _ _ _ _ -> do - docSeq - [ docLit (Text.pack "rec") - , docSeparator - , docSetBaseAndIndent $ docLines $ layoutStmt <$> stmts - ] - BodyStmt expr _ _ _ -> do - expDoc <- docSharedWrapper layoutExpr expr - docAddBaseY BrIndentRegular $ expDoc - _ -> briDocByExactInlineOnly "some unknown statement" lstmt + BodyStmt expr _ _ _ -> do + expDoc <- docSharedWrapper layoutExpr expr + docAddBaseY BrIndentRegular $ expDoc + _ -> briDocByExactInlineOnly "some unknown statement" lstmt diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs index a5148f5..bd4d728 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs @@ -174,17 +174,17 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of , docForceSingleline $ return $ typeDoc ] -- :: forall x - -- . x + -- . x , docPar (docSeq $ docLit (Text.pack "forall") : tyVarDocLineList) ( docCols ColTyOpPrefix - [ docWrapNodeRest ltype $ docLit $ Text.pack ". " + [ docWrapNodeRest ltype $ docLit $ Text.pack " . " , maybeForceML $ return typeDoc ] ) -- :: forall -- (x :: *) - -- . x + -- . x , docPar (docLit (Text.pack "forall")) (docLines @@ -204,7 +204,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of ] ) ++[ docCols ColTyOpPrefix - [ docWrapNodeRest ltype $ docLit $ Text.pack ". " + [ docWrapNodeRest ltype $ docLit $ Text.pack " . " , maybeForceML $ return typeDoc ] ] @@ -499,7 +499,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of ) (docCols ColTyOpPrefix [ docWrapNodeRest ltype - $ docLit $ Text.pack "::" + $ docLit $ Text.pack ":: " , docAddBaseY (BrIndentSpecial 2) typeDoc1 ]) ]