diff --git a/.gitignore b/.gitignore index 4393459..4cdb828 100644 --- a/.gitignore +++ b/.gitignore @@ -12,4 +12,5 @@ local/ cabal.sandbox.config cabal.project.local .ghc.environment.* -result \ No newline at end of file +result +.stack-work* diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..e0213ab --- /dev/null +++ b/Makefile @@ -0,0 +1,28 @@ +.PHONY: test +test: + echo "test" + stack test + +.PHONY: test-all +test-all: + $(MAKE) test test-8.6.5 test-8.4.3 test-8.2.2 test-8.0.2 + +.PHONY: test-8.6.5 +test-8.6.5: + echo "test 8.6.5" + stack test --stack-yaml stack-8.6.5.yaml --work-dir .stack-work-8.6.5 + +.PHONY: test-8.4.3 +test-8.4.3: + echo "test 8.4.3" + stack test --stack-yaml stack-8.4.3.yaml --work-dir .stack-work-8.4.3 + +.PHONY: test-8.2.2 +test-8.2.2: + echo "test 8.2.2" + stack test --stack-yaml stack-8.2.2.yaml --work-dir .stack-work-8.2.2 + +.PHONY: test-8.0.2 +test-8.0.2: + echo "test 8.0.2" + stack test --stack-yaml stack-8.0.2.yaml --work-dir .stack-work-8.0.2 diff --git a/brittany.cabal b/brittany.cabal index 3374405..9274ad7 100644 --- a/brittany.cabal +++ b/brittany.cabal @@ -77,6 +77,7 @@ library { Language.Haskell.Brittany.Internal.Layouters.IE Language.Haskell.Brittany.Internal.Layouters.Import Language.Haskell.Brittany.Internal.Layouters.Module + Language.Haskell.Brittany.Internal.Layouters.DataDecl Language.Haskell.Brittany.Internal.Transformations.Alt Language.Haskell.Brittany.Internal.Transformations.Floating Language.Haskell.Brittany.Internal.Transformations.Par diff --git a/src-literatetests/10-tests.blt b/src-literatetests/10-tests.blt index 1b152f5..a3d1138 100644 --- a/src-literatetests/10-tests.blt +++ b/src-literatetests/10-tests.blt @@ -310,6 +310,303 @@ func = f f = id +############################################################################### +############################################################################### +############################################################################### +#group data type declarations +############################################################################### +############################################################################### +############################################################################### + +#test nullary data type +data Foo = Bar {} + +data Biz = Baz + +#test single record +data Foo = Bar + { foo :: Baz + } + +#test record multiple names +data Foo = Bar + { foo, bar :: Baz + } + +#test record multiple types +data Foo = Bar + { foo :: Baz + , bars :: Bizzz + } + +#test record multiple types and names +data Foo = Bar + { foo, biz :: Baz + , bar :: Bizzz + } + +#test record multiple types deriving +data Foo = Bar + { fooz :: Baz + , bar :: Bizzz + } + deriving Show + +#test record long field names +data MyRecord = MyConstructor + { bar1, bar2 + :: Loooooooooooooooooooooooooooooooong + -> Loooooooooooooooooooooooooooooooong + , foo1, foo2 + :: Loooooooooooooooooooooooooooooooonger + -> Loooooooooooooooooooooooooooooooonger + } + +#test record with DataTypeContexts +{-# LANGUAGE DatatypeContexts #-} +data + ( LooooooooooooooooooooongConstraint a + , LooooooooooooooooooooongConstraint b + ) => + MyRecord a b + = MyConstructor + { foo1, foo2 + :: loooooooooooooooooooooooooooooooong + -> loooooooooooooooooooooooooooooooong + , bar :: a + , bazz :: b + } + +#test record single line layout +#pending config flag is disabled for now +{-# LANGUAGE ScopedTypeVariables #-} +-- brittany { lconfig_allowSinglelineRecord: true } +data MyRecord = forall a . Show a => MyCons { foo :: a -> a, i :: Int } + +#test record no matching single line layout +{-# LANGUAGE ScopedTypeVariables #-} +-- brittany { lconfig_allowSinglelineRecord: true } +data MyRecord = forall a . Show a => Bar + { foo :: abittoolongbutnotvery -> abittoolongbutnotvery + } + +#test record forall constraint multiline +{-# LANGUAGE ScopedTypeVariables #-} +data MyRecord + = forall a + . LooooooooooooooooooooongConstraint a => + LoooooooooooongConstructor + { foo :: abittoolongbutnotvery -> abittoolongbutnotvery + } + +#test record forall constraint multiline more +{-# LANGUAGE ScopedTypeVariables #-} +data MyRecord + = forall a b + . ( Loooooooooooooooooooooooooooooooong a + , Loooooooooooooooooooooooooooooooong b + ) => + MyConstructor + { a :: a + , b :: b + } + +#test plain with forall and constraint +{-# LANGUAGE ScopedTypeVariables #-} +data MyStruct + = forall a b + . ( Loooooooooooooooooooooooooooooooong a + , Loooooooooooooooooooooooooooooooong b + ) => + MyConstructor (ToBriDocM BriDocNumbered) + (ToBriDocM BriDocNumbered) + (ToBriDocM BriDocNumbered) + +#test record with many features +{-# LANGUAGE ScopedTypeVariables #-} +data MyRecord + = forall a b + . ( Loooooooooooooooooooooooooooooooong a + , Loooooooooooooooooooooooooooooooong b + ) => + MyConstructor + { foo, foo2 + :: loooooooooooooooooooooooooooooooong + -> loooooooooooooooooooooooooooooooong + , bar :: a + , bazz :: b + } + deriving Show + +#test record multiple types deriving +data Foo = Bar + { foo :: Baz + , bars :: Bizzz + } + deriving (Show, Eq, Monad, Functor, Traversable, Foldable) + +#test record multiple deriving strategies +#min-ghc 8.2 +data Foo = Bar + { foo :: Baz + , bars :: Bizzz + } + deriving Show + deriving (Eq, Ord) + deriving stock Show + deriving stock (Eq, Ord) + deriving anyclass Show + deriving anyclass (Show, Eq, Monad, Functor) + deriving newtype Show + deriving newtype (Traversable, Foldable) + +#test record deriving via +#min-ghc 8.6 +data Foo = Bar + { foo :: Baz + , bars :: Bizzz + } + deriving ToJSON via (SomeType) + deriving (ToJSON, FromJSON) via (SomeType) + +#test single record existential +{-# LANGUAGE ExistentialQuantification #-} + +data Foo = forall a . Show a => Bar + { foo :: a + } + +#test record multiple types existential +{-# LANGUAGE ExistentialQuantification #-} + +data Foo = forall a b . (Show a, Eq b) => Bar + { foo :: a + , bars :: b + } + +#test plain comment simple +-- before +data MyData = MyData Int +-- after + +#test record newline comment +data MyRecord = MyRecord + { a :: Int + -- comment + , b :: Int + } + +#test record comments simple +data Foo = Bar -- a + { foo :: Baz -- b + , bars :: Bizzz -- c + } -- d + deriving (Show, Eq, Monad, Functor, Traversable, Foldable) -- e + +#test record comments strange inline +data Foo = Bar + { -- a + foo -- b + :: -- c + Baz -- d + , -- e + bars :: Bizzz + } + deriving (Show, Eq, Monad, Functor, Traversable, Foldable) + +#test record comments in deriving +## maybe we want to switch to a differnt layout when there are such comments. +## Don't hesitate to modify this testcase, it clearly is not the ideal layout +## for this. + +data Foo = Bar + { foo :: Baz + , bars :: Bizzz + } + -- a + deriving --b + ( -- c + ToJSON -- d + , -- e + FromJSON --f + ) -- g + +#test record comments in deriving via +## maybe we want to switch to a differnt layout when there are such comments. +## Don't hesitate to modify this testcase, it clearly is not the ideal layout +## for this. +#min-ghc 8.6 + +data Foo = Bar + { foo :: Baz + , bars :: Bizzz + } + -- a + deriving --a + ToJSON --b + via -- c + ( -- d + SomeType --e + , -- f + ABC --g + ) + +#test comment before equal sign +{-# LANGUAGE ExistentialQuantification #-} +data MyRecord + -- test comment + = forall a b + . ( Loooooooooooooooooooooooooooooooong a + , Loooooooooooooooooooooooooooooooong b + ) => + MyConstructor a b + +#test normal records on multi line indent policy left +-- brittany {lconfig_indentPolicy: IndentPolicyLeft } +data EnterpriseGrantsForCompanyResponse = EnterpriseGrantsForCompanyResponse + Types.Company + [EnterpriseGrantResponse] + +#test normal records on multi line indent policy free +-- brittany {lconfig_indentPolicy: IndentPolicyFree } +data GrantsForCompanyResp = GrantsForCompanyResp Types.Company + [EnterpriseGrantResponse] + +#test normal records on multi line indent policy free 2 +-- brittany {lconfig_indentPolicy: IndentPolicyFree } +data EnterpriseGrantsForCompanyResponse = EnterpriseGrantsForCompanyResponse + Types.Company + [EnterpriseGrantResponse] + +#test normal records on multi line indent policy multiple +-- brittany {lconfig_indentPolicy: IndentPolicyMultiple } +data GrantsForCompanyResp = GrantsForCompanyResp Types.Company + [EnterpriseGrantResponse] + +#test large record with a comment +data XIILqcacwiuNiu = XIILqcacwiuNiu + { oyyFtvbepgbOge_pebzVmuftEijwuj :: Jgtoyuh HessJvNlo + , wloQsiskdoxJop_xatiKrwedOxtu :: Jgtoyuh [Inotg] + , mmmJjcqtemyIyo_ovosDoreKeeoyamvove :: Jgtoyuh Eujo + , mbiIatelofxOzr_uluxNngiiMjah :: Jgtoyuh HessJvNlo + , obxIskfcxpkIkb_uuviTuevcSkrgo :: Jgtoyuh Int + , wqrAtuvuecoHwr_ilotNxbuPleo :: Jgtoyuh Ufaxdeq + , lofAfuebdhpLuv_cnekPoyFxmg :: Jgtoyuh Ufaxdeq + , ouoFugtawzvUpk_oupiLzptugy :: Jgtoyuh Eujo + , iqiXjtziwogNsa_uiyvSunaTtgUsf3 :: Jgtoyuh Oaivn + , odbIriaqnojUlz_onotoWuunehIpuy :: Jgtoyuh Eujo + , opjUxtkxzkiKse_luqjuZazt + :: Jgtoyuh [(Eujo, Int, Int, Int, Int, Int, NELUxro)] + -- , jcqRaqznxfhIpa_ywevMezmoYkutuwa :: Jgtoyuh () + , vayOmuasyphOfd_bcsVljmvt :: Jgtoyuh Eujo + , rifArahilooRax_ufikecqdImsv :: Jgtoyuh Oaivn + , raqKtopcpszDwb_oqocubasZuqjcryoDojGkw :: Jgtoyuh Oaivn + , mluJiilpcijUtt_gaisklifVekfeyagRmfbyzz :: Jgtoyuh Oaivn + , oqhPaahjupaSmi_gamwwoovKyxznecvEayluc :: Jgtoyuh Oaivn + , mazFubimwebZpa_itidehDodiDlboz :: Jgtoyuh Vrep + , jeyOcuesexaYoy_vpqn :: Jgtoyuh () + } + ############################################################################### ############################################################################### ############################################################################### @@ -1093,6 +1390,14 @@ type (a :+: b) = (a, b) type ((a :+: b) c) = (a, c) +#test synonym-tuple-type-many-comments + +type Foo + = ( -- t1 + A -- t2 + , -- t3 + B -- t4 + ) -- t5 ############################################################################### ############################################################################### diff --git a/src-literatetests/30-tests-context-free.blt b/src-literatetests/30-tests-context-free.blt index d5c4507..ba84a7c 100644 --- a/src-literatetests/30-tests-context-free.blt +++ b/src-literatetests/30-tests-context-free.blt @@ -312,6 +312,51 @@ func = f f = id +############################################################################### +############################################################################### +############################################################################### +#group data type declarations +############################################################################### +############################################################################### +############################################################################### + +#test single record +data Foo = Bar + { foo :: Baz + } + +#test record multiple names +data Foo = Bar + { foo, bar :: Baz + } + +#test record multiple types +data Foo = Bar + { foo :: Baz + , bar :: Bizzz + } + +#test record multiple types and names +data Foo = Bar + { foo, biz :: Baz + , bar :: Bizzz + } + +#test record multiple types deriving +data Foo = Bar + { foo :: Baz + , bar :: Bizzz + } + deriving Show + +#test record multiple types deriving +data Foo = Bar + { foo :: Baz + , bar :: Bizzz + } + deriving (Show, Eq, Monad, Functor, Traversable, Foldable) + + ############################################################################### ############################################################################### ############################################################################### @@ -1163,6 +1208,12 @@ foo = Reflex.runSpiderHost $ ReflexHost.hostApp $ do liftIO . forkIO . forever $ getLine >>= inputFire ReflexHost.performEvent_ $ fmap (liftIO . putStrLn) inputEvent +#test issue 15 +-- Test.hs +module Test where + +data X = X + #test issue 16 foldrDesc f z = unSwitchQueue $ \q -> switch (Min.foldrDesc (f unTaggedF) z q) (Min.foldrAsc (f unTaggedF) z q) diff --git a/src-literatetests/Main.hs b/src-literatetests/Main.hs index 435e328..3595b1f 100644 --- a/src-literatetests/Main.hs +++ b/src-literatetests/Main.hs @@ -1,42 +1,56 @@ {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE CPP #-} -module Main (main) where +module Main + ( main + ) +where #include "prelude.inc" -import Test.Hspec -import Test.Hspec.Runner ( hspecWith, defaultConfig, configConcurrentJobs ) +import Test.Hspec +import Test.Hspec.Runner ( hspecWith + , defaultConfig + , configConcurrentJobs + ) -import NeatInterpolation +import NeatInterpolation -import qualified Text.Parsec as Parsec -import Text.Parsec.Text ( Parser ) +import qualified Text.Parsec as Parsec +import Text.Parsec.Text ( Parser ) -import Data.Char ( isSpace ) -import Data.List ( groupBy ) +import Data.Char ( isSpace ) +import Data.List ( groupBy ) -import Language.Haskell.Brittany.Internal +import Language.Haskell.Brittany.Internal -import Language.Haskell.Brittany.Internal.Config.Types -import Language.Haskell.Brittany.Internal.Config +import Language.Haskell.Brittany.Internal.Config.Types +import Language.Haskell.Brittany.Internal.Config -import Data.Coerce ( coerce ) +import Data.Coerce ( coerce ) -import qualified Data.Text.IO as Text.IO -import System.FilePath ( () ) +import qualified Data.Text.IO as Text.IO +import System.FilePath ( () ) data InputLine = GroupLine Text | HeaderLine Text + | GhcVersionGuardLine Text | PendingLine | NormalLine Text | CommentLine deriving Show +data TestCase = TestCase + { testName :: Text + , isPending :: Bool + , minGHCVersion :: Maybe Text + , content :: Text + } main :: IO () main = do @@ -44,28 +58,39 @@ main = do let blts = List.sort $ filter (\x -> not ("tests-context-free.blt" `isSuffixOf` x)) - $ filter (".blt"`isSuffixOf`) files + $ filter (".blt" `isSuffixOf`) files inputs <- blts `forM` \blt -> Text.IO.readFile ("src-literatetests" blt) let groups = createChunks =<< inputs inputCtxFree <- Text.IO.readFile "src-literatetests/30-tests-context-free.blt" let groupsCtxFree = createChunks inputCtxFree + let parseVersion :: Text -> Maybe [Int] + parseVersion = + mapM (readMaybe . Text.unpack) . Text.splitOn (Text.pack ".") + let ghcVersion = Data.Maybe.fromJust $ parseVersion $ Text.pack VERSION_ghc + let checkVersion = \case + Nothing -> True -- no version constraint + Just s -> case parseVersion s of + Nothing -> error $ "could not parse version " ++ Text.unpack s + Just v -> v <= ghcVersion 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 + describe (Text.unpack groupname) $ do + tests `forM_` \test -> when (checkVersion $ minGHCVersion test) $ do + (if isPending test then before_ pending else id) + $ it (Text.unpack $ testName test) + $ roundTripEqual defaultTestConfig + $ content test groupsCtxFree `forM_` \(groupname, tests) -> do - describe ("context free: " ++ Text.unpack groupname) - $ tests - `forM_` \(name, pend, inp) -> do - (if pend then before_ pending else id) - $ it (Text.unpack name) - $ roundTripEqual contextFreeTestConfig inp + describe ("context free: " ++ Text.unpack groupname) $ do + tests `forM_` \test -> when (checkVersion $ minGHCVersion test) $ do + (if isPending test then before_ pending else id) + $ it (Text.unpack $ testName test) + $ roundTripEqual contextFreeTestConfig + $ content test where -- this function might be implemented in a weirdly complex fashion; the -- reason being that it was copied from a somewhat more complex variant. - createChunks :: Text -> [(Text, [(Text, Bool, Text)])] + createChunks :: Text -> [(Text, [TestCase])] createChunks input = -- fmap (\case -- HeaderLine n:PendingLine:rest | Just rlines <- mapM extractNormal rest -> (n, True, Text.unlines rlines) @@ -73,35 +98,39 @@ main = do -- l -> error $ "first non-empty line must start with #test footest\n" ++ show l -- ) -- $ fmap (groupBy grouperT) - fmap - ( \case - GroupLine g:grouprest -> - (,) g - $ fmap - ( \case - HeaderLine n:PendingLine:rest | Just rlines <- mapM - extractNormal - rest -> - (n, True, Text.unlines rlines) - HeaderLine n:rest | Just rlines <- mapM extractNormal rest -> - (n, False, Text.unlines rlines) - l -> - error - $ "first non-empty line must start with #test footest\n" - ++ show l - ) - $ groupBy grouperT - $ filter (not . lineIsSpace) - $ grouprest - l -> error $ "first non-empty line must be a #group\n" ++ show l - ) - $ groupBy grouperG - $ filter (not . lineIsSpace) - $ lineMapper - <$> Text.lines input + fmap groupProcessor + $ groupBy grouperG + $ filter (not . lineIsSpace) + $ fmap lineMapper + $ Text.lines input where + groupProcessor :: [InputLine] -> (Text, [TestCase]) + groupProcessor = \case + GroupLine g : grouprest -> + (,) g + $ fmap testProcessor + $ groupBy grouperT + $ filter (not . lineIsSpace) + $ grouprest + l -> error $ "first non-empty line must be a #group\n" ++ show l + testProcessor :: [InputLine] -> TestCase + testProcessor = \case + HeaderLine n : rest -> + let normalLines = Data.Maybe.mapMaybe extractNormal rest + in TestCase + { testName = n + , isPending = any isPendingLine rest + , minGHCVersion = Data.List.Extra.firstJust extractMinGhc rest + , content = Text.unlines normalLines + } + l -> + error $ "first non-empty line must start with #test footest\n" ++ show l extractNormal (NormalLine l) = Just l extractNormal _ = Nothing + extractMinGhc (GhcVersionGuardLine v) = Just v + extractMinGhc _ = Nothing + isPendingLine PendingLine{} = True + isPendingLine _ = False specialLineParser :: Parser InputLine specialLineParser = Parsec.choice [ [ GroupLine $ Text.pack name @@ -116,6 +145,11 @@ main = do , name <- Parsec.many1 $ Parsec.noneOf "\r\n:" , _ <- Parsec.eof ] + , [ GhcVersionGuardLine $ Text.pack version + | _ <- Parsec.try $ Parsec.string "#min-ghc" + , _ <- Parsec.many1 $ Parsec.oneOf " \t" + , version <- Parsec.many1 $ Parsec.noneOf "\r\n:" + ] , [ PendingLine | _ <- Parsec.try $ Parsec.string "#pending" , _ <- Parsec.optional $ many (Parsec.noneOf "\r\n") @@ -123,8 +157,8 @@ main = do ] , [ CommentLine | _ <- Parsec.many $ Parsec.oneOf " \t" - , _ <- - Parsec.optional $ Parsec.string "##" <* many (Parsec.noneOf "\r\n") + , _ <- Parsec.optional $ Parsec.string "##" <* many + (Parsec.noneOf "\r\n") , _ <- Parsec.eof ] ] @@ -148,8 +182,7 @@ main = do -------------------- roundTripEqual :: Config -> Text -> Expectation roundTripEqual c t = - fmap (fmap PPTextWrapper) - (parsePrintModuleTests c "TestFakeFileName.hs" t) + fmap (fmap PPTextWrapper) (parsePrintModuleTests c "TestFakeFileName.hs" t) `shouldReturn` Right (PPTextWrapper t) newtype PPTextWrapper = PPTextWrapper Text @@ -158,7 +191,8 @@ newtype PPTextWrapper = PPTextWrapper Text instance Show PPTextWrapper where show (PPTextWrapper t) = "\n" ++ Text.unpack t - +-- brittany-next-binding --columns 160 +-- brittany-next-binding { lconfig_indentPolicy: IndentPolicyLeft } defaultTestConfig :: Config defaultTestConfig = Config { _conf_version = _conf_version staticDefaultConfig @@ -180,22 +214,20 @@ defaultTestConfig = Config , _lconfig_allowSingleLineExportList = coerce True , _lconfig_allowHangingQuasiQuotes = coerce True , _lconfig_experimentalSemicolonNewlines = coerce False + -- , _lconfig_allowSinglelineRecord = coerce False } - , _conf_errorHandling = (_conf_errorHandling staticDefaultConfig) - { _econf_omit_output_valid_check = coerce True - } + , _conf_errorHandling = (_conf_errorHandling staticDefaultConfig) { _econf_omit_output_valid_check = coerce True } , _conf_preprocessor = _conf_preprocessor staticDefaultConfig - , _conf_forward = ForwardOptions {_options_ghc = Identity []} + , _conf_forward = ForwardOptions { _options_ghc = Identity [] } , _conf_roundtrip_exactprint_only = coerce False - , _conf_obfuscate = coerce False + , _conf_obfuscate = coerce False } contextFreeTestConfig :: Config -contextFreeTestConfig = - defaultTestConfig +contextFreeTestConfig = defaultTestConfig { _conf_layout = (_conf_layout defaultTestConfig) - {_lconfig_indentPolicy = coerce IndentPolicyLeft - ,_lconfig_alignmentLimit = coerce (1 :: Int) - ,_lconfig_columnAlignMode = coerce ColumnAlignModeDisabled - } + { _lconfig_indentPolicy = coerce IndentPolicyLeft + , _lconfig_alignmentLimit = coerce (1 :: Int) + , _lconfig_columnAlignMode = coerce ColumnAlignModeDisabled + } } diff --git a/src-unittests/TestUtils.hs b/src-unittests/TestUtils.hs index d9555cc..3f24266 100644 --- a/src-unittests/TestUtils.hs +++ b/src-unittests/TestUtils.hs @@ -61,6 +61,7 @@ defaultTestConfig = Config , _lconfig_allowSingleLineExportList = coerce True , _lconfig_allowHangingQuasiQuotes = coerce True , _lconfig_experimentalSemicolonNewlines = coerce False + -- , _lconfig_allowSinglelineRecord = coerce False } , _conf_errorHandling = (_conf_errorHandling staticDefaultConfig) { _econf_ExactPrintFallback = coerce ExactPrintFallbackModeNever diff --git a/src/Language/Haskell/Brittany/Internal.hs b/src/Language/Haskell/Brittany/Internal.hs index 9720106..b0680a7 100644 --- a/src/Language/Haskell/Brittany/Internal.hs +++ b/src/Language/Haskell/Brittany/Internal.hs @@ -51,13 +51,15 @@ import Language.Haskell.Brittany.Internal.Transformations.Par import Language.Haskell.Brittany.Internal.Transformations.Columns import Language.Haskell.Brittany.Internal.Transformations.Indent -import qualified GHC as GHC +import qualified GHC as GHC hiding ( parseModule ) import ApiAnnotation ( AnnKeywordId(..) ) -import GHC ( runGhc +import GHC ( Located + , runGhc , GenLocated(L) , moduleNameString ) +import RdrName ( RdrName(..) ) import SrcLoc ( SrcSpan ) import HsSyn import qualified DynFlags as GHC @@ -485,7 +487,6 @@ ppModule lmod@(L _loc _m@(HsModule _name _exports _ decls _ _)) = do in ppmMoveToExactLoc $ ExactPrint.DP (eofZ - cmY, eofX - cmX) _ -> return () - getDeclBindingNames :: LHsDecl GhcPs -> [String] #if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ getDeclBindingNames (L _ decl) = case decl of diff --git a/src/Language/Haskell/Brittany/Internal/Backend.hs b/src/Language/Haskell/Brittany/Internal/Backend.hs index 8fd7c5d..50522ed 100644 --- a/src/Language/Haskell/Brittany/Internal/Backend.hs +++ b/src/Language/Haskell/Brittany/Internal/Backend.hs @@ -287,7 +287,7 @@ layoutBriDocM = \case Just (ExactPrint.Types.DP (y, x)) -> layoutMoveToCommentPos y (if shouldRestoreIndent then x else 0) layoutBriDocM bd - BDNonBottomSpacing bd -> layoutBriDocM bd + BDNonBottomSpacing _ bd -> layoutBriDocM bd BDSetParSpacing bd -> layoutBriDocM bd BDForceParSpacing bd -> layoutBriDocM bd BDDebug s bd -> do @@ -321,15 +321,15 @@ briDocLineLength briDoc = flip StateS.evalState False $ rec briDoc BDAnnotationKW _ _ bd -> rec bd BDAnnotationRest _ bd -> rec bd BDMoveToKWDP _ _ _ bd -> rec bd - BDLines ls@(_:_) -> do + BDLines ls@(_ : _) -> do x <- StateS.get return $ maximum $ ls <&> \l -> StateS.evalState (rec l) x - BDLines [] -> error "briDocLineLength BDLines []" - BDEnsureIndent _ bd -> rec bd - BDSetParSpacing bd -> rec bd - BDForceParSpacing bd -> rec bd - BDNonBottomSpacing bd -> rec bd - BDDebug _ bd -> rec bd + BDLines [] -> error "briDocLineLength BDLines []" + BDEnsureIndent _ bd -> rec bd + BDSetParSpacing bd -> rec bd + BDForceParSpacing bd -> rec bd + BDNonBottomSpacing _ bd -> rec bd + BDDebug _ bd -> rec bd briDocIsMultiLine :: BriDoc -> Bool briDocIsMultiLine briDoc = rec briDoc @@ -363,9 +363,9 @@ briDocIsMultiLine briDoc = rec briDoc BDLines [_ ] -> False BDLines [] -> error "briDocIsMultiLine BDLines []" BDEnsureIndent _ bd -> rec bd - BDSetParSpacing bd -> rec bd - BDForceParSpacing bd -> rec bd - BDNonBottomSpacing bd -> rec bd + BDSetParSpacing bd -> rec bd + BDForceParSpacing bd -> rec bd + BDNonBottomSpacing _ bd -> rec bd BDDebug _ bd -> rec bd -- In theory @@ -551,6 +551,8 @@ alignColsLines bridocs = do -- colInfos `forM_` \colInfo -> do (BDCols ColBindStmt _) -> True (BDCols ColDoLet _) -> True (BDCols ColRec _) -> False + (BDCols ColRecUpdate _) -> False + (BDCols ColRecDecl _) -> False (BDCols ColListComp _) -> False (BDCols ColList _) -> False (BDCols ColApp{} _) -> True diff --git a/src/Language/Haskell/Brittany/Internal/BackendUtils.hs b/src/Language/Haskell/Brittany/Internal/BackendUtils.hs index 508a18c..bf30a4e 100644 --- a/src/Language/Haskell/Brittany/Internal/BackendUtils.hs +++ b/src/Language/Haskell/Brittany/Internal/BackendUtils.hs @@ -245,9 +245,10 @@ layoutWriteEnsureAbsoluteN -> m () layoutWriteEnsureAbsoluteN n = do state <- mGet - let diff = case _lstate_curYOrAddNewline state of - Left i -> n - i - Right{} -> n + let diff = case (_lstate_commentCol state, _lstate_curYOrAddNewline state) of + (Just c , _ ) -> n - c + (Nothing, Left i ) -> n - i + (Nothing, Right{}) -> n traceLocal ("layoutWriteEnsureAbsoluteN", n, diff) when (diff > 0) $ do mSet $ state { _lstate_addSepSpace = Just diff -- this always sets to @@ -557,6 +558,7 @@ layoutWritePostComments ast = do ) -> do replicateM_ x layoutWriteNewline layoutWriteAppend $ Text.pack $ replicate y ' ' + mModify $ \s -> s { _lstate_addSepSpace = Nothing } layoutWriteAppendMultiline $ Text.pack $ comment layoutIndentRestorePostComment diff --git a/src/Language/Haskell/Brittany/Internal/Config.hs b/src/Language/Haskell/Brittany/Internal/Config.hs index 5d220fd..a5bbdbd 100644 --- a/src/Language/Haskell/Brittany/Internal/Config.hs +++ b/src/Language/Haskell/Brittany/Internal/Config.hs @@ -77,6 +77,7 @@ staticDefaultConfig = Config , _lconfig_allowSingleLineExportList = coerce False , _lconfig_allowHangingQuasiQuotes = coerce True , _lconfig_experimentalSemicolonNewlines = coerce False + -- , _lconfig_allowSinglelineRecord = coerce False } , _conf_errorHandling = ErrorHandlingConfig { _econf_produceOutputOnErrors = coerce False @@ -181,6 +182,7 @@ cmdlineConfigParser = do , _lconfig_allowSingleLineExportList = mempty , _lconfig_allowHangingQuasiQuotes = mempty , _lconfig_experimentalSemicolonNewlines = mempty + -- , _lconfig_allowSinglelineRecord = mempty } , _conf_errorHandling = ErrorHandlingConfig { _econf_produceOutputOnErrors = wrapLast $ falseToNothing outputOnErrors diff --git a/src/Language/Haskell/Brittany/Internal/Config/Types.hs b/src/Language/Haskell/Brittany/Internal/Config/Types.hs index 29711c5..a244eae 100644 --- a/src/Language/Haskell/Brittany/Internal/Config/Types.hs +++ b/src/Language/Haskell/Brittany/Internal/Config/Types.hs @@ -142,6 +142,14 @@ data CLayoutConfig f = LayoutConfig -- The implementation for this is a bit hacky and not tested; it might -- break output syntax or not work properly for every kind of brace. So -- far I have considered `do` and `case-of`. + -- , _lconfig_allowSinglelineRecord :: f (Last Bool) + -- -- if true, layouts record data decls as a single line when possible, e.g. + -- -- > MyPoint { x :: Double, y :: Double } + -- -- if false, always use the multi-line layout + -- -- > MyPoint + -- -- > { x :: Double + -- -- > , y :: Double + -- -- > } } deriving (Generic) diff --git a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs index cd5764d..6263f50 100644 --- a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs +++ b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs @@ -13,6 +13,7 @@ module Language.Haskell.Brittany.Internal.LayouterBasics , filterAnns , docEmpty , docLit + , docLitS , docAlt , CollectAltM , addAlternativeCond @@ -39,6 +40,7 @@ module Language.Haskell.Brittany.Internal.LayouterBasics , docAnnotationRest , docMoveToKWDP , docNonBottomSpacing + , docNonBottomSpacingS , docSetParSpacing , docForceParSpacing , docDebug @@ -481,6 +483,9 @@ docEmpty = allocateNode BDFEmpty docLit :: Text -> ToBriDocM BriDocNumbered docLit t = allocateNode $ BDFLit t +docLitS :: String -> ToBriDocM BriDocNumbered +docLitS s = allocateNode $ BDFLit $ Text.pack s + docExt :: (ExactPrint.Annotate.Annotate ast) => Located ast @@ -572,7 +577,10 @@ docAnnotationRest docAnnotationRest annKey bdm = allocateNode . BDFAnnotationRest annKey =<< bdm docNonBottomSpacing :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered -docNonBottomSpacing bdm = allocateNode . BDFNonBottomSpacing =<< bdm +docNonBottomSpacing bdm = allocateNode . BDFNonBottomSpacing False =<< bdm + +docNonBottomSpacingS :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered +docNonBottomSpacingS bdm = allocateNode . BDFNonBottomSpacing True =<< bdm docSetParSpacing :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered docSetParSpacing bdm = allocateNode . BDFSetParSpacing =<< bdm @@ -642,18 +650,18 @@ docNodeMoveToKWDP ast kw shouldRestoreIndent bdm = class DocWrapable a where docWrapNode :: ( Data.Data.Data ast) => Located ast - -> ToBriDocM a - -> ToBriDocM a + -> a + -> a docWrapNodePrior :: ( Data.Data.Data ast) => Located ast - -> ToBriDocM a - -> ToBriDocM a + -> a + -> a docWrapNodeRest :: ( Data.Data.Data ast) => Located ast - -> ToBriDocM a - -> ToBriDocM a + -> a + -> a -instance DocWrapable BriDocNumbered where +instance DocWrapable (ToBriDocM BriDocNumbered) where docWrapNode ast bdm = do bd <- bdm i1 <- allocNodeIndex @@ -679,7 +687,22 @@ instance DocWrapable BriDocNumbered where $ BDFAnnotationRest (ExactPrint.Types.mkAnnKey ast) $ bd -instance DocWrapable a => DocWrapable [a] where +instance DocWrapable (ToBriDocM a) => DocWrapable [ToBriDocM a] where + docWrapNode ast bdms = case bdms of + [] -> [] + [bd] -> [docWrapNode ast bd] + (bd1:bdR) | (bdN:bdM) <- reverse bdR -> + [docWrapNodePrior ast bd1] ++ reverse bdM ++ [docWrapNodeRest ast bdN] + _ -> error "cannot happen (TM)" + docWrapNodePrior ast bdms = case bdms of + [] -> [] + [bd] -> [docWrapNodePrior ast bd] + (bd1:bdR) -> docWrapNodePrior ast bd1 : bdR + docWrapNodeRest ast bdms = case reverse bdms of + [] -> [] + (bdN:bdR) -> reverse $ docWrapNodeRest ast bdN : bdR + +instance DocWrapable (ToBriDocM a) => DocWrapable (ToBriDocM [a]) where docWrapNode ast bdsm = do bds <- bdsm case bds of @@ -707,7 +730,7 @@ instance DocWrapable a => DocWrapable [a] where bdN' <- docWrapNodeRest ast (return bdN) return $ reverse (bdN':bdR) -instance DocWrapable a => DocWrapable (Seq a) where +instance DocWrapable (ToBriDocM a) => DocWrapable (ToBriDocM (Seq a)) where docWrapNode ast bdsm = do bds <- bdsm case Seq.viewl bds of @@ -735,7 +758,7 @@ instance DocWrapable a => DocWrapable (Seq a) where bdN' <- docWrapNodeRest ast (return bdN) return $ bdR Seq.|> bdN' -instance DocWrapable ([BriDocNumbered], BriDocNumbered, a) where +instance DocWrapable (ToBriDocM ([BriDocNumbered], BriDocNumbered, a)) where docWrapNode ast stuffM = do (bds, bd, x) <- stuffM if null bds diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs b/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs new file mode 100644 index 0000000..00453b3 --- /dev/null +++ b/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs @@ -0,0 +1,527 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE KindSignatures #-} + +module Language.Haskell.Brittany.Internal.Layouters.DataDecl + ( layoutDataDecl + ) +where + + + +#include "prelude.inc" + +import Language.Haskell.Brittany.Internal.Types +import Language.Haskell.Brittany.Internal.LayouterBasics +import Language.Haskell.Brittany.Internal.Config.Types + +import RdrName ( RdrName(..) ) +import GHC ( Located, runGhc, GenLocated(L), moduleNameString ) +import qualified GHC +import HsSyn +import Name +import BasicTypes +import Language.Haskell.GHC.ExactPrint.Types ( mkAnnKey ) + +import Language.Haskell.Brittany.Internal.Layouters.Type +import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Expr +import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Stmt +import Language.Haskell.Brittany.Internal.Layouters.Pattern +import Language.Haskell.Brittany.Internal.Utils + +import Bag ( mapBagM ) + + + +layoutDataDecl + :: Located (TyClDecl GhcPs) + -> Located RdrName + -> LHsQTyVars GhcPs + -> HsDataDefn GhcPs + -> ToBriDocM BriDocNumbered +#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ +layoutDataDecl _ _ (XLHsQTyVars ext) _ = absurdExt ext +layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of +#else +layoutDataDecl ltycl name (HsQTvs _ bndrs _) defn = case defn of +#endif + -- newtype MyType a b = MyType .. +#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ + HsDataDefn _ext NewType (L _ []) _ctype Nothing [cons] mDerivs -> case cons of + (L _ (ConDeclH98 _ext consName (L _ False) _qvars (Just (L _ [])) details _conDoc)) -> +#else + HsDataDefn NewType (L _ []) _ctype Nothing [cons] mDerivs -> case cons of + (L _ (ConDeclH98 consName Nothing (Just (L _ [])) details _conDoc)) -> +#endif + docWrapNode ltycl $ do + nameStr <- lrdrNameToTextAnn name + consNameStr <- lrdrNameToTextAnn consName + tyVarLine <- fmap return $ createBndrDoc bndrs + -- headDoc <- fmap return $ docSeq + -- [ appSep $ docLitS "newtype") + -- , appSep $ docLit nameStr + -- , appSep tyVarLine + -- ] + rhsDoc <- fmap return $ createDetailsDoc consNameStr details + createDerivingPar mDerivs $ docSeq + [ appSep $ docLitS "newtype" + , appSep $ docLit nameStr + , appSep tyVarLine + , docSeparator + , docLitS "=" + , docSeparator + , rhsDoc + ] + _ -> briDocByExactNoComment ltycl + + + -- data MyData a b + -- (zero constructors) +#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ + HsDataDefn _ext DataType (L _ lhsContext) _ctype Nothing [] mDerivs -> +#else + HsDataDefn DataType (L _ lhsContext) _ctype Nothing [] mDerivs -> +#endif + docWrapNode ltycl $ do + lhsContextDoc <- docSharedWrapper createContextDoc lhsContext + nameStr <- lrdrNameToTextAnn name + tyVarLine <- fmap return $ createBndrDoc bndrs + createDerivingPar mDerivs $ docSeq + [ appSep $ docLitS "data" + , lhsContextDoc + , appSep $ docLit nameStr + , appSep tyVarLine + ] + + -- data MyData = MyData .. + -- data MyData = MyData { .. } +#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ + HsDataDefn _ext DataType (L _ lhsContext) _ctype Nothing [cons] mDerivs -> +#else + HsDataDefn DataType (L _ lhsContext) _ctype Nothing [cons] mDerivs -> +#endif + case cons of +#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ + (L _ (ConDeclH98 _ext consName (L _ _hasExt) qvars mRhsContext details _conDoc)) -> +#else + (L _ (ConDeclH98 consName (Just (HsQTvs _ qvars _)) mRhsContext details _conDoc)) -> +#endif + docWrapNode ltycl $ do + lhsContextDoc <- docSharedWrapper createContextDoc lhsContext + nameStr <- lrdrNameToTextAnn name + consNameStr <- lrdrNameToTextAnn consName + tyVarLine <- fmap return $ createBndrDoc bndrs + forallDocMay <- case createForallDoc qvars of + Nothing -> pure Nothing + Just x -> Just . pure <$> x + rhsContextDocMay <- case mRhsContext of + Nothing -> pure Nothing + Just (L _ ctxt) -> Just . pure <$> createContextDoc ctxt + rhsDoc <- fmap return $ createDetailsDoc consNameStr details + consDoc <- fmap pure + $ docNonBottomSpacing + $ case (forallDocMay, rhsContextDocMay) of + (Just forallDoc, Just rhsContextDoc) -> docLines + [ docSeq [docLitS "=", docSeparator, docForceSingleline forallDoc] + , docSeq + [ docLitS "." + , docSeparator + , docSetBaseY $ docLines [rhsContextDoc, docSetBaseY rhsDoc] + ] + ] + (Just forallDoc, Nothing) -> docLines + [ docSeq [docLitS "=", docSeparator, docForceSingleline forallDoc] + , docSeq [docLitS ".", docSeparator, rhsDoc] + ] + (Nothing, Just rhsContextDoc) -> docSeq + [ docLitS "=" + , docSeparator + , docSetBaseY $ docLines [rhsContextDoc, docSetBaseY rhsDoc] + ] + (Nothing, Nothing) -> docSeq [docLitS "=", docSeparator, rhsDoc] + createDerivingPar mDerivs $ docAlt + [ -- data D = forall a . Show a => D a + docSeq + [ docNodeAnnKW ltycl (Just GHC.AnnData) + $ docSeq + [ appSep $ docLitS "data" + , docForceSingleline $ lhsContextDoc + , appSep $ docLit nameStr + , appSep tyVarLine + , docSeparator + ] + , docLitS "=" + , docSeparator + , docSetIndentLevel $ docSeq + [ case forallDocMay of + Nothing -> docEmpty + Just forallDoc -> docSeq + [ docForceSingleline forallDoc + , docSeparator + , docLitS "." + , docSeparator + ] + , maybe docEmpty docForceSingleline rhsContextDocMay + , rhsDoc + ] + ] + , -- data D + -- = forall a . Show a => D a + docAddBaseY BrIndentRegular $ docPar + ( docNodeAnnKW ltycl (Just GHC.AnnData) + $ docSeq + [ appSep $ docLitS "data" + , docForceSingleline lhsContextDoc + , appSep $ docLit nameStr + , tyVarLine + ] + ) + ( docSeq + [ docLitS "=" + , docSeparator + , docSetIndentLevel $ docSeq + [ case forallDocMay of + Nothing -> docEmpty + Just forallDoc -> docSeq + [ docForceSingleline forallDoc + , docSeparator + , docLitS "." + , docSeparator + ] + , maybe docEmpty docForceSingleline rhsContextDocMay + , rhsDoc + ] + ] + ) + , -- data D + -- = forall a + -- . Show a => + -- D a + docAddBaseY BrIndentRegular $ docPar + ( docNodeAnnKW ltycl (Just GHC.AnnData) + $ docSeq + [ appSep $ docLitS "data" + , docForceSingleline lhsContextDoc + , appSep $ docLit nameStr + , tyVarLine + ] + ) + consDoc + , -- data + -- Show a => + -- D + -- = forall a + -- . Show a => + -- D a + -- This alternative is only for -XDatatypeContexts. + -- But I think it is rather unlikely this will trigger without + -- -XDataTypeContexts, especially with the `docNonBottomSpacing` + -- above, so while not strictly necessary, this should not + -- hurt. + docAddBaseY BrIndentRegular $ docPar + (docLitS "data") + ( docLines + [ lhsContextDoc + , docNodeAnnKW ltycl (Just GHC.AnnData) + $ docSeq + [ appSep $ docLit nameStr + , tyVarLine + ] + , consDoc + ] + ) + ] + _ -> briDocByExactNoComment ltycl + + _ -> briDocByExactNoComment ltycl + +createContextDoc :: HsContext GhcPs -> ToBriDocM BriDocNumbered +createContextDoc [] = docEmpty +createContextDoc [t] = + docSeq [layoutType t, docSeparator, docLitS "=>", docSeparator] +createContextDoc (t1 : tR) = do + t1Doc <- docSharedWrapper layoutType t1 + tRDocs <- tR `forM` docSharedWrapper layoutType + docAlt + [ docSeq + [ docLitS "(" + , docForceSingleline $ docSeq $ List.intersperse docCommaSep + (t1Doc : tRDocs) + , docLitS ") =>" + , docSeparator + ] + , docLines $ join + [ [docSeq [docLitS "(", docSeparator, t1Doc]] + , tRDocs + <&> \tRDoc -> docSeq [docLitS ",", docSeparator, tRDoc] + , [docLitS ") =>", docSeparator] + ] + ] + +createBndrDoc :: [LHsTyVarBndr GhcPs] -> ToBriDocM BriDocNumbered +createBndrDoc bs = do + tyVarDocs <- bs `forM` \case +#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ + (L _ (UserTyVar _ext vname)) -> return $ (lrdrNameToText vname, Nothing) + (L _ (KindedTyVar _ext lrdrName kind)) -> do +#else + (L _ (UserTyVar vname)) -> return $ (lrdrNameToText vname, Nothing) + (L _ (KindedTyVar lrdrName kind)) -> do +#endif + d <- docSharedWrapper layoutType kind + return $ (lrdrNameToText lrdrName, Just $ d) +#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ + (L _ (XTyVarBndr ext)) -> absurdExt ext +#endif + docSeq + $ List.intersperse docSeparator + $ tyVarDocs + <&> \(vname, mKind) -> case mKind of + Nothing -> docLit vname + Just kind -> docSeq + [ docLitS "(" + , docLit vname + , docSeparator + , docLitS "::" + , docSeparator + , kind + , docLitS ")" + ] + +createDerivingPar + :: HsDeriving GhcPs -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered +createDerivingPar derivs mainDoc = do + case derivs of +#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ + (L _ []) -> mainDoc + (L _ types) -> + docPar mainDoc + $ docEnsureIndent BrIndentRegular + $ docLines + $ docWrapNode derivs + $ derivingClauseDoc + <$> types +#else + Nothing -> mainDoc + Just types -> + docPar mainDoc + $ docEnsureIndent BrIndentRegular + $ derivingClauseDoc types +#endif + +#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ +derivingClauseDoc :: LHsDerivingClause GhcPs -> ToBriDocM BriDocNumbered +#else +derivingClauseDoc :: Located [LHsSigType GhcPs] -> ToBriDocM BriDocNumbered +#endif +#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ +derivingClauseDoc (L _ (XHsDerivingClause ext)) = absurdExt ext +derivingClauseDoc (L _ (HsDerivingClause _ext mStrategy types)) = case types of +#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ +derivingClauseDoc (L _ (HsDerivingClause mStrategy types)) = case types of +#else +derivingClauseDoc types = case types of +#endif + (L _ []) -> docSeq [] + (L _ ts) -> + let + tsLength = length ts + whenMoreThan1Type val = + if tsLength > 1 then docLitS val else docLitS "" +#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ + (lhsStrategy, rhsStrategy) = maybe (docEmpty, docEmpty) strategyLeftRight mStrategy +#else + (lhsStrategy, rhsStrategy) = (docEmpty, docEmpty) +#endif + in + docSeq + [ docDeriving + , docWrapNodePrior types $ lhsStrategy + , docSeparator + , whenMoreThan1Type "(" + , docWrapNodeRest types + $ docSeq + $ List.intersperse docCommaSep + $ ts <&> \case +#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ + HsIB _ t -> layoutType t + XHsImplicitBndrs x -> absurdExt x +#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ + HsIB _ t _ -> layoutType t +#else + HsIB _ t -> layoutType t +#endif + , whenMoreThan1Type ")" + , rhsStrategy + ] +#if MIN_VERSION_ghc(8,2,0) /* ghc-8.6 */ + where + strategyLeftRight = \case + (L _ StockStrategy ) -> (docLitS " stock", docEmpty) + (L _ AnyclassStrategy ) -> (docLitS " anyclass", docEmpty) + (L _ NewtypeStrategy ) -> (docLitS " newtype", docEmpty) +#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ + lVia@(L _ (ViaStrategy viaTypes) ) -> + ( docEmpty + , case viaTypes of + HsIB _ext t -> docSeq + [ docWrapNode lVia $ docLitS " via" + , docSeparator + , layoutType t + ] + XHsImplicitBndrs ext -> absurdExt ext + ) +#endif +#endif + +docDeriving :: ToBriDocM BriDocNumbered +docDeriving = docLitS "deriving" + +createDetailsDoc + :: Text -> HsConDeclDetails GhcPs -> (ToBriDocM BriDocNumbered) +createDetailsDoc consNameStr details = case details of + PrefixCon args -> do + indentPolicy <- mAsk <&> _conf_layout .> _lconfig_indentPolicy .> confUnpack + let + singleLine = docSeq + [ docLit consNameStr + , docSeparator + , docForceSingleline + $ docSeq + $ List.intersperse docSeparator + $ args <&> layoutType + ] + leftIndented = docSetParSpacing + . docAddBaseY BrIndentRegular + . docPar (docLit consNameStr) + . docLines + $ layoutType <$> args + multiAppended = docSeq + [ docLit consNameStr + , docSeparator + , docSetBaseY $ docLines $ layoutType <$> args + ] + multiIndented = docSetBaseY $ docAddBaseY BrIndentRegular $ docPar + (docLit consNameStr) + (docLines $ layoutType <$> args) + case indentPolicy of + IndentPolicyLeft -> docAlt [singleLine, leftIndented] + IndentPolicyMultiple -> docAlt [singleLine, multiAppended, leftIndented] + IndentPolicyFree -> + docAlt [singleLine, multiAppended, multiIndented, leftIndented] + RecCon (L _ []) -> docSeq [docLit consNameStr, docSeparator, docLit $ Text.pack "{}"] + RecCon lRec@(L _ fields@(_:_)) -> do + let ((fName1, fType1) : fDocR) = mkFieldDocs fields + -- allowSingleline <- mAsk <&> _conf_layout .> _lconfig_allowSinglelineRecord .> confUnpack + let allowSingleline = False + docAddBaseY BrIndentRegular + $ runFilteredAlternative + $ do + -- single-line: { i :: Int, b :: Bool } + addAlternativeCond allowSingleline $ docSeq + [ docLit consNameStr + , docSeparator + , docWrapNodePrior lRec $ docLitS "{" + , docSeparator + , docWrapNodeRest lRec + $ docForceSingleline + $ docSeq + $ join + $ [fName1, docSeparator, docLitS "::", docSeparator, fType1] + : [ [ docLitS "," + , docSeparator + , fName + , docSeparator + , docLitS "::" + , docSeparator + , fType + ] + | (fName, fType) <- fDocR + ] + , docSeparator + , docLitS "}" + ] + addAlternative $ docPar + (docLit consNameStr) + (docWrapNodePrior lRec $ docNonBottomSpacingS $ docLines + [ docAlt + [ docCols ColRecDecl + [ appSep (docLitS "{") + , appSep $ docForceSingleline fName1 + , docSeq [docLitS "::", docSeparator] + , docForceSingleline $ fType1 + ] + , docSeq + [ docLitS "{" + , docSeparator + , docSetBaseY $ docAddBaseY BrIndentRegular $ docPar + fName1 + (docSeq [docLitS "::", docSeparator, fType1]) + ] + ] + , docWrapNodeRest lRec $ docLines $ fDocR <&> \(fName, fType) -> + docAlt + [ docCols ColRecDecl + [ docCommaSep + , appSep $ docForceSingleline fName + , docSeq [docLitS "::", docSeparator] + , docForceSingleline fType + ] + , docSeq + [ docLitS "," + , docSeparator + , docSetBaseY $ docAddBaseY BrIndentRegular $ docPar + fName + (docSeq [docLitS "::", docSeparator, fType]) + ] + ] + , docLitS "}" + ] + ) + InfixCon arg1 arg2 -> docSeq + [ layoutType arg1 + , docSeparator + , docLit consNameStr + , docSeparator + , layoutType arg2 + ] + where + mkFieldDocs + :: [LConDeclField GhcPs] + -> [(ToBriDocM BriDocNumbered, ToBriDocM BriDocNumbered)] + mkFieldDocs = fmap $ \lField -> case lField of +#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ + L _ (ConDeclField _ext names t _) -> createNamesAndTypeDoc lField names t + L _ (XConDeclField x) -> absurdExt x +#else + L _ (ConDeclField names t _) -> createNamesAndTypeDoc lField names t +#endif + +createForallDoc :: [LHsTyVarBndr GhcPs] -> Maybe (ToBriDocM BriDocNumbered) +createForallDoc [] = Nothing +createForallDoc lhsTyVarBndrs = Just $ docSeq + [docLitS "forall ", createBndrDoc lhsTyVarBndrs] + +createNamesAndTypeDoc + :: Data.Data.Data ast + => Located ast + -> [GenLocated t (FieldOcc GhcPs)] + -> Located (HsType GhcPs) + -> (ToBriDocM BriDocNumbered, ToBriDocM BriDocNumbered) +createNamesAndTypeDoc lField names t = + ( docNodeAnnKW lField Nothing $ docWrapNodePrior lField $ docSeq + [ docSeq + $ List.intersperse docCommaSep + $ names + <&> \case +#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ + L _ (XFieldOcc x) -> absurdExt x + L _ (FieldOcc _ fieldName) -> +#else + L _ (FieldOcc fieldName _) -> +#endif + docLit =<< lrdrNameToTextAnn fieldName + ] + , docWrapNodeRest lField $ layoutType t + ) diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs index 6d9a1f5..fbbcafd 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs @@ -53,6 +53,7 @@ import Language.Haskell.Brittany.Internal.Layouters.Type import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Expr import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Stmt import Language.Haskell.Brittany.Internal.Layouters.Pattern +import Language.Haskell.Brittany.Internal.Layouters.DataDecl import Bag ( mapBagM, bagToList, emptyBag ) import Data.Char (isUpper) @@ -85,7 +86,6 @@ layoutDecl d@(L loc decl) = case decl of _ -> briDocByExactNoComment d #endif - -------------------------------------------------------------------------------- -- Sig -------------------------------------------------------------------------------- @@ -741,6 +741,14 @@ layoutTyCl ltycl@(L _loc tycl) = case tycl of let wrapNodeRest = docWrapNodeRest ltycl docWrapNodePrior ltycl $ layoutSynDecl isInfix wrapNodeRest name (hsq_explicit vars) typ +#if MIN_VERSION_ghc(8,6,0) + DataDecl _ext name tyVars _ dataDefn -> +#elif MIN_VERSION_ghc(8,2,0) + DataDecl name tyVars _ dataDefn _ _ -> +#else + DataDecl name tyVars dataDefn _ _ -> +#endif + layoutDataDecl ltycl name tyVars dataDefn _ -> briDocByExactNoComment ltycl layoutSynDecl diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs index 4902a08..bf5a956 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs @@ -444,15 +444,17 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of docs <- docSharedWrapper layoutType `mapM` typs let end = docLit $ Text.pack ")" lines = List.tail docs <&> \d -> - docCols ColTyOpPrefix [docCommaSep, d] + docAddBaseY (BrIndentSpecial 2) + $ docCols ColTyOpPrefix [docCommaSep, d] + commaDocs = List.intersperse docCommaSep (docForceSingleline <$> docs) docAlt [ docSeq $ [docLit $ Text.pack "("] - ++ List.intersperse docCommaSep (docForceSingleline <$> docs) + ++ docWrapNodeRest ltype commaDocs ++ [end] , let line1 = docCols ColTyOpPrefix [docParenLSep, head docs] in docPar (docAddBaseY (BrIndentSpecial 2) $ line1) - (docLines $ (docAddBaseY (BrIndentSpecial 2) <$> lines) ++ [end]) + (docLines $ docWrapNodeRest ltype lines ++ [end]) ] unboxedL = do docs <- docSharedWrapper layoutType `mapM` typs @@ -460,15 +462,16 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of end = docParenHashRSep docAlt [ docSeq $ [start] - ++ List.intersperse docCommaSep docs + ++ docWrapNodeRest ltype (List.intersperse docCommaSep docs) ++ [end] , let line1 = docCols ColTyOpPrefix [start, head docs] lines = List.tail docs <&> \d -> - docCols ColTyOpPrefix [docCommaSep, d] + docAddBaseY (BrIndentSpecial 2) + $ docCols ColTyOpPrefix [docCommaSep, d] in docPar (docAddBaseY (BrIndentSpecial 2) line1) - (docLines $ (docAddBaseY (BrIndentSpecial 2) <$> lines) ++ [end]) + (docLines $ lines ++ [end]) ] HsOpTy{} -> -- TODO briDocByExactInlineOnly "HsOpTy{}" ltype diff --git a/src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs b/src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs index 22d0555..6a15eac 100644 --- a/src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs +++ b/src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs @@ -331,7 +331,7 @@ transformAlts = BrIndentNone -> r BrIndentRegular -> reWrap $ BDFEnsureIndent (BrIndentSpecial indAdd) r BrIndentSpecial i -> reWrap $ BDFEnsureIndent (BrIndentSpecial i) r - BDFNonBottomSpacing bd -> rec bd + BDFNonBottomSpacing _ bd -> rec bd BDFSetParSpacing bd -> rec bd BDFForceParSpacing bd -> rec bd BDFDebug s bd -> do @@ -488,13 +488,18 @@ getSpacing !bridoc = rec bridoc BrIndentSpecial i -> i return $ mVs <&> \(VerticalSpacing lsp psp pf) -> VerticalSpacing (lsp + addInd) psp pf - BDFNonBottomSpacing bd -> do + BDFNonBottomSpacing b bd -> do mVs <- rec bd return $ mVs - <|> LineModeValid (VerticalSpacing 0 - (VerticalSpacingParAlways colMax) - False) + <|> LineModeValid + (VerticalSpacing + 0 + (if b then VerticalSpacingParSome 0 + else VerticalSpacingParAlways colMax + ) + False + ) BDFSetParSpacing bd -> do mVs <- rec bd return $ mVs <&> \vs -> vs { _vs_parFlag = True } @@ -799,16 +804,30 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc BrIndentSpecial i -> i return $ mVs <&> \(VerticalSpacing lsp psp parFlag) -> VerticalSpacing (lsp + addInd) psp parFlag - BDFNonBottomSpacing bd -> do + BDFNonBottomSpacing b bd -> do + -- TODO: the `b` flag is an ugly hack, but I was not able to make + -- all tests work without it. It should be possible to have + -- `spMakePar` map VSPAlways{} to VSPSome x1, which fixes this + -- problem but breaks certain other cases. mVs <- rec bd return $ if null mVs - then [VerticalSpacing 0 (VerticalSpacingParAlways colMax) False] + then [VerticalSpacing + 0 + (if b then VerticalSpacingParSome 0 + else VerticalSpacingParAlways colMax + ) + False + ] else mVs <&> \vs -> vs { _vs_sameLine = min colMax (_vs_sameLine vs) , _vs_paragraph = case _vs_paragraph vs of VerticalSpacingParNone -> VerticalSpacingParNone - VerticalSpacingParAlways i -> VerticalSpacingParAlways i - VerticalSpacingParSome i -> VerticalSpacingParAlways i + VerticalSpacingParAlways i + | b -> VerticalSpacingParSome 0 + | otherwise -> VerticalSpacingParAlways i + VerticalSpacingParSome i + | b -> VerticalSpacingParSome 0 + | otherwise -> VerticalSpacingParAlways i } -- the version below is an alternative idea: fold the input -- spacings into a single spacing. This was hoped to improve in diff --git a/src/Language/Haskell/Brittany/Internal/Transformations/Columns.hs b/src/Language/Haskell/Brittany/Internal/Transformations/Columns.hs index 31ec86a..d652dda 100644 --- a/src/Language/Haskell/Brittany/Internal/Transformations/Columns.hs +++ b/src/Language/Haskell/Brittany/Internal/Transformations/Columns.hs @@ -135,4 +135,4 @@ transformSimplifyColumns = Uniplate.rewrite $ \case BDSetParSpacing{} -> Nothing BDForceParSpacing{} -> Nothing BDDebug{} -> Nothing - BDNonBottomSpacing x -> Just x + BDNonBottomSpacing _ x -> Just x diff --git a/src/Language/Haskell/Brittany/Internal/Types.hs b/src/Language/Haskell/Brittany/Internal/Types.hs index 8aad965..c8e37ff 100644 --- a/src/Language/Haskell/Brittany/Internal/Types.hs +++ b/src/Language/Haskell/Brittany/Internal/Types.hs @@ -185,6 +185,8 @@ data ColSig | ColBindStmt | ColDoLet -- the non-indented variant | ColRec + | ColRecUpdate -- used for both RecCon and RecUpd. TODO: refactor to reflect? + | ColRecDecl | ColListComp | ColList | ColApp Text @@ -256,7 +258,7 @@ data BriDoc -- after the alt transformation. | BDForceMultiline BriDoc | BDForceSingleline BriDoc - | BDNonBottomSpacing BriDoc + | BDNonBottomSpacing Bool BriDoc | BDSetParSpacing BriDoc | BDForceParSpacing BriDoc -- pseudo-deprecated @@ -301,7 +303,7 @@ data BriDocF f | BDFEnsureIndent BrIndent (f (BriDocF f)) | BDFForceMultiline (f (BriDocF f)) | BDFForceSingleline (f (BriDocF f)) - | BDFNonBottomSpacing (f (BriDocF f)) + | BDFNonBottomSpacing Bool (f (BriDocF f)) | BDFSetParSpacing (f (BriDocF f)) | BDFForceParSpacing (f (BriDocF f)) | BDFDebug String (f (BriDocF f)) @@ -313,33 +315,37 @@ type BriDocFInt = BriDocF ((,) Int) type BriDocNumbered = (Int, BriDocFInt) instance Uniplate.Uniplate BriDoc where - uniplate x@BDEmpty{} = plate x - uniplate x@BDLit{} = plate x - uniplate (BDSeq list) = plate BDSeq ||* list - uniplate (BDCols sig list) = plate BDCols |- sig ||* list - uniplate x@BDSeparator = plate x - uniplate (BDAddBaseY ind bd) = plate BDAddBaseY |- ind |* bd - uniplate (BDBaseYPushCur bd) = plate BDBaseYPushCur |* bd - uniplate (BDBaseYPop bd) = plate BDBaseYPop |* bd - uniplate (BDIndentLevelPushCur bd) = plate BDIndentLevelPushCur |* bd - uniplate (BDIndentLevelPop bd) = plate BDIndentLevelPop |* bd - uniplate (BDPar ind line indented) = plate BDPar |- ind |* line |* indented - uniplate (BDAlt alts) = plate BDAlt ||* alts - uniplate (BDForwardLineMode bd ) = plate BDForwardLineMode |* bd - uniplate x@BDExternal{} = plate x - uniplate x@BDPlain{} = plate x - uniplate (BDAnnotationPrior annKey bd) = plate BDAnnotationPrior |- annKey |* bd - uniplate (BDAnnotationKW annKey kw bd) = plate BDAnnotationKW |- annKey |- kw |* bd - uniplate (BDAnnotationRest annKey bd) = plate BDAnnotationRest |- annKey |* bd - uniplate (BDMoveToKWDP annKey kw b bd) = plate BDMoveToKWDP |- annKey |- kw |- b |* bd - uniplate (BDLines lines) = plate BDLines ||* lines - uniplate (BDEnsureIndent ind bd) = plate BDEnsureIndent |- ind |* bd - uniplate (BDForceMultiline bd) = plate BDForceMultiline |* bd - uniplate (BDForceSingleline bd) = plate BDForceSingleline |* bd - uniplate (BDNonBottomSpacing bd) = plate BDNonBottomSpacing |* bd - uniplate (BDSetParSpacing bd) = plate BDSetParSpacing |* bd - uniplate (BDForceParSpacing bd) = plate BDForceParSpacing |* bd - uniplate (BDDebug s bd) = plate BDDebug |- s |* bd + uniplate x@BDEmpty{} = plate x + uniplate x@BDLit{} = plate x + uniplate (BDSeq list ) = plate BDSeq ||* list + uniplate (BDCols sig list) = plate BDCols |- sig ||* list + uniplate x@BDSeparator = plate x + uniplate (BDAddBaseY ind bd ) = plate BDAddBaseY |- ind |* bd + uniplate (BDBaseYPushCur bd) = plate BDBaseYPushCur |* bd + uniplate (BDBaseYPop bd) = plate BDBaseYPop |* bd + uniplate (BDIndentLevelPushCur bd) = plate BDIndentLevelPushCur |* bd + uniplate (BDIndentLevelPop bd) = plate BDIndentLevelPop |* bd + uniplate (BDPar ind line indented) = plate BDPar |- ind |* line |* indented + uniplate (BDAlt alts ) = plate BDAlt ||* alts + uniplate (BDForwardLineMode bd ) = plate BDForwardLineMode |* bd + uniplate x@BDExternal{} = plate x + uniplate x@BDPlain{} = plate x + uniplate (BDAnnotationPrior annKey bd) = + plate BDAnnotationPrior |- annKey |* bd + uniplate (BDAnnotationKW annKey kw bd) = + plate BDAnnotationKW |- annKey |- kw |* bd + uniplate (BDAnnotationRest annKey bd) = + plate BDAnnotationRest |- annKey |* bd + uniplate (BDMoveToKWDP annKey kw b bd) = + plate BDMoveToKWDP |- annKey |- kw |- b |* bd + uniplate (BDLines lines ) = plate BDLines ||* lines + uniplate (BDEnsureIndent ind bd ) = plate BDEnsureIndent |- ind |* bd + uniplate (BDForceMultiline bd ) = plate BDForceMultiline |* bd + uniplate (BDForceSingleline bd ) = plate BDForceSingleline |* bd + uniplate (BDNonBottomSpacing b bd) = plate BDNonBottomSpacing |- b |* bd + uniplate (BDSetParSpacing bd ) = plate BDSetParSpacing |* bd + uniplate (BDForceParSpacing bd ) = plate BDForceParSpacing |* bd + uniplate (BDDebug s bd ) = plate BDDebug |- s |* bd newtype NodeAllocIndex = NodeAllocIndex Int @@ -367,14 +373,13 @@ unwrapBriDocNumbered tpl = case snd tpl of BDFMoveToKWDP annKey kw b bd -> BDMoveToKWDP annKey kw b $ rec bd BDFLines lines -> BDLines $ rec <$> lines BDFEnsureIndent ind bd -> BDEnsureIndent ind $ rec bd - BDFForceMultiline bd -> BDForceMultiline $ rec bd - BDFForceSingleline bd -> BDForceSingleline $ rec bd - BDFNonBottomSpacing bd -> BDNonBottomSpacing $ rec bd - BDFSetParSpacing bd -> BDSetParSpacing $ rec bd - BDFForceParSpacing bd -> BDForceParSpacing $ rec bd + BDFForceMultiline bd -> BDForceMultiline $ rec bd + BDFForceSingleline bd -> BDForceSingleline $ rec bd + BDFNonBottomSpacing b bd -> BDNonBottomSpacing b $ rec bd + BDFSetParSpacing bd -> BDSetParSpacing $ rec bd + BDFForceParSpacing bd -> BDForceParSpacing $ rec bd BDFDebug s bd -> BDDebug (s ++ "@" ++ show (fst tpl)) $ rec bd - where - rec = unwrapBriDocNumbered + where rec = unwrapBriDocNumbered isNotEmpty :: BriDoc -> Bool isNotEmpty BDEmpty = False @@ -404,11 +409,11 @@ briDocSeqSpine = \case BDMoveToKWDP _annKey _kw _b bd -> briDocSeqSpine bd BDLines lines -> foldl' (\(!()) -> briDocSeqSpine) () lines BDEnsureIndent _ind bd -> briDocSeqSpine bd - BDForceMultiline bd -> briDocSeqSpine bd - BDForceSingleline bd -> briDocSeqSpine bd - BDNonBottomSpacing bd -> briDocSeqSpine bd - BDSetParSpacing bd -> briDocSeqSpine bd - BDForceParSpacing bd -> briDocSeqSpine bd + BDForceMultiline bd -> briDocSeqSpine bd + BDForceSingleline bd -> briDocSeqSpine bd + BDNonBottomSpacing _ bd -> briDocSeqSpine bd + BDSetParSpacing bd -> briDocSeqSpine bd + BDForceParSpacing bd -> briDocSeqSpine bd BDDebug _s bd -> briDocSeqSpine bd briDocForceSpine :: BriDoc -> BriDoc diff --git a/src/Language/Haskell/Brittany/Internal/Utils.hs b/src/Language/Haskell/Brittany/Internal/Utils.hs index dfd28c3..435ad96 100644 --- a/src/Language/Haskell/Brittany/Internal/Utils.hs +++ b/src/Language/Haskell/Brittany/Internal/Utils.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -25,6 +26,7 @@ module Language.Haskell.Brittany.Internal.Utils , splitFirstLast , lines' , showOutputable + , absurdExt ) where @@ -57,6 +59,9 @@ import Language.Haskell.Brittany.Internal.Config.Types import Language.Haskell.Brittany.Internal.Types import qualified Data.Generics.Uniplate.Direct as Uniplate +#if MIN_VERSION_ghc(8,4,0) /* ghc-8.4 */ +import qualified HsExtension +#endif @@ -293,3 +298,12 @@ lines' s = case break (== '\n') s of (s1, []) -> [s1] (s1, [_]) -> [s1, ""] (s1, (_:r)) -> s1 : lines' r + +#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ +-- | A method to dismiss NoExt patterns for total matches +absurdExt :: HsExtension.NoExt -> a +absurdExt = error "cannot construct NoExt" +#else +absurdExt :: () +absurdExt = () +#endif diff --git a/stack-8.0.2.yaml.lock b/stack-8.0.2.yaml.lock new file mode 100644 index 0000000..08d3ffb --- /dev/null +++ b/stack-8.0.2.yaml.lock @@ -0,0 +1,54 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: +- completed: + hackage: monad-memo-0.4.1@sha256:d7575b0c89ad21818ca5746170d10a3b92f01fdf9028fa37d3a370e42b24b38b,3672 + pantry-tree: + size: 1823 + sha256: 8d7bcc8a8bce43804613a160fd7f0fea7869a54e530a9f1b9f9e853ec4e00b57 + original: + hackage: monad-memo-0.4.1 +- completed: + hackage: czipwith-1.0.1.0@sha256:30751c5a92488304863f20403cd8e9d4fee2b5def0b656a3d979aa3331a09c00,1652 + pantry-tree: + size: 323 + sha256: acd60968c5a1945741204751243f88d1af1c152018c2d9575f62c0805825f44f + original: + hackage: czipwith-1.0.1.0 +- completed: + hackage: butcher-1.3.1.1@sha256:d5734df2e42c28c5a8419eb8251cc531e5f5e6a13794b2ae1dac04abd1c359ad,3242 + pantry-tree: + size: 1197 + sha256: 057b5c8aa0211951337d87cda1f3d4c6f049945314f6fc7883394eebac79be5b + original: + hackage: butcher-1.3.1.1 +- completed: + hackage: data-tree-print-0.1.0.0@sha256:6610723626501d3ab65dc2290c0de59de8d042caf72a1db1e0cd01e84d229346,1547 + pantry-tree: + size: 272 + sha256: caa741fd498f754b42d45a16aae455056d5e71df51e960fce1579b8e8b6496ad + original: + hackage: data-tree-print-0.1.0.0 +- completed: + hackage: deque-0.2@sha256:a9736298cd04472924b3b681b3791c99e8b6009a6e5df1ff13dd57457109ad43,877 + pantry-tree: + size: 205 + sha256: c48e1f58dfac107ba9dd8d159d4c033fd72521de678204788e3f01f7a2e17546 + original: + hackage: deque-0.2 +- completed: + hackage: ghc-exactprint-0.5.8.0@sha256:71915a08a7d442d39a63cb3b0fbd90b7dacd19bc4b05bac5c53b6e8a0d931b7b,7728 + pantry-tree: + size: 83871 + sha256: 3998143d33f7de29b31e8cf8d1b207c1fb4962f819fc820e209e1eecbf7e5a35 + original: + hackage: ghc-exactprint-0.5.8.0 +snapshots: +- completed: + size: 533451 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/9/0.yaml + sha256: 27f29b231b39ea68e967a7a4346b2693a49d77c50f41fc0c276e11189a538da7 + original: lts-9.0 diff --git a/stack-8.2.2.yaml.lock b/stack-8.2.2.yaml.lock new file mode 100644 index 0000000..8bacbb2 --- /dev/null +++ b/stack-8.2.2.yaml.lock @@ -0,0 +1,33 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: +- completed: + hackage: czipwith-1.0.1.0@sha256:30751c5a92488304863f20403cd8e9d4fee2b5def0b656a3d979aa3331a09c00,1652 + pantry-tree: + size: 323 + sha256: acd60968c5a1945741204751243f88d1af1c152018c2d9575f62c0805825f44f + original: + hackage: czipwith-1.0.1.0 +- completed: + hackage: butcher-1.3.1.1@sha256:d5734df2e42c28c5a8419eb8251cc531e5f5e6a13794b2ae1dac04abd1c359ad,3242 + pantry-tree: + size: 1197 + sha256: 057b5c8aa0211951337d87cda1f3d4c6f049945314f6fc7883394eebac79be5b + original: + hackage: butcher-1.3.1.1 +- completed: + hackage: ghc-exactprint-0.5.8.0@sha256:71915a08a7d442d39a63cb3b0fbd90b7dacd19bc4b05bac5c53b6e8a0d931b7b,7728 + pantry-tree: + size: 83871 + sha256: 3998143d33f7de29b31e8cf8d1b207c1fb4962f819fc820e209e1eecbf7e5a35 + original: + hackage: ghc-exactprint-0.5.8.0 +snapshots: +- completed: + size: 505335 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/11/1.yaml + sha256: 59c853f993e736f430ad20d03eb5441c715d84359c035de906f970841887a8f8 + original: lts-11.1 diff --git a/stack-8.4.3.yaml.lock b/stack-8.4.3.yaml.lock new file mode 100644 index 0000000..b4a4818 --- /dev/null +++ b/stack-8.4.3.yaml.lock @@ -0,0 +1,19 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: +- completed: + hackage: ghc-exactprint-0.5.8.1@sha256:f76eed0976b854ce03928796e9cff97769e304618ca99bc0f6cdccab31e539d0,7728 + pantry-tree: + size: 83871 + sha256: 14febc191ef8b0d1f218d13e8db9ed20395f10a5b3d8aa2c0d45869a037420a2 + original: + hackage: ghc-exactprint-0.5.8.1 +snapshots: +- completed: + size: 504336 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/12/12.yaml + sha256: 11db5c37144d13fe6b56cd511050b4e6ffe988f6edb8e439c2432fc9fcdf50c3 + original: lts-12.12 diff --git a/stack-8.6.5.yaml.lock b/stack-8.6.5.yaml.lock new file mode 100644 index 0000000..a7d341f --- /dev/null +++ b/stack-8.6.5.yaml.lock @@ -0,0 +1,26 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: +- completed: + hackage: butcher-1.3.2.1@sha256:cf479ea83a08f4f59a482e7c023c70714e7c93c1ccd7d53fe076ad3f1a3d2b8d,3115 + pantry-tree: + size: 1197 + sha256: dc4bd6adc5f8bd3589533659b62567da78b6956d7098e561c0523c60fcaa0406 + original: + hackage: butcher-1.3.2.1 +- completed: + hackage: multistate-0.8.0.1@sha256:496ac087a0df3984045d7460b981d5e868a49e160b60a6555f6799e81e58542d,3700 + pantry-tree: + size: 2143 + sha256: 0136d5fcddee0244c3bc73b4ae1b489134a1dd12a8978f437b2be81e98f5d8bd + original: + hackage: multistate-0.8.0.1 +snapshots: +- completed: + size: 498398 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/23.yaml + sha256: 63151ca76f39d5cfbd266ce019236459fdda53fbefd2200aedeb33bcc81f808e + original: lts-13.23 diff --git a/stack.yaml.lock b/stack.yaml.lock new file mode 100644 index 0000000..6b3c445 --- /dev/null +++ b/stack.yaml.lock @@ -0,0 +1,47 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: +- completed: + hackage: multistate-0.8.0.2@sha256:fbb0d8ade9ef73c8ed92488f5804d0ebe75d3a9c24bf53452bc3a4f32b34cb2e,3713 + pantry-tree: + size: 2143 + sha256: 1753828d37b456e1e0241766d893b29f385ef7769fa79610f507b747935b77cb + original: + hackage: multistate-0.8.0.2 +- completed: + hackage: butcher-1.3.2.3@sha256:1b8040eddb6da2a05426bf9f6c56b078e629228d64d7d61fb3daa88802487e1b,3262 + pantry-tree: + size: 1197 + sha256: 6bf3a318bd8689bd1fa7a8084c0d96372768d2dc3e30d9aa58d07741ed6816e6 + original: + hackage: butcher-1.3.2.3 +- completed: + hackage: deque-0.4.2.3@sha256:7cc8ddfc77df351ff9c16e838ccdb4a89f055c80a3111e27eba8d90e8edde7d0,1853 + pantry-tree: + size: 807 + sha256: 7f584c71e9e912935f829cb4667411ae3c3048fcd8b935170fb5a45188019403 + original: + hackage: deque-0.4.2.3 +- completed: + hackage: strict-list-0.1.4@sha256:0fa869e2c21b710b7133e8628169f120fe6299342628edd3d5087ded299bc941,1631 + pantry-tree: + size: 340 + sha256: bbb22fd014867dc48697ddd8598d4a9fb03fa2d58ef79bed94f208a9b6d94224 + original: + hackage: strict-list-0.1.4 +- completed: + hackage: ghc-exactprint-0.5.8.2@sha256:b078e02ce263db6214f8418c8b6f6be1c8a7ca1499bb2f8936b91b5ed210faa5,7901 + pantry-tree: + size: 83871 + sha256: 1dc1dc7f036dfb8e7642deaeb2845c62731085abc29a1494c22cd6b1b5a18d16 + original: + hackage: ghc-exactprint-0.5.8.2 +snapshots: +- completed: + size: 499461 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/25.yaml + sha256: aed98969628e20615e96b06083c933c7e3354ae56b08b75e607a26569225d6c0 + original: lts-13.25