import+module: Refactor and Simplify slightly

pull/83/head
Lennart Spitzner 2017-12-17 20:47:52 +01:00
parent e140cd01e0
commit 204f0aff08
7 changed files with 159 additions and 132 deletions

View File

@ -544,9 +544,14 @@ func =
] ]
++ [ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc] ++ [ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc]
###
###############################################################################
###############################################################################
###############################################################################
#group module #group module
### ###############################################################################
###############################################################################
###############################################################################
#test simple #test simple
module Main where module Main where
@ -603,9 +608,13 @@ module Main (Test()) where
#test empty-with-comment #test empty-with-comment
-- Intentionally left empty -- Intentionally left empty
### ###############################################################################
#group import ###############################################################################
### ###############################################################################
#group module.import
###############################################################################
###############################################################################
###############################################################################
#test simple-import #test simple-import
import Data.List import Data.List

View File

@ -593,9 +593,13 @@ func =
] ]
++ [ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc] ++ [ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc]
### ###############################################################################
###############################################################################
###############################################################################
#group module #group module
### ###############################################################################
###############################################################################
###############################################################################
#test simple #test simple
module Main where module Main where
@ -652,9 +656,13 @@ module Main (Test()) where
#test empty-with-comment #test empty-with-comment
-- Intentionally left empty -- Intentionally left empty
### ###############################################################################
###############################################################################
###############################################################################
#group import #group import
### ###############################################################################
###############################################################################
###############################################################################
#test simple-import #test simple-import
import Data.List import Data.List

View File

@ -42,6 +42,7 @@ module Language.Haskell.Brittany.Internal.LayouterBasics
, appSep , appSep
, docCommaSep , docCommaSep
, docParenLSep , docParenLSep
, docParenR
, docTick , docTick
, spacifyDocs , spacifyDocs
, briDocMToPPM , briDocMToPPM
@ -465,6 +466,9 @@ docCommaSep = appSep $ docLit $ Text.pack ","
docParenLSep :: ToBriDocM BriDocNumbered docParenLSep :: ToBriDocM BriDocNumbered
docParenLSep = appSep $ docLit $ Text.pack "(" docParenLSep = appSep $ docLit $ Text.pack "("
docParenR :: ToBriDocM BriDocNumbered
docParenR = docLit $ Text.pack ")"
docTick :: ToBriDocM BriDocNumbered docTick :: ToBriDocM BriDocNumbered
docTick = docLit $ Text.pack "'" docTick = docLit $ Text.pack "'"

View File

@ -11,7 +11,13 @@ import Language.Haskell.Brittany.Internal.LayouterBasics
import Language.Haskell.Brittany.Internal.Config.Types import Language.Haskell.Brittany.Internal.Config.Types
import RdrName (RdrName(..)) import RdrName (RdrName(..))
import GHC (unLoc, runGhc, GenLocated(L), moduleNameString, AnnKeywordId(..)) import GHC ( unLoc
, runGhc
, GenLocated(L)
, moduleNameString
, AnnKeywordId(..)
, Located
)
import HsSyn import HsSyn
import Name import Name
import HsImpExp import HsImpExp
@ -22,53 +28,53 @@ import BasicTypes
import Language.Haskell.Brittany.Internal.Utils 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) #if MIN_VERSION_ghc(8,2,0)
++ ( intersperse docCommaSep (map (docLit . lrdrNameToText . ieLWrappedName) ns) prepareName :: LIEWrappedName name -> Located name
prepareName = ieLWrappedName
#else #else
++ ( intersperse docCommaSep (map (docLit . lrdrNameToText) ns) prepareName :: Located name -> Located name
prepareName = id
#endif #endif
++ intersperse docCommaSep (map (prepareFL) fs)
) layoutIE :: ToBriDoc IE
++ [docLit $ Text.pack ")"] layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of
IEModuleContents n -> docSeq IEVar _ -> ien
[ docLit $ Text.pack "module" IEThingAbs _ -> ien
, docSeparator IEThingAll _ -> docSeq [ien, docLit $ Text.pack "(..)"]
, docLit . Text.pack . moduleNameString $ unLoc n IEThingWith _ (IEWildcard _) _ _ -> docSeq [ien, docLit $ Text.pack "(..)"]
] IEThingWith _ _ ns fs ->
_ -> docEmpty 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 :: [LIE RdrName] -> ToBriDocM BriDocNumbered
layoutIEList lies = do layoutIEList lies = do
ies <- mapM (docSharedWrapper layoutIE) lies ies <- mapM (docSharedWrapper layoutIE) lies
case ies of case ies of
[] -> docLit $ Text.pack "()" [] -> docLit $ Text.pack "()"
(x:xs) -> docAlt xs@(x1:xr) -> docAlt
[ docSeq [ docSeq
$ [docLit $ Text.pack "(", x] [ docLit $ Text.pack "("
++ map (\x' -> docSeq [docCommaSep, x']) xs , docSeq $ List.intersperse docCommaSep xs
++ [docLit $ Text.pack ")"] , docLit $ Text.pack ")"
]
, docLines , docLines
( docSeq [docLit $ Text.pack "(", docSeparator, x] ( [docSeq [docParenLSep, x1]]
: map (\x' -> docSeq [docCommaSep, x']) xs ++ [ docSeq [docCommaSep, x] | x <- xr ]
++ [docLit $ Text.pack ")"] ++ [docParenR]
) )
] ]

View File

@ -8,7 +8,13 @@ import Language.Haskell.Brittany.Internal.Layouters.IE
import Language.Haskell.Brittany.Internal.Config.Types import Language.Haskell.Brittany.Internal.Config.Types
import RdrName (RdrName(..)) import RdrName (RdrName(..))
import GHC (unLoc, runGhc, GenLocated(L), moduleNameString, AnnKeywordId(..)) import GHC ( unLoc
, runGhc
, GenLocated(L)
, moduleNameString
, AnnKeywordId(..)
, Located
)
import HsSyn import HsSyn
import Name import Name
import HsImpExp import HsImpExp
@ -18,29 +24,36 @@ import BasicTypes
import Language.Haskell.Brittany.Internal.Utils 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 :: ToBriDoc ImportDecl
layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of 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 let
modNameT = Text.pack $ moduleNameString modName 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 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 asT = Text.pack . moduleNameString . prepModName <$> as
sig = ColBindingLine (Just (Text.pack "import"))
importQualifiers = docSeq importQualifiers = docSeq
[ appSep $ docLit $ Text.pack "import" [ appSep $ docLit $ Text.pack "import"
, if src then appSep $ docLit $ Text.pack "{-# SOURCE #-}" else docEmpty , 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'] appSep $ docSeq [docLit (Text.pack "as"), docSeparator, docLit asT']
importIds = importIds =
docSeq $ [appSep $ docLit modNameT, fromMaybe docEmpty (makeAs <$> asT)] docSeq $ [appSep $ docLit modNameT, fromMaybe docEmpty (makeAs <$> asT)]
in (hiding, ies) <- case llies of
do Just (h, L _ lies) -> do
(hiding, ies) <- case llies of sies <- docSharedWrapper layoutIEList lies
Just (h, L _ lies) -> do return (h, sies)
sies <- docSharedWrapper layoutIEList lies Nothing -> return (False, docEmpty)
return (h, sies) h <- docSharedWrapper
Nothing -> return (False, docEmpty) ( const
h <- docSharedWrapper ( docSeq
( const [ docCols ColImport [importQualifiers, importIds]
( docSeq , if hiding then appSep $ docLit $ Text.pack "hiding" else docEmpty
[ 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)
] ]
)
)
()
docAlt
[ docSeq [h, docForceSingleline ies]
, docAddBaseY BrIndentRegular $ docPar h (docForceMultiline ies)
]
_ -> docEmpty _ -> docEmpty

View File

@ -21,53 +21,43 @@ import Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
import Language.Haskell.Brittany.Internal.Utils import Language.Haskell.Brittany.Internal.Utils
layoutModule :: ToBriDoc HsModule layoutModule :: ToBriDoc HsModule
layoutModule lmod@(L _ mod') = do layoutModule lmod@(L _ mod') = do
case mod' of case mod' of
-- Implicit module Main -- Implicit module Main
HsModule Nothing _ imports _ _ _ -> docLines $ map layoutImport imports HsModule Nothing _ imports _ _ _ -> docLines $ map layoutImport imports
HsModule (Just n) les imports _ _ _ -> HsModule (Just n) les imports _ _ _ -> do
let let tn = Text.pack $ moduleNameString $ unLoc n
tn = Text.pack $ moduleNameString $ unLoc n (hasComments, es) <- case les of
in Nothing -> return (False, docEmpty)
do Just llies@(L _ lies) -> do
cs <- do hasComments <- hasAnyCommentsBelow llies
anns <- mAsk return (hasComments, docWrapNode llies $ layoutIEList lies)
case ExactPrint.Types.mkAnnKey lmod `Map.lookup` anns of docLines
Just mAnn -> return $ extractAllComments mAnn $ docSeq
Nothing -> return [] [ docWrapNode lmod $ docEmpty
(hasComments, es) <- case les of -- A pseudo node that serves merely to force documentation
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
-- before the node -- before the node
docWrapNode lmod $ docEmpty , docAlt
| [] /= cs ( [ docSeq
] [ appSep $ docLit $ Text.pack "module"
++ [ docAlt , appSep $ docLit tn
( [ docSeq , appSep $ docForceSingleline es
[ appSep $ docLit $ Text.pack "module" , docLit $ Text.pack "where"
, appSep $ docLit tn ]
, appSep $ docForceSingleline es | not hasComments
, docLit $ Text.pack "where" ]
] ++ [ docLines
| not hasComments [ docAddBaseY BrIndentRegular $ docPar
] ( docSeq
++ [ docLines [appSep $ docLit $ Text.pack "module", docLit tn]
[ docAddBaseY BrIndentRegular $ docPar )
( docSeq (docForceMultiline es)
[ appSep $ docLit $ Text.pack "module" , docLit $ Text.pack "where"
, docLit tn ]
] ]
) )
(docForceMultiline es) ]
, docLit $ Text.pack "where" : map layoutImport imports
]
]
)
]
++ map layoutImport imports
)

View File

@ -178,6 +178,7 @@ data ColSig
| ColTuple | ColTuple
| ColTuples | ColTuples
| ColOpPrefix -- merge with ColList ? other stuff? | ColOpPrefix -- merge with ColList ? other stuff?
| ColImport
-- TODO -- TODO
deriving (Eq, Ord, Data.Data.Data, Show) deriving (Eq, Ord, Data.Data.Data, Show)