Add import and module support
sniperrifle2004
parent
f7e5287f1d
commit
ee9abff9e8
|
|
@ -67,6 +67,9 @@ library {
|
|||
Language.Haskell.Brittany.Internal.Layouters.Expr
|
||||
Language.Haskell.Brittany.Internal.Layouters.Stmt
|
||||
Language.Haskell.Brittany.Internal.Layouters.Pattern
|
||||
Language.Haskell.Brittany.Internal.Layouters.IE
|
||||
Language.Haskell.Brittany.Internal.Layouters.Import
|
||||
Language.Haskell.Brittany.Internal.Layouters.Module
|
||||
Language.Haskell.Brittany.Internal.Transformations.Alt
|
||||
Language.Haskell.Brittany.Internal.Transformations.Floating
|
||||
Language.Haskell.Brittany.Internal.Transformations.Par
|
||||
|
|
|
|||
|
|
@ -544,3 +544,165 @@ func =
|
|||
]
|
||||
++ [ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc]
|
||||
|
||||
###
|
||||
#group module
|
||||
###
|
||||
|
||||
#test simple
|
||||
module Main where
|
||||
|
||||
#test no-exports
|
||||
module Main () where
|
||||
|
||||
#test one-export
|
||||
module Main (main) where
|
||||
|
||||
#test several-exports
|
||||
module Main (main, test1, test2) where
|
||||
|
||||
#test many-exports
|
||||
module Main
|
||||
( main
|
||||
, test1
|
||||
, test2
|
||||
, test3
|
||||
, test4
|
||||
, test5
|
||||
, test6
|
||||
, test7
|
||||
, test8
|
||||
, test9
|
||||
)
|
||||
where
|
||||
|
||||
#test exports-with-comments
|
||||
module Main
|
||||
( main
|
||||
, test1
|
||||
, test2
|
||||
-- Test 3
|
||||
, test3
|
||||
, test4
|
||||
-- Test 5
|
||||
, test5
|
||||
)
|
||||
where
|
||||
|
||||
#test simple-export-with-things
|
||||
module Main (Test(..)) where
|
||||
|
||||
#test simple-export-with-module-contents
|
||||
module Main (module Main) where
|
||||
|
||||
#test export-with-things
|
||||
module Main (Test(Test, a, b)) where
|
||||
|
||||
#test export-with-empty-thing
|
||||
module Main (Test()) where
|
||||
|
||||
#test empty-with-comment
|
||||
-- Intentionally left empty
|
||||
|
||||
###
|
||||
#group import
|
||||
###
|
||||
|
||||
#test simple-import
|
||||
import Data.List
|
||||
|
||||
#test simple-import-alias
|
||||
import Data.List as L
|
||||
|
||||
#test simple-qualified-import
|
||||
import qualified Data.List
|
||||
|
||||
#test simple-qualified-import-alias
|
||||
import qualified Data.List as L
|
||||
|
||||
#test simple-safe
|
||||
import safe Data.List
|
||||
|
||||
#test simple-source
|
||||
import {-# SOURCE #-} Data.List
|
||||
|
||||
#test simple-safe-qualified
|
||||
import safe qualified Data.List
|
||||
|
||||
#test simple-safe-qualified-source
|
||||
import {-# SOURCE #-} safe qualified Data.List
|
||||
|
||||
#test simple-qualified-package
|
||||
import qualified "base" Data.List
|
||||
|
||||
#test instances-only
|
||||
import qualified Data.List ()
|
||||
|
||||
#test one-element
|
||||
import Data.List (nub)
|
||||
|
||||
#test several-elements
|
||||
import Data.List (nub, foldl', indexElem)
|
||||
|
||||
#test with-things
|
||||
import Test (T, T2(), T3(..), T4(T4), T5(T5, t5))
|
||||
|
||||
#test hiding
|
||||
import Test hiding ()
|
||||
import Test as T hiding ()
|
||||
|
||||
#test horizontal-layout
|
||||
import Data.List (nub)
|
||||
import qualified Data.List as L (foldl')
|
||||
|
||||
import Test (test)
|
||||
import Main hiding
|
||||
( main
|
||||
, test1
|
||||
, test2
|
||||
, test3
|
||||
, test4
|
||||
, test5
|
||||
, test6
|
||||
, test7
|
||||
, test8
|
||||
, test9
|
||||
)
|
||||
|
||||
#test import-with-comments
|
||||
-- Test
|
||||
import Data.List (nub) -- Test
|
||||
{- Test -}
|
||||
import qualified Data.List as L (foldl') {- Test -}
|
||||
|
||||
-- Test
|
||||
import Test (test)
|
||||
|
||||
#test preamble full-preamble
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
|
||||
{-
|
||||
- Test module
|
||||
-}
|
||||
module Test
|
||||
( test1
|
||||
-- ^ test
|
||||
, test2
|
||||
-- | test
|
||||
, test3
|
||||
, test4
|
||||
, test5
|
||||
, test6
|
||||
, test7
|
||||
, test8
|
||||
, test9
|
||||
, test10
|
||||
)
|
||||
where
|
||||
|
||||
-- Test
|
||||
import Data.List (nub) -- Test
|
||||
{- Test -}
|
||||
import qualified Data.List as L (foldl') {- Test -}
|
||||
|
||||
-- Test
|
||||
import Test (test)
|
||||
|
|
|
|||
|
|
@ -33,6 +33,7 @@ import Language.Haskell.Brittany.Internal.LayouterBasics
|
|||
|
||||
import Language.Haskell.Brittany.Internal.Layouters.Type
|
||||
import Language.Haskell.Brittany.Internal.Layouters.Decl
|
||||
import Language.Haskell.Brittany.Internal.Layouters.Module
|
||||
import Language.Haskell.Brittany.Internal.Utils
|
||||
import Language.Haskell.Brittany.Internal.Backend
|
||||
import Language.Haskell.Brittany.Internal.BackendUtils
|
||||
|
|
@ -243,30 +244,8 @@ parsePrintModuleTests conf filename input = do
|
|||
-- else return $ TextL.toStrict $ Text.Builder.toLazyText out
|
||||
|
||||
ppModule :: GenLocated SrcSpan (HsModule RdrName) -> PPM ()
|
||||
ppModule lmod@(L loc m@(HsModule _name _exports _imports decls _ _)) = do
|
||||
let emptyModule = L loc m { hsmodDecls = [] }
|
||||
(anns', post) <- do
|
||||
anns <- mAsk
|
||||
-- evil partiality. but rather unlikely.
|
||||
return $ case Map.lookup (ExactPrint.Types.mkAnnKey lmod) anns of
|
||||
Nothing -> (anns, [])
|
||||
Just mAnn ->
|
||||
let modAnnsDp = ExactPrint.Types.annsDP mAnn
|
||||
isWhere (ExactPrint.Types.G AnnWhere) = True
|
||||
isWhere _ = False
|
||||
isEof (ExactPrint.Types.G AnnEofPos) = True
|
||||
isEof _ = False
|
||||
whereInd = List.findIndex (isWhere . fst) modAnnsDp
|
||||
eofInd = List.findIndex (isEof . fst) modAnnsDp
|
||||
(pre, post) = case (whereInd, eofInd) of
|
||||
(Nothing, Nothing) -> ([], modAnnsDp)
|
||||
(Just i , Nothing) -> List.splitAt (i + 1) modAnnsDp
|
||||
(Nothing, Just _i) -> ([], modAnnsDp)
|
||||
(Just i , Just j ) -> List.splitAt (min (i + 1) j) modAnnsDp
|
||||
mAnn' = mAnn { ExactPrint.Types.annsDP = pre }
|
||||
anns' = Map.insert (ExactPrint.Types.mkAnnKey lmod) mAnn' anns
|
||||
in (anns', post)
|
||||
MultiRWSS.withMultiReader anns' $ processDefault emptyModule
|
||||
ppModule lmod@(L _loc _m@(HsModule _name _exports _ decls _ _)) = do
|
||||
post <- ppPreamble lmod
|
||||
decls `forM_` \decl -> do
|
||||
filteredAnns <- mAsk <&> \annMap ->
|
||||
Map.findWithDefault Map.empty (ExactPrint.Types.mkAnnKey decl) annMap
|
||||
|
|
@ -336,6 +315,51 @@ ppDecl d@(L loc decl) = case decl of
|
|||
layoutBriDoc briDoc
|
||||
_ -> briDocMToPPM (briDocByExactNoComment d) >>= layoutBriDoc
|
||||
|
||||
-- Prints the information associated with the module annotation
|
||||
-- This includes the imports
|
||||
ppPreamble :: GenLocated SrcSpan (HsModule RdrName)
|
||||
-> PPM [(ExactPrint.Types.KeywordId, ExactPrint.Types.DeltaPos)]
|
||||
ppPreamble lmod@(L _ (HsModule _ _ _ _ _ _)) = do
|
||||
filteredAnns <- mAsk <&> \annMap ->
|
||||
Map.findWithDefault Map.empty (ExactPrint.Types.mkAnnKey lmod) annMap
|
||||
-- Since ghc-exactprint adds annotations following (implicit)
|
||||
-- modules to both HsModule and the elements in the module
|
||||
-- this can cause duplication of comments. So strip
|
||||
-- attached annotations that come after the module's where
|
||||
-- from the module node
|
||||
let (filteredAnns', post) =
|
||||
case (ExactPrint.Types.mkAnnKey lmod) `Map.lookup` filteredAnns of
|
||||
Nothing -> (filteredAnns, [])
|
||||
Just mAnn ->
|
||||
let modAnnsDp = ExactPrint.Types.annsDP mAnn
|
||||
isWhere (ExactPrint.Types.G AnnWhere) = True
|
||||
isWhere _ = False
|
||||
isEof (ExactPrint.Types.G AnnEofPos) = True
|
||||
isEof _ = False
|
||||
whereInd = List.findIndex (isWhere . fst) modAnnsDp
|
||||
eofInd = List.findIndex (isEof . fst) modAnnsDp
|
||||
(pre, post') = case (whereInd, eofInd) of
|
||||
(Nothing, Nothing) -> ([], modAnnsDp)
|
||||
(Just i , Nothing) -> List.splitAt (i + 1) modAnnsDp
|
||||
(Nothing, Just _i) -> ([], modAnnsDp)
|
||||
(Just i , Just j ) -> List.splitAt (min (i + 1) j) modAnnsDp
|
||||
mAnn' = mAnn { ExactPrint.Types.annsDP = pre }
|
||||
filteredAnns'' = Map.insert (ExactPrint.Types.mkAnnKey lmod) mAnn' filteredAnns
|
||||
in (filteredAnns'', post')
|
||||
in do
|
||||
traceIfDumpConf "bridoc annotations filtered/transformed"
|
||||
_dconf_dump_annotations
|
||||
$ annsDoc filteredAnns'
|
||||
|
||||
config <- mAsk
|
||||
|
||||
MultiRWSS.withoutMultiReader $ do
|
||||
MultiRWSS.mPutRawR $ config :+: filteredAnns' :+: HNil
|
||||
withTransformedAnns lmod $ do
|
||||
briDoc <- briDocMToPPM $ layoutModule lmod
|
||||
layoutBriDoc briDoc
|
||||
return post
|
||||
|
||||
_sigHead :: Sig RdrName -> String
|
||||
_sigHead = \case
|
||||
TypeSig names _ ->
|
||||
|
|
|
|||
|
|
@ -0,0 +1,70 @@
|
|||
module Language.Haskell.Brittany.Internal.Layouters.IE
|
||||
( layoutIE
|
||||
, layoutIEList
|
||||
)
|
||||
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 (unLoc, runGhc, GenLocated(L), moduleNameString, AnnKeywordId(..))
|
||||
import HsSyn
|
||||
import Name
|
||||
import HsImpExp
|
||||
import FieldLabel
|
||||
import qualified FastString
|
||||
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 "("]
|
||||
++ ( intersperse docCommaSep (map (docLit . lrdrNameToText) ns)
|
||||
++ intersperse docCommaSep (map (prepareFL) fs)
|
||||
)
|
||||
++ [docLit $ Text.pack ")"]
|
||||
IEModuleContents n -> docSeq
|
||||
[ docLit $ Text.pack "module"
|
||||
, docSeparator
|
||||
, docLit . Text.pack . moduleNameString $ unLoc n
|
||||
]
|
||||
_ -> docEmpty
|
||||
|
||||
layoutIEList :: [LIE RdrName] -> ToBriDocM BriDocNumbered
|
||||
layoutIEList lies = do
|
||||
ies <- mapM (docSharedWrapper layoutIE) lies
|
||||
case ies of
|
||||
[] -> docLit $ Text.pack "()"
|
||||
(x:xs) -> docAlt
|
||||
[ docSeq
|
||||
$ [docLit $ Text.pack "(", x]
|
||||
++ map (\x' -> docSeq [docCommaSep, x']) xs
|
||||
++ [docLit $ Text.pack ")"]
|
||||
, docLines
|
||||
( docSeq [docLit $ Text.pack "(", docSeparator, x]
|
||||
: map (\x' -> docSeq [docCommaSep, x']) xs
|
||||
++ [docLit $ Text.pack ")"]
|
||||
)
|
||||
]
|
||||
|
|
@ -0,0 +1,62 @@
|
|||
module Language.Haskell.Brittany.Internal.Layouters.Import (layoutImport) where
|
||||
|
||||
#include "prelude.inc"
|
||||
|
||||
import Language.Haskell.Brittany.Internal.Types
|
||||
import Language.Haskell.Brittany.Internal.LayouterBasics
|
||||
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 HsSyn
|
||||
import Name
|
||||
import HsImpExp
|
||||
import FieldLabel
|
||||
import qualified FastString
|
||||
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
|
||||
pkgNameT = Text.pack . sl_st <$> pkg
|
||||
asT = Text.pack . moduleNameString <$> as
|
||||
sig = ColBindingLine (Just (Text.pack "import"))
|
||||
importQualifiers = docSeq
|
||||
[ appSep $ docLit $ Text.pack "import"
|
||||
, if src then appSep $ docLit $ Text.pack "{-# SOURCE #-}" else docEmpty
|
||||
, if safe then appSep $ docLit $ Text.pack "safe" else docEmpty
|
||||
, if q then appSep $ docLit $ Text.pack "qualified" else docEmpty
|
||||
, fromMaybe docEmpty (appSep . docLit <$> pkgNameT)
|
||||
]
|
||||
makeAs asT' =
|
||||
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)
|
||||
]
|
||||
_ -> docEmpty
|
||||
|
|
@ -0,0 +1,73 @@
|
|||
module Language.Haskell.Brittany.Internal.Layouters.Module (layoutModule) where
|
||||
|
||||
#include "prelude.inc"
|
||||
|
||||
import Language.Haskell.Brittany.Internal.Types
|
||||
import Language.Haskell.Brittany.Internal.LayouterBasics
|
||||
import Language.Haskell.Brittany.Internal.Layouters.IE
|
||||
import Language.Haskell.Brittany.Internal.Layouters.Import
|
||||
import Language.Haskell.Brittany.Internal.Config.Types
|
||||
|
||||
import RdrName (RdrName(..))
|
||||
import GHC (unLoc, runGhc, GenLocated(L), moduleNameString, AnnKeywordId(..))
|
||||
import HsSyn
|
||||
import Name
|
||||
import HsImpExp
|
||||
import FieldLabel
|
||||
import qualified FastString
|
||||
import BasicTypes
|
||||
import Language.Haskell.GHC.ExactPrint as ExactPrint
|
||||
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
|
||||
-- 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
|
||||
)
|
||||
Loading…
Reference in New Issue