hexagoxel
/
brittany
1
0
Fork 0
Code Issues 117 Pull Requests 5 Packages Projects Releases 5 Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
src-literatetests/10-tests.blt
View File

@ -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

16
src-literatetests/tests-context-free.blt
View File

@ -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

4
src/Language/Haskell/Brittany/Internal/LayouterBasics.hs
View File

@ -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 "'"

84
src/Language/Haskell/Brittany/Internal/Layouters/IE.hs
View File

@ -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]
)
]

87
src/Language/Haskell/Brittany/Internal/Layouters/Import.hs
View File

@ -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

80
src/Language/Haskell/Brittany/Internal/Layouters/Module.hs
View File

@ -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

1
src/Language/Haskell/Brittany/Internal/Types.hs
View File

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