import+module: Refactor and Simplify slightly

lspitzner · Dec 17, 2017 · 204f0af · 204f0af
1 parent e140cd0
commit 204f0af
Show file tree

Hide file tree

Showing 7 changed files with 158 additions and 131 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
 
-layoutImport :: ToBriDoc ImportDecl
-layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of
-  ImportDecl _ (L _ modName) pkg src safe q False as llies ->
-    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 -> ""
+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         = id
+prepPkg :: String -> String
+prepPkg = id
 #endif
-      pkgNameT         = Text.pack . prepPkg . sl_st <$> pkg
 #if MIN_VERSION_ghc(8,2,0)
-      prepModName      = unLoc
+prepModName :: Located e -> e
+prepModName = unLoc
 #else
-      prepModName      = id
+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 -> do
+    let
+      modNameT         = Text.pack $ moduleNameString modName
+      pkgNameT         = Text.pack . prepPkg . sl_st <$> pkg
+
       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
@@ -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
@@ -178,6 +178,7 @@ data ColSig
   | ColTuple
   | ColTuples
   | ColOpPrefix -- merge with ColList ? other stuff?
+  | ColImport
 
   -- TODO
   deriving (Eq, Ord, Data.Data.Data, Show)