From 204f0aff0857968a24d0f0e2f968c3bd91a51e26 Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Sun, 17 Dec 2017 20:47:52 +0100 Subject: [PATCH] import+module: Refactor and Simplify slightly --- src-literatetests/10-tests.blt | 19 ++-- src-literatetests/tests-context-free.blt | 16 +++- .../Brittany/Internal/LayouterBasics.hs | 4 + .../Haskell/Brittany/Internal/Layouters/IE.hs | 84 +++++++++--------- .../Brittany/Internal/Layouters/Import.hs | 87 ++++++++++--------- .../Brittany/Internal/Layouters/Module.hs | 80 ++++++++--------- .../Haskell/Brittany/Internal/Types.hs | 1 + 7 files changed, 159 insertions(+), 132 deletions(-) diff --git a/src-literatetests/10-tests.blt b/src-literatetests/10-tests.blt index f1ea640..6b838a3 100644 --- a/src-literatetests/10-tests.blt +++ b/src-literatetests/10-tests.blt @@ -544,9 +544,14 @@ func = ] ++ [ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc] -### + +############################################################################### +############################################################################### +############################################################################### #group module -### +############################################################################### +############################################################################### +############################################################################### #test simple module Main where @@ -603,9 +608,13 @@ module Main (Test()) where #test empty-with-comment -- Intentionally left empty -### -#group import -### +############################################################################### +############################################################################### +############################################################################### +#group module.import +############################################################################### +############################################################################### +############################################################################### #test simple-import import Data.List diff --git a/src-literatetests/tests-context-free.blt b/src-literatetests/tests-context-free.blt index b8b0c4a..c588436 100644 --- a/src-literatetests/tests-context-free.blt +++ b/src-literatetests/tests-context-free.blt @@ -593,9 +593,13 @@ func = ] ++ [ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc] -### +############################################################################### +############################################################################### +############################################################################### #group module -### +############################################################################### +############################################################################### +############################################################################### #test simple module Main where @@ -652,9 +656,13 @@ module Main (Test()) where #test empty-with-comment -- Intentionally left empty -### +############################################################################### +############################################################################### +############################################################################### #group import -### +############################################################################### +############################################################################### +############################################################################### #test simple-import import Data.List diff --git a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs index 52c9e08..151dd65 100644 --- a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs +++ b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs @@ -42,6 +42,7 @@ module Language.Haskell.Brittany.Internal.LayouterBasics , appSep , docCommaSep , docParenLSep + , docParenR , docTick , spacifyDocs , briDocMToPPM @@ -465,6 +466,9 @@ docCommaSep = appSep $ docLit $ Text.pack "," docParenLSep :: ToBriDocM BriDocNumbered docParenLSep = appSep $ docLit $ Text.pack "(" +docParenR :: ToBriDocM BriDocNumbered +docParenR = docLit $ Text.pack ")" + docTick :: ToBriDocM BriDocNumbered docTick = docLit $ Text.pack "'" diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs b/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs index e6b83b7..df1b6ff 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs @@ -11,7 +11,13 @@ import Language.Haskell.Brittany.Internal.LayouterBasics import Language.Haskell.Brittany.Internal.Config.Types import RdrName (RdrName(..)) -import GHC (unLoc, runGhc, GenLocated(L), moduleNameString, AnnKeywordId(..)) +import GHC ( unLoc + , runGhc + , GenLocated(L) + , moduleNameString + , AnnKeywordId(..) + , Located + ) import HsSyn import Name import HsImpExp @@ -22,53 +28,53 @@ import BasicTypes import Language.Haskell.Brittany.Internal.Utils -layoutIE :: ToBriDoc IE -layoutIE lie@(L _ _ie) = - docWrapNode lie - $ let - ien = docLit $ rdrNameToText $ ieName _ie - in - case _ie of - IEVar _ -> ien - IEThingAbs _ -> ien - IEThingAll _ -> docSeq [ien, docLit $ Text.pack "(..)"] - IEThingWith _ (IEWildcard _) _ _ -> - docSeq [ien, docLit $ Text.pack "(..)"] - IEThingWith _ _ ns fs -> - let - prepareFL = - docLit . Text.pack . FastString.unpackFS . flLabel . unLoc - in - docSeq - $ [ien, docLit $ Text.pack "("] + #if MIN_VERSION_ghc(8,2,0) - ++ ( intersperse docCommaSep (map (docLit . lrdrNameToText . ieLWrappedName) ns) +prepareName :: LIEWrappedName name -> Located name +prepareName = ieLWrappedName #else - ++ ( intersperse docCommaSep (map (docLit . lrdrNameToText) ns) +prepareName :: Located name -> Located name +prepareName = id #endif - ++ intersperse docCommaSep (map (prepareFL) fs) - ) - ++ [docLit $ Text.pack ")"] - IEModuleContents n -> docSeq - [ docLit $ Text.pack "module" - , docSeparator - , docLit . Text.pack . moduleNameString $ unLoc n - ] - _ -> docEmpty + +layoutIE :: ToBriDoc IE +layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of + IEVar _ -> ien + IEThingAbs _ -> ien + IEThingAll _ -> docSeq [ien, docLit $ Text.pack "(..)"] + IEThingWith _ (IEWildcard _) _ _ -> docSeq [ien, docLit $ Text.pack "(..)"] + IEThingWith _ _ ns fs -> + docSeq + $ [ien, docLit $ Text.pack "("] + ++ ( intersperse docCommaSep + (map (docLit . lrdrNameToText . prepareName) ns) + ++ intersperse docCommaSep (map prepareFL fs) + ) + ++ [docLit $ Text.pack ")"] + where + prepareFL = docLit . Text.pack . FastString.unpackFS . flLabel . unLoc + IEModuleContents n -> docSeq + [ docLit $ Text.pack "module" + , docSeparator + , docLit . Text.pack . moduleNameString $ unLoc n + ] + _ -> docEmpty + where ien = docLit $ rdrNameToText $ ieName ie layoutIEList :: [LIE RdrName] -> ToBriDocM BriDocNumbered layoutIEList lies = do ies <- mapM (docSharedWrapper layoutIE) lies case ies of - [] -> docLit $ Text.pack "()" - (x:xs) -> docAlt + [] -> docLit $ Text.pack "()" + xs@(x1:xr) -> docAlt [ docSeq - $ [docLit $ Text.pack "(", x] - ++ map (\x' -> docSeq [docCommaSep, x']) xs - ++ [docLit $ Text.pack ")"] + [ docLit $ Text.pack "(" + , docSeq $ List.intersperse docCommaSep xs + , docLit $ Text.pack ")" + ] , docLines - ( docSeq [docLit $ Text.pack "(", docSeparator, x] - : map (\x' -> docSeq [docCommaSep, x']) xs - ++ [docLit $ Text.pack ")"] + ( [docSeq [docParenLSep, x1]] + ++ [ docSeq [docCommaSep, x] | x <- xr ] + ++ [docParenR] ) ] diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs index 6bfd63f..ea5d49c 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs @@ -8,7 +8,13 @@ import Language.Haskell.Brittany.Internal.Layouters.IE import Language.Haskell.Brittany.Internal.Config.Types import RdrName (RdrName(..)) -import GHC (unLoc, runGhc, GenLocated(L), moduleNameString, AnnKeywordId(..)) +import GHC ( unLoc + , runGhc + , GenLocated(L) + , moduleNameString + , AnnKeywordId(..) + , Located + ) import HsSyn import Name import HsImpExp @@ -18,29 +24,36 @@ import BasicTypes import Language.Haskell.Brittany.Internal.Utils + + +#if MIN_VERSION_ghc(8,2,0) +prepPkg :: SourceText -> String +prepPkg rawN = + case rawN of + SourceText n -> n + -- This would be odd to encounter and the + -- result will most certainly be wrong + NoSourceText -> "" +#else +prepPkg :: String -> String +prepPkg = id +#endif +#if MIN_VERSION_ghc(8,2,0) +prepModName :: Located e -> e +prepModName = unLoc +#else +prepModName :: e -> e +prepModName = id +#endif + layoutImport :: ToBriDoc ImportDecl layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of - ImportDecl _ (L _ modName) pkg src safe q False as llies -> + ImportDecl _ (L _ modName) pkg src safe q False as llies -> do let modNameT = Text.pack $ moduleNameString modName -#if MIN_VERSION_ghc(8,2,0) - prepPkg rawN = - case rawN of - SourceText n -> n - -- This would be odd to encounter and the - -- result will most certainly be wrong - NoSourceText -> "" -#else - prepPkg = id -#endif pkgNameT = Text.pack . prepPkg . sl_st <$> pkg -#if MIN_VERSION_ghc(8,2,0) - prepModName = unLoc -#else - prepModName = id -#endif + asT = Text.pack . moduleNameString . prepModName <$> as - sig = ColBindingLine (Just (Text.pack "import")) importQualifiers = docSeq [ appSep $ docLit $ Text.pack "import" , if src then appSep $ docLit $ Text.pack "{-# SOURCE #-}" else docEmpty @@ -52,26 +65,22 @@ layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of appSep $ docSeq [docLit (Text.pack "as"), docSeparator, docLit asT'] importIds = docSeq $ [appSep $ docLit modNameT, fromMaybe docEmpty (makeAs <$> asT)] - in - do - (hiding, ies) <- case llies of - Just (h, L _ lies) -> do - sies <- docSharedWrapper layoutIEList lies - return (h, sies) - Nothing -> return (False, docEmpty) - h <- docSharedWrapper - ( const - ( docSeq - [ docCols sig [importQualifiers, importIds] - , if hiding - then appSep $ docLit $ Text.pack "hiding" - else docEmpty - ] - ) - ) - () - docAlt - [ docSeq [h, docForceSingleline ies] - , docAddBaseY BrIndentRegular $ docPar h (docForceMultiline ies) + (hiding, ies) <- case llies of + Just (h, L _ lies) -> do + sies <- docSharedWrapper layoutIEList lies + return (h, sies) + Nothing -> return (False, docEmpty) + h <- docSharedWrapper + ( const + ( docSeq + [ docCols ColImport [importQualifiers, importIds] + , if hiding then appSep $ docLit $ Text.pack "hiding" else docEmpty ] + ) + ) + () + docAlt + [ docSeq [h, docForceSingleline ies] + , docAddBaseY BrIndentRegular $ docPar h (docForceMultiline ies) + ] _ -> docEmpty diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Module.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Module.hs index 0093c46..d7ce6ea 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Module.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Module.hs @@ -21,53 +21,43 @@ import Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types import Language.Haskell.Brittany.Internal.Utils + + layoutModule :: ToBriDoc HsModule layoutModule lmod@(L _ mod') = do case mod' of -- Implicit module Main - HsModule Nothing _ imports _ _ _ -> docLines $ map layoutImport imports - HsModule (Just n) les imports _ _ _ -> - let - tn = Text.pack $ moduleNameString $ unLoc n - in - do - cs <- do - anns <- mAsk - case ExactPrint.Types.mkAnnKey lmod `Map.lookup` anns of - Just mAnn -> return $ extractAllComments mAnn - Nothing -> return [] - (hasComments, es) <- case les of - Nothing -> return (False, docEmpty) - Just llies@(L _ lies) -> do - hasComments <- hasAnyCommentsBelow llies - return (hasComments, docWrapNode llies $ layoutIEList lies) - docLines - ( [ -- A pseudo node that serves merely to force documentation + HsModule Nothing _ imports _ _ _ -> docLines $ map layoutImport imports + HsModule (Just n) les imports _ _ _ -> do + let tn = Text.pack $ moduleNameString $ unLoc n + (hasComments, es) <- case les of + Nothing -> return (False, docEmpty) + Just llies@(L _ lies) -> do + hasComments <- hasAnyCommentsBelow llies + return (hasComments, docWrapNode llies $ layoutIEList lies) + docLines + $ docSeq + [ docWrapNode lmod $ docEmpty + -- A pseudo node that serves merely to force documentation -- before the node - docWrapNode lmod $ docEmpty - | [] /= cs - ] - ++ [ docAlt - ( [ docSeq - [ appSep $ docLit $ Text.pack "module" - , appSep $ docLit tn - , appSep $ docForceSingleline es - , docLit $ Text.pack "where" - ] - | not hasComments - ] - ++ [ docLines - [ docAddBaseY BrIndentRegular $ docPar - ( docSeq - [ appSep $ docLit $ Text.pack "module" - , docLit tn - ] - ) - (docForceMultiline es) - , docLit $ Text.pack "where" - ] - ] - ) - ] - ++ map layoutImport imports - ) + , docAlt + ( [ docSeq + [ appSep $ docLit $ Text.pack "module" + , appSep $ docLit tn + , appSep $ docForceSingleline es + , docLit $ Text.pack "where" + ] + | not hasComments + ] + ++ [ docLines + [ docAddBaseY BrIndentRegular $ docPar + ( docSeq + [appSep $ docLit $ Text.pack "module", docLit tn] + ) + (docForceMultiline es) + , docLit $ Text.pack "where" + ] + ] + ) + ] + : map layoutImport imports diff --git a/src/Language/Haskell/Brittany/Internal/Types.hs b/src/Language/Haskell/Brittany/Internal/Types.hs index 557f9b3..2784c1d 100644 --- a/src/Language/Haskell/Brittany/Internal/Types.hs +++ b/src/Language/Haskell/Brittany/Internal/Types.hs @@ -178,6 +178,7 @@ data ColSig | ColTuple | ColTuples | ColOpPrefix -- merge with ColList ? other stuff? + | ColImport -- TODO deriving (Eq, Ord, Data.Data.Data, Show)