Merge pull request #83/#124 from sniperrifle2004/import
commit
f1536b8966
|
@ -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
|
||||
|
|
|
@ -565,3 +565,297 @@ 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
|
||||
-- main
|
||||
, test1
|
||||
, test2
|
||||
-- Test 3
|
||||
, test3
|
||||
, test4
|
||||
-- Test 5
|
||||
, test5
|
||||
-- Test 6
|
||||
)
|
||||
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-things-comment
|
||||
-- comment1
|
||||
|
||||
module Main
|
||||
( Test(Test, a, b)
|
||||
, foo -- comment2
|
||||
) -- comment3
|
||||
where
|
||||
|
||||
#test export-with-empty-thing
|
||||
module Main (Test()) where
|
||||
|
||||
#test empty-with-comment
|
||||
-- Intentionally left empty
|
||||
|
||||
###############################################################################
|
||||
###############################################################################
|
||||
###############################################################################
|
||||
#group module.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 as L
|
||||
|
||||
#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 qualifier-effect
|
||||
import {-# SOURCE #-} safe qualified "base" Data.List as L
|
||||
import {-# SOURCE #-} safe qualified "base" Data.List ( )
|
||||
import {-# SOURCE #-} safe qualified Data.List hiding ( )
|
||||
|
||||
#test instances-only
|
||||
import qualified Data.List ( )
|
||||
|
||||
#test one-element
|
||||
import Data.List ( nub )
|
||||
|
||||
#test several-elements
|
||||
import Data.List ( nub
|
||||
, foldl'
|
||||
, indexElem
|
||||
)
|
||||
|
||||
#test a-ridiculous-amount-of-elements
|
||||
import Test ( Long
|
||||
, list
|
||||
, with
|
||||
, items
|
||||
, that
|
||||
, will
|
||||
, not
|
||||
, quite
|
||||
, fit
|
||||
, onA
|
||||
, single
|
||||
, line
|
||||
, anymore
|
||||
)
|
||||
|
||||
#test with-things
|
||||
import Test ( T
|
||||
, T2()
|
||||
, T3(..)
|
||||
, T4(T4)
|
||||
, T5(T5, t5)
|
||||
, T6((<|>))
|
||||
, (+)
|
||||
)
|
||||
|
||||
#test hiding
|
||||
import Test hiding ( )
|
||||
import Test as T
|
||||
hiding ( )
|
||||
|
||||
#test long-module-name
|
||||
import TestJustShortEnoughModuleNameLikeThisOne ( )
|
||||
import TestJustAbitToLongModuleNameLikeThisOneIs
|
||||
( )
|
||||
|
||||
import TestJustShortEnoughModuleNameLikeThisOn as T
|
||||
import TestJustAbitToLongModuleNameLikeThisOneI
|
||||
as T
|
||||
|
||||
import TestJustShortEnoughModuleNameLike hiding ( )
|
||||
import TestJustAbitToLongModuleNameLikeTh
|
||||
hiding ( )
|
||||
|
||||
import MoreThanSufficientlyLongModuleNameWithSome
|
||||
( items
|
||||
, that
|
||||
, will
|
||||
, not
|
||||
, fit
|
||||
, inA
|
||||
, compact
|
||||
, layout
|
||||
)
|
||||
|
||||
import {-# SOURCE #-} safe qualified "qualifiers" AlsoAff ( )
|
||||
import {-# SOURCE #-} safe qualified "qualifiers" AlsoAffe
|
||||
( )
|
||||
|
||||
import {-# SOURCE #-} safe qualified "qualifiers" AlsoAf as T
|
||||
import {-# SOURCE #-} safe qualified "qualifiers" AlsoAff
|
||||
as T
|
||||
import {-# SOURCE #-} safe qualified "qualifier" A hiding ( )
|
||||
import {-# SOURCE #-} safe qualified "qualifiers" A
|
||||
hiding ( )
|
||||
|
||||
#test import-with-comments
|
||||
-- Test
|
||||
import Data.List ( nub ) -- Test
|
||||
{- Test -}
|
||||
import qualified Data.List as L
|
||||
( foldl' ) {- Test -}
|
||||
|
||||
-- Test
|
||||
import Test ( test )
|
||||
|
||||
#test import-with-comments-2
|
||||
|
||||
import Test ( abc
|
||||
, def
|
||||
-- comment
|
||||
)
|
||||
|
||||
#test import-with-comments-3
|
||||
|
||||
import Test ( abc
|
||||
-- comment
|
||||
)
|
||||
|
||||
#test import-with-comments-4
|
||||
import Test ( abc
|
||||
-- comment
|
||||
, def
|
||||
, ghi
|
||||
{- comment -}
|
||||
, jkl
|
||||
-- comment
|
||||
)
|
||||
|
||||
#test import-with-comments-5
|
||||
import Test ( -- comment
|
||||
)
|
||||
|
||||
#test long-bindings
|
||||
import Test ( longbindingNameThatoverflowsColum
|
||||
)
|
||||
import Test ( Long
|
||||
( List
|
||||
, Of
|
||||
, Things
|
||||
)
|
||||
)
|
||||
|
||||
#test things-with-with-comments
|
||||
import Test ( Thing
|
||||
( -- Comments
|
||||
)
|
||||
)
|
||||
import Test ( Thing
|
||||
( Item
|
||||
-- and Comment
|
||||
)
|
||||
)
|
||||
import Test ( Thing
|
||||
( With
|
||||
-- Comments
|
||||
, and
|
||||
-- also
|
||||
, items
|
||||
-- !
|
||||
)
|
||||
)
|
||||
#test prefer-dense-empty-list
|
||||
import VeryLongModuleNameThatCouldEvenCauseAnEmptyBindingListToExpandIntoMultipleLine
|
||||
( )
|
||||
|
||||
#test preamble full-preamble
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
|
||||
{-
|
||||
- Test module
|
||||
-}
|
||||
module Test
|
||||
( test1
|
||||
-- ^ test
|
||||
, test2
|
||||
-- | test
|
||||
, test3
|
||||
, test4
|
||||
, test5
|
||||
, test6
|
||||
, test7
|
||||
, test8
|
||||
, test9
|
||||
, test10
|
||||
-- Test 10
|
||||
)
|
||||
where
|
||||
|
||||
-- Test
|
||||
import Data.List ( nub ) -- Test
|
||||
{- Test -}
|
||||
import qualified Data.List as L
|
||||
( foldl' ) {- Test -}
|
||||
|
||||
-- Test
|
||||
import Test ( test )
|
||||
|
|
|
@ -169,11 +169,14 @@ defaultTestConfig = Config
|
|||
, _lconfig_indentWhereSpecial = coerce True
|
||||
, _lconfig_indentListSpecial = coerce True
|
||||
, _lconfig_importColumn = coerce (60 :: Int)
|
||||
, _lconfig_importAsColumn = coerce (60 :: Int)
|
||||
, _lconfig_altChooser = coerce $ AltChooserBoundedSearch 3
|
||||
, _lconfig_columnAlignMode = coerce (ColumnAlignModeMajority 0.7)
|
||||
, _lconfig_alignmentLimit = coerce (30 :: Int)
|
||||
, _lconfig_alignmentBreakOnMultiline = coerce True
|
||||
, _lconfig_hangingTypeSignature = coerce False
|
||||
, _lconfig_reformatModulePreamble = coerce True
|
||||
, _lconfig_allowSingleLineExportList = coerce True
|
||||
}
|
||||
, _conf_errorHandling = (_conf_errorHandling staticDefaultConfig)
|
||||
{ _econf_omit_output_valid_check = coerce True
|
||||
|
|
|
@ -598,6 +598,259 @@ 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
|
||||
-- main
|
||||
, test1
|
||||
, test2
|
||||
-- Test 3
|
||||
, test3
|
||||
, test4
|
||||
-- Test 5
|
||||
, test5
|
||||
-- Test 6
|
||||
)
|
||||
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 as L
|
||||
|
||||
#test simple-source
|
||||
import {-# SOURCE #-} Data.List ()
|
||||
|
||||
#test simple-safe-qualified
|
||||
import safe qualified Data.List hiding (nub)
|
||||
|
||||
#test simple-safe-qualified-source
|
||||
import {-# SOURCE #-} safe qualified Data.List
|
||||
|
||||
#test simple-qualified-package
|
||||
import qualified "base" Data.List
|
||||
|
||||
#test qualifier-effect
|
||||
import {-# SOURCE #-} safe qualified "base" Data.List as L
|
||||
import {-# SOURCE #-} safe qualified "base" Data.List ()
|
||||
import {-# SOURCE #-} safe qualified Data.List hiding ()
|
||||
|
||||
#test instances-only
|
||||
import qualified Data.List ()
|
||||
|
||||
#test one-element
|
||||
import Data.List (nub)
|
||||
|
||||
#test several-elements
|
||||
import Data.List (nub, foldl', indexElem)
|
||||
|
||||
#test a-ridiculous-amount-of-elements
|
||||
import Test
|
||||
( Long
|
||||
, list
|
||||
, with
|
||||
, items
|
||||
, that
|
||||
, will
|
||||
, not
|
||||
, quite
|
||||
, fit
|
||||
, onA
|
||||
, single
|
||||
, line
|
||||
, anymore
|
||||
)
|
||||
|
||||
#test with-things
|
||||
import Test (T, T2(), T3(..), T4(T4), T5(T5, t5), T6((<|>)), (+))
|
||||
|
||||
#test hiding
|
||||
import Test hiding ()
|
||||
import Test as T hiding ()
|
||||
|
||||
#test long-module-name
|
||||
import TestJustShortEnoughModuleNameLikeThisOne ()
|
||||
import TestJustAbitToLongModuleNameLikeThisOneIs ()
|
||||
import TestJustShortEnoughModuleNameLikeThisOn as T
|
||||
import TestJustAbitToLongModuleNameLikeThisOneI as T
|
||||
import TestJustShortEnoughModuleNameLike hiding ()
|
||||
import TestJustAbitToLongModuleNameLikeTh hiding ()
|
||||
import MoreThanSufficientlyLongModuleNameWithSome
|
||||
(items, that, will, not, fit, inA, compact, layout)
|
||||
|
||||
#test import-with-comments
|
||||
-- Test
|
||||
import Data.List (nub) -- Test
|
||||
{- Test -}
|
||||
import qualified Data.List as L (foldl') {- Test -}
|
||||
|
||||
#test import-with-comments-2
|
||||
|
||||
import Test
|
||||
( abc
|
||||
, def
|
||||
-- comment
|
||||
)
|
||||
|
||||
#test import-with-comments-3
|
||||
|
||||
import Test
|
||||
( abc
|
||||
-- comment
|
||||
)
|
||||
|
||||
#test import-with-comments-4
|
||||
import Test
|
||||
( abc
|
||||
-- comment
|
||||
, def
|
||||
, ghi
|
||||
{- comment -}
|
||||
, jkl
|
||||
-- comment
|
||||
)
|
||||
|
||||
-- Test
|
||||
import Test (test)
|
||||
|
||||
#test import-with-comments-5
|
||||
import Test
|
||||
( -- comment
|
||||
)
|
||||
|
||||
#test long-bindings
|
||||
import Test (longbindingNameThatoverflowsColum)
|
||||
import Test (Long(List, Of, Things))
|
||||
|
||||
#test things-with-with-comments
|
||||
import Test
|
||||
( Thing
|
||||
( With
|
||||
-- Comments
|
||||
, and
|
||||
-- also
|
||||
, items
|
||||
-- !
|
||||
)
|
||||
)
|
||||
import Test
|
||||
( Thing
|
||||
( Item
|
||||
-- and Comment
|
||||
)
|
||||
)
|
||||
import Test
|
||||
( Thing
|
||||
( With
|
||||
-- Comments
|
||||
, and
|
||||
-- also
|
||||
, items
|
||||
-- !
|
||||
)
|
||||
)
|
||||
|
||||
#test prefer-dense-empty-list
|
||||
import VeryLongModuleNameThatCouldEvenCauseAnEmptyBindingListToExpandIntoMultipleLine
|
||||
()
|
||||
|
||||
#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)
|
||||
|
||||
###############################################################################
|
||||
###############################################################################
|
||||
|
@ -1133,4 +1386,3 @@ foo =
|
|||
## ]
|
||||
## where
|
||||
## role = stringProperty "WM_WINDOW_ROLE"
|
||||
|
||||
|
|
|
@ -51,11 +51,14 @@ defaultTestConfig = Config
|
|||
, _lconfig_indentWhereSpecial = coerce True
|
||||
, _lconfig_indentListSpecial = coerce True
|
||||
, _lconfig_importColumn = coerce (60 :: Int)
|
||||
, _lconfig_importAsColumn = coerce (60 :: Int)
|
||||
, _lconfig_altChooser = coerce $ AltChooserBoundedSearch 3
|
||||
, _lconfig_columnAlignMode = coerce (ColumnAlignModeMajority 0.7)
|
||||
, _lconfig_alignmentLimit = coerce (30 :: Int)
|
||||
, _lconfig_alignmentBreakOnMultiline = coerce True
|
||||
, _lconfig_hangingTypeSignature = coerce False
|
||||
, _lconfig_reformatModulePreamble = coerce True
|
||||
, _lconfig_allowSingleLineExportList = coerce True
|
||||
}
|
||||
, _conf_errorHandling = (_conf_errorHandling staticDefaultConfig)
|
||||
{ _econf_ExactPrintFallback = coerce ExactPrintFallbackModeNever
|
||||
|
|
|
@ -16,7 +16,7 @@ where
|
|||
#include "prelude.inc"
|
||||
|
||||
import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
|
||||
import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
|
||||
import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint
|
||||
import qualified Language.Haskell.GHC.ExactPrint.Parsers as ExactPrint.Parsers
|
||||
|
||||
import Data.Data
|
||||
|
@ -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
|
||||
|
@ -132,7 +133,7 @@ parsePrintModule configRaw inputText = runExceptT $ do
|
|||
-- can occur.
|
||||
pPrintModule
|
||||
:: Config
|
||||
-> ExactPrint.Types.Anns
|
||||
-> ExactPrint.Anns
|
||||
-> GHC.ParsedSource
|
||||
-> ([BrittanyError], TextL.Text)
|
||||
pPrintModule conf anns parsedModule =
|
||||
|
@ -160,7 +161,7 @@ pPrintModule conf anns parsedModule =
|
|||
in
|
||||
tracer $ (errs, Text.Builder.toLazyText out)
|
||||
-- unless () $ do
|
||||
--
|
||||
--
|
||||
-- debugStrings `forM_` \s ->
|
||||
-- trace s $ return ()
|
||||
|
||||
|
@ -168,7 +169,7 @@ pPrintModule conf anns parsedModule =
|
|||
-- if it does not.
|
||||
pPrintModuleAndCheck
|
||||
:: Config
|
||||
-> ExactPrint.Types.Anns
|
||||
-> ExactPrint.Anns
|
||||
-> GHC.ParsedSource
|
||||
-> IO ([BrittanyError], TextL.Text)
|
||||
pPrintModuleAndCheck conf anns parsedModule = do
|
||||
|
@ -248,33 +249,11 @@ 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
|
||||
Map.findWithDefault Map.empty (ExactPrint.mkAnnKey decl) annMap
|
||||
|
||||
traceIfDumpConf "bridoc annotations filtered/transformed"
|
||||
_dconf_dump_annotations
|
||||
|
@ -287,26 +266,26 @@ ppModule lmod@(L loc m@(HsModule _name _exports _imports decls _ _)) = do
|
|||
ppDecl decl
|
||||
let finalComments = filter
|
||||
( fst .> \case
|
||||
ExactPrint.Types.AnnComment{} -> True
|
||||
ExactPrint.AnnComment{} -> True
|
||||
_ -> False
|
||||
)
|
||||
post
|
||||
post `forM_` \case
|
||||
(ExactPrint.Types.AnnComment (ExactPrint.Types.Comment cmStr _ _), l) -> do
|
||||
(ExactPrint.AnnComment (ExactPrint.Comment cmStr _ _), l) -> do
|
||||
ppmMoveToExactLoc l
|
||||
mTell $ Text.Builder.fromString cmStr
|
||||
(ExactPrint.Types.G AnnEofPos, (ExactPrint.Types.DP (eofX, eofY))) ->
|
||||
(ExactPrint.G AnnEofPos, (ExactPrint.DP (eofZ, eofX))) ->
|
||||
let
|
||||
folder (acc, _) (kw, ExactPrint.Types.DP (x, y)) = case kw of
|
||||
ExactPrint.Types.AnnComment cm
|
||||
| GHC.RealSrcSpan span <- ExactPrint.Types.commentIdentifier cm
|
||||
-> ( acc + x + GHC.srcSpanEndLine span - GHC.srcSpanStartLine span
|
||||
, y + GHC.srcSpanEndCol span - GHC.srcSpanStartCol span
|
||||
folder (acc, _) (kw, ExactPrint.DP (y, x)) = case kw of
|
||||
ExactPrint.AnnComment cm
|
||||
| GHC.RealSrcSpan span <- ExactPrint.commentIdentifier cm
|
||||
-> ( acc + y + GHC.srcSpanEndLine span - GHC.srcSpanStartLine span
|
||||
, x + GHC.srcSpanEndCol span - GHC.srcSpanStartCol span
|
||||
)
|
||||
_ -> (acc + x, y)
|
||||
(cmX, cmY) = foldl' folder (0, 0) finalComments
|
||||
_ -> (acc + y, x)
|
||||
(cmY, cmX) = foldl' folder (0, 0) finalComments
|
||||
in
|
||||
ppmMoveToExactLoc $ ExactPrint.Types.DP (eofX - cmX, eofY - cmY)
|
||||
ppmMoveToExactLoc $ ExactPrint.DP (eofZ - cmY, eofX - cmX)
|
||||
_ -> return ()
|
||||
|
||||
withTransformedAnns :: Data ast => ast -> PPMLocal () -> PPMLocal ()
|
||||
|
@ -341,6 +320,76 @@ 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.KeywordId, ExactPrint.DeltaPos)]
|
||||
ppPreamble lmod@(L loc m@(HsModule _ _ _ _ _ _)) = do
|
||||
filteredAnns <- mAsk <&> \annMap ->
|
||||
Map.findWithDefault Map.empty (ExactPrint.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
|
||||
config <- mAsk
|
||||
let shouldReformatPreamble =
|
||||
config & _conf_layout & _lconfig_reformatModulePreamble & confUnpack
|
||||
|
||||
let
|
||||
(filteredAnns', post) =
|
||||
case (ExactPrint.mkAnnKey lmod) `Map.lookup` filteredAnns of
|
||||
Nothing -> (filteredAnns, [])
|
||||
Just mAnn ->
|
||||
let
|
||||
modAnnsDp = ExactPrint.annsDP mAnn
|
||||
isWhere (ExactPrint.G AnnWhere) = True
|
||||
isWhere _ = False
|
||||
isEof (ExactPrint.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
|
||||
findInitialCommentSize = \case
|
||||
((ExactPrint.AnnComment cm, ExactPrint.DP (y, _)) : rest) ->
|
||||
let GHC.RealSrcSpan span = ExactPrint.commentIdentifier cm
|
||||
in y
|
||||
+ GHC.srcSpanEndLine span
|
||||
- GHC.srcSpanStartLine span
|
||||
+ findInitialCommentSize rest
|
||||
_ -> 0
|
||||
initialCommentSize = findInitialCommentSize pre
|
||||
fixAbsoluteModuleDP = \case
|
||||
(g@(ExactPrint.G AnnModule), ExactPrint.DP (y, x)) ->
|
||||
(g, ExactPrint.DP (y - initialCommentSize, x))
|
||||
x -> x
|
||||
pre' = if shouldReformatPreamble
|
||||
then map fixAbsoluteModuleDP pre
|
||||
else pre
|
||||
mAnn' = mAnn { ExactPrint.annsDP = pre' }
|
||||
filteredAnns'' =
|
||||
Map.insert (ExactPrint.mkAnnKey lmod) mAnn' filteredAnns
|
||||
in
|
||||
(filteredAnns'', post')
|
||||
traceIfDumpConf "bridoc annotations filtered/transformed"
|
||||
_dconf_dump_annotations
|
||||
$ annsDoc filteredAnns'
|
||||
|
||||
if shouldReformatPreamble
|
||||
then MultiRWSS.withoutMultiReader $ do
|
||||
MultiRWSS.mPutRawR $ config :+: filteredAnns' :+: HNil
|
||||
withTransformedAnns lmod $ do
|
||||
briDoc <- briDocMToPPM $ layoutModule lmod
|
||||
layoutBriDoc briDoc
|
||||
else
|
||||
let emptyModule = L loc m { hsmodDecls = [] }
|
||||
in MultiRWSS.withMultiReader filteredAnns' $ processDefault emptyModule
|
||||
return post
|
||||
|
||||
_sigHead :: Sig RdrName -> String
|
||||
_sigHead = \case
|
||||
TypeSig names _ ->
|
||||
|
@ -391,7 +440,7 @@ layoutBriDoc briDoc = do
|
|||
-- simpl <- mGet <&> transformToSimple
|
||||
-- return simpl
|
||||
|
||||
anns :: ExactPrint.Types.Anns <- mAsk
|
||||
anns :: ExactPrint.Anns <- mAsk
|
||||
|
||||
let state = LayoutState
|
||||
{ _lstate_baseYs = [0]
|
||||
|
|
|
@ -250,6 +250,23 @@ layoutBriDocM = \case
|
|||
-- layoutMoveToIndentCol y
|
||||
layoutWriteAppendMultiline $ Text.pack $ comment
|
||||
-- mModify $ \s -> s { _lstate_curYOrAddNewline = Right 0 }
|
||||
BDMoveToKWDP annKey keyword bd -> do
|
||||
mDP <- do
|
||||
state <- mGet
|
||||
let m = _lstate_comments state
|
||||
let mAnn = ExactPrint.annsDP <$> Map.lookup annKey m
|
||||
let relevant = [ dp
|
||||
| Just ann <- [mAnn]
|
||||
, (ExactPrint.Types.G kw1, dp) <- ann
|
||||
, keyword == kw1
|
||||
]
|
||||
pure $ case relevant of
|
||||
[] -> Nothing
|
||||
(dp:_) -> Just dp
|
||||
case mDP of
|
||||
Nothing -> pure ()
|
||||
Just (ExactPrint.Types.DP (y, x)) -> layoutMoveToCommentPos y x
|
||||
layoutBriDocM bd
|
||||
BDNonBottomSpacing bd -> layoutBriDocM bd
|
||||
BDSetParSpacing bd -> layoutBriDocM bd
|
||||
BDForceParSpacing bd -> layoutBriDocM bd
|
||||
|
@ -282,6 +299,7 @@ briDocLineLength briDoc = flip StateS.evalState False $ rec briDoc
|
|||
BDAnnotationPrior _ bd -> rec bd
|
||||
BDAnnotationKW _ _ bd -> rec bd
|
||||
BDAnnotationRest _ bd -> rec bd
|
||||
BDMoveToKWDP _ _ bd -> rec bd
|
||||
BDLines ls@(_:_) -> do
|
||||
x <- StateS.get
|
||||
return $ maximum $ ls <&> \l -> StateS.evalState (rec l) x
|
||||
|
@ -317,6 +335,7 @@ briDocIsMultiLine briDoc = rec briDoc
|
|||
BDAnnotationPrior _ bd -> rec bd
|
||||
BDAnnotationKW _ _ bd -> rec bd
|
||||
BDAnnotationRest _ bd -> rec bd
|
||||
BDMoveToKWDP _ _ bd -> rec bd
|
||||
BDLines (_:_:_) -> True
|
||||
BDLines [_ ] -> False
|
||||
BDLines [] -> error "briDocIsMultiLine BDLines []"
|
||||
|
|
|
@ -65,12 +65,15 @@ staticDefaultConfig = Config
|
|||
, _lconfig_indentAmount = coerce (2 :: Int)
|
||||
, _lconfig_indentWhereSpecial = coerce True
|
||||
, _lconfig_indentListSpecial = coerce True
|
||||
, _lconfig_importColumn = coerce (60 :: Int)
|
||||
, _lconfig_importColumn = coerce (50 :: Int)
|
||||
, _lconfig_importAsColumn = coerce (50 :: Int)
|
||||
, _lconfig_altChooser = coerce (AltChooserBoundedSearch 3)
|
||||
, _lconfig_columnAlignMode = coerce (ColumnAlignModeMajority 0.7)
|
||||
, _lconfig_alignmentLimit = coerce (30 :: Int)
|
||||
, _lconfig_alignmentBreakOnMultiline = coerce True
|
||||
, _lconfig_hangingTypeSignature = coerce False
|
||||
, _lconfig_reformatModulePreamble = coerce True
|
||||
, _lconfig_allowSingleLineExportList = coerce False
|
||||
}
|
||||
, _conf_errorHandling = ErrorHandlingConfig
|
||||
{ _econf_produceOutputOnErrors = coerce False
|
||||
|
@ -111,6 +114,7 @@ configParser = do
|
|||
ind <- addFlagReadParams "" ["indent"] "AMOUNT" (flagHelpStr "spaces per indentation level")
|
||||
cols <- addFlagReadParams "" ["columns"] "AMOUNT" (flagHelpStr "target max columns (80 is an old default for this)")
|
||||
importCol <- addFlagReadParams "" ["import-col"] "N" (flagHelpStr "column to align import lists at")
|
||||
importAsCol <- addFlagReadParams "" ["import-as-col"] "N" (flagHelpStr "column to qualified-as module names at")
|
||||
|
||||
dumpConfig <- addSimpleBoolFlag "" ["dump-config"] (flagHelp $ parDoc "dump the programs full config (merged commandline + file + defaults)")
|
||||
dumpAnnotations <- addSimpleBoolFlag "" ["dump-annotations"] (flagHelp $ parDoc "dump the full annotations returned by ghc-exactprint")
|
||||
|
@ -160,11 +164,14 @@ configParser = do
|
|||
, _lconfig_indentWhereSpecial = mempty -- falseToNothing _
|
||||
, _lconfig_indentListSpecial = mempty -- falseToNothing _
|
||||
, _lconfig_importColumn = optionConcat importCol
|
||||
, _lconfig_importAsColumn = optionConcat importAsCol
|
||||
, _lconfig_altChooser = mempty
|
||||
, _lconfig_columnAlignMode = mempty
|
||||
, _lconfig_alignmentLimit = mempty
|
||||
, _lconfig_alignmentBreakOnMultiline = mempty
|
||||
, _lconfig_hangingTypeSignature = mempty
|
||||
, _lconfig_reformatModulePreamble = mempty
|
||||
, _lconfig_allowSingleLineExportList = mempty
|
||||
}
|
||||
, _conf_errorHandling = ErrorHandlingConfig
|
||||
{ _econf_produceOutputOnErrors = wrapLast $ falseToNothing outputOnErrors
|
||||
|
|
|
@ -53,7 +53,12 @@ data CLayoutConfig f = LayoutConfig
|
|||
, _lconfig_indentListSpecial :: f (Last Bool) -- use some special indentation for ","
|
||||
-- when creating zero-indentation
|
||||
-- multi-line list literals.
|
||||
, _lconfig_importColumn :: f (Last Int)
|
||||
, _lconfig_importColumn :: f (Last Int)
|
||||
-- ^ for import statement layouting, column at which to align the
|
||||
-- elements to be imported from a module.
|
||||
, _lconfig_importAsColumn :: f (Last Int)
|
||||
-- ^ for import statement layouting, column at which put the module's
|
||||
-- "as" name (which also affects the positioning of the "as" keyword).
|
||||
, _lconfig_altChooser :: f (Last AltChooser)
|
||||
, _lconfig_columnAlignMode :: f (Last ColumnAlignMode)
|
||||
, _lconfig_alignmentLimit :: f (Last Int)
|
||||
|
@ -84,6 +89,21 @@ data CLayoutConfig f = LayoutConfig
|
|||
-- -> SomeLongStuff
|
||||
-- As usual for hanging indentation, the result will be
|
||||
-- context-sensitive (in the function name).
|
||||
, _lconfig_reformatModulePreamble :: f (Last Bool)
|
||||
-- whether the module preamble/header (module keyword, name, export list,
|
||||
-- import statements) are reformatted. If false, only the elements of the
|
||||
-- module (everything past the "where") are reformatted.
|
||||
, _lconfig_allowSingleLineExportList :: f (Last Bool)
|
||||
-- if true, and it fits in a single line, and there are no comments in the
|
||||
-- export list, the following layout will be used:
|
||||
-- > module MyModule (abc, def) where
|
||||
-- > [stuff]
|
||||
-- otherwise, the multi-line version is used:
|
||||
-- > module MyModule
|
||||
-- > ( abc
|
||||
-- > , def
|
||||
-- > )
|
||||
-- > where
|
||||
}
|
||||
deriving (Generic)
|
||||
|
||||
|
|
|
@ -17,6 +17,7 @@ module Language.Haskell.Brittany.Internal.LayouterBasics
|
|||
, docSeq
|
||||
, docPar
|
||||
, docNodeAnnKW
|
||||
, docNodeMoveToKWDP
|
||||
, docWrapNode
|
||||
, docWrapNodePrior
|
||||
, docWrapNodeRest
|
||||
|
@ -30,6 +31,7 @@ module Language.Haskell.Brittany.Internal.LayouterBasics
|
|||
, docAnnotationPrior
|
||||
, docAnnotationKW
|
||||
, docAnnotationRest
|
||||
, docMoveToKWDP
|
||||
, docNonBottomSpacing
|
||||
, docSetParSpacing
|
||||
, docForceParSpacing
|
||||
|
@ -43,6 +45,7 @@ module Language.Haskell.Brittany.Internal.LayouterBasics
|
|||
, appSep
|
||||
, docCommaSep
|
||||
, docParenLSep
|
||||
, docParenR
|
||||
, docTick
|
||||
, spacifyDocs
|
||||
, briDocMToPPM
|
||||
|
@ -462,6 +465,13 @@ docAnnotationKW
|
|||
-> ToBriDocM BriDocNumbered
|
||||
docAnnotationKW annKey kw bdm = allocateNode . BDFAnnotationKW annKey kw =<< bdm
|
||||
|
||||
docMoveToKWDP
|
||||
:: AnnKey
|
||||
-> AnnKeywordId
|
||||
-> ToBriDocM BriDocNumbered
|
||||
-> ToBriDocM BriDocNumbered
|
||||
docMoveToKWDP annKey kw bdm = allocateNode . BDFMoveToKWDP annKey kw =<< bdm
|
||||
|
||||
docAnnotationRest
|
||||
:: AnnKey -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
|
||||
docAnnotationRest annKey bdm = allocateNode . BDFAnnotationRest annKey =<< bdm
|
||||
|
@ -487,6 +497,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 "'"
|
||||
|
||||
|
@ -499,6 +512,15 @@ docNodeAnnKW
|
|||
docNodeAnnKW ast kw bdm =
|
||||
docAnnotationKW (ExactPrint.Types.mkAnnKey ast) kw bdm
|
||||
|
||||
docNodeMoveToKWDP
|
||||
:: Data.Data.Data ast
|
||||
=> Located ast
|
||||
-> AnnKeywordId
|
||||
-> ToBriDocM BriDocNumbered
|
||||
-> ToBriDocM BriDocNumbered
|
||||
docNodeMoveToKWDP ast kw bdm =
|
||||
docMoveToKWDP (ExactPrint.Types.mkAnnKey ast) kw bdm
|
||||
|
||||
class DocWrapable a where
|
||||
docWrapNode :: ( Data.Data.Data ast)
|
||||
=> Located ast
|
||||
|
|
|
@ -0,0 +1,145 @@
|
|||
module Language.Haskell.Brittany.Internal.Layouters.IE
|
||||
( layoutIE
|
||||
, layoutLLIEs
|
||||
, layoutAnnAndSepLLIEs
|
||||
)
|
||||
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(..)
|
||||
, Located
|
||||
)
|
||||
import HsSyn
|
||||
import Name
|
||||
import HsImpExp
|
||||
import FieldLabel
|
||||
import qualified FastString
|
||||
import BasicTypes
|
||||
|
||||
import Language.Haskell.Brittany.Internal.Utils
|
||||
|
||||
|
||||
|
||||
#if MIN_VERSION_ghc(8,2,0)
|
||||
prepareName :: LIEWrappedName name -> Located name
|
||||
prepareName = ieLWrappedName
|
||||
#else
|
||||
prepareName :: Located name -> Located name
|
||||
prepareName = id
|
||||
#endif
|
||||
|
||||
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 _ -> do
|
||||
hasComments <- hasAnyCommentsBelow lie
|
||||
docAltFilter
|
||||
[ ( not hasComments
|
||||
, docSeq
|
||||
$ [ien, docLit $ Text.pack "("]
|
||||
++ intersperse docCommaSep (map nameDoc ns)
|
||||
++ [docParenR]
|
||||
)
|
||||
, (otherwise
|
||||
, docAddBaseY BrIndentRegular
|
||||
$ docPar ien (layoutItems (splitFirstLast ns))
|
||||
)
|
||||
]
|
||||
where
|
||||
nameDoc = (docLit =<<) . lrdrNameToTextAnn . prepareName
|
||||
layoutItem n = docSeq [docCommaSep, docWrapNode n $ nameDoc n]
|
||||
layoutItems FirstLastEmpty =
|
||||
docSetBaseY $
|
||||
docLines [docSeq [docParenLSep, docWrapNodeRest lie docEmpty]
|
||||
,docParenR
|
||||
]
|
||||
layoutItems (FirstLastSingleton n) =
|
||||
docSetBaseY $ docLines
|
||||
[docSeq [docParenLSep, docWrapNodeRest lie $ nameDoc n], docParenR]
|
||||
layoutItems (FirstLast n1 nMs nN) =
|
||||
docSetBaseY $ docLines $
|
||||
[docSeq [docParenLSep, docWrapNode n1 $ nameDoc n1]]
|
||||
++ map layoutItem nMs
|
||||
++ [ docSeq [docCommaSep, docWrapNodeRest lie $ nameDoc nN]
|
||||
, docParenR
|
||||
]
|
||||
IEModuleContents n -> docSeq
|
||||
[ docLit $ Text.pack "module"
|
||||
, docSeparator
|
||||
, docLit . Text.pack . moduleNameString $ unLoc n
|
||||
]
|
||||
_ -> docEmpty
|
||||
where ien = docLit =<< lrdrNameToTextAnn (ieName <$> lie)
|
||||
|
||||
-- Helper function to deal with Located lists of LIEs.
|
||||
-- In particular this will also associate documentation
|
||||
-- from the located list that actually belongs to the last IE.
|
||||
-- It also adds docCommaSep to all but the first element
|
||||
-- This configuration allows both vertical and horizontal
|
||||
-- handling of the resulting list. Adding parens is
|
||||
-- left to the caller since that is context sensitive
|
||||
layoutAnnAndSepLLIEs
|
||||
:: Located [LIE RdrName] -> ToBriDocM [ToBriDocM BriDocNumbered]
|
||||
layoutAnnAndSepLLIEs llies@(L _ lies) = do
|
||||
let makeIENode ie = docSeq [docCommaSep, ie]
|
||||
let ieDocs = layoutIE <$> lies
|
||||
ieCommaDocs <-
|
||||
docWrapNodeRest llies $ sequence $ case splitFirstLast ieDocs of
|
||||
FirstLastEmpty -> []
|
||||
FirstLastSingleton ie -> [ie]
|
||||
FirstLast ie1 ieMs ieN ->
|
||||
[ie1] ++ map makeIENode ieMs ++ [makeIENode ieN]
|
||||
pure $ fmap pure ieCommaDocs -- returned shared nodes
|
||||
|
||||
-- Builds a complete layout for the given located
|
||||
-- list of LIEs. The layout provides two alternatives:
|
||||
-- (item, item, ..., item)
|
||||
-- ( item
|
||||
-- , item
|
||||
-- ...
|
||||
-- , item
|
||||
-- )
|
||||
-- If the llies contains comments the list will
|
||||
-- always expand over multiple lines, even when empty:
|
||||
-- () -- no comments
|
||||
-- ( -- a comment
|
||||
-- )
|
||||
layoutLLIEs :: Bool -> Located [LIE RdrName] -> ToBriDocM BriDocNumbered
|
||||
layoutLLIEs enableSingleline llies = do
|
||||
ieDs <- layoutAnnAndSepLLIEs llies
|
||||
hasComments <- hasAnyCommentsBelow llies
|
||||
case ieDs of
|
||||
[] -> docAltFilter
|
||||
[ (not hasComments, docLit $ Text.pack "()")
|
||||
, ( hasComments
|
||||
, docPar (docSeq [docParenLSep, docWrapNodeRest llies docEmpty])
|
||||
docParenR
|
||||
)
|
||||
]
|
||||
(ieDsH:ieDsT) -> docAltFilter
|
||||
[ ( not hasComments && enableSingleline
|
||||
, docSeq
|
||||
$ [docLit (Text.pack "(")]
|
||||
++ (docForceSingleline <$> ieDs)
|
||||
++ [docParenR]
|
||||
)
|
||||
, ( otherwise
|
||||
, docPar (docSetBaseY $ docSeq [docParenLSep, ieDsH])
|
||||
$ docLines
|
||||
$ ieDsT
|
||||
++ [docParenR]
|
||||
)
|
||||
]
|
|
@ -0,0 +1,147 @@
|
|||
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
|
||||
, GenLocated(L)
|
||||
, moduleNameString
|
||||
, Located
|
||||
)
|
||||
import HsSyn
|
||||
import Name
|
||||
import FieldLabel
|
||||
import qualified FastString
|
||||
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 mas mllies -> do
|
||||
importCol <- mAsk <&> _conf_layout .> _lconfig_importColumn .> confUnpack
|
||||
importAsCol <- mAsk <&> _conf_layout .> _lconfig_importAsColumn .> confUnpack
|
||||
indentPolicy <- mAsk <&> _conf_layout .> _lconfig_indentPolicy .> confUnpack
|
||||
let
|
||||
compact = indentPolicy == IndentPolicyLeft
|
||||
modNameT = Text.pack $ moduleNameString modName
|
||||
pkgNameT = Text.pack . prepPkg . sl_st <$> pkg
|
||||
masT = Text.pack . moduleNameString . prepModName <$> mas
|
||||
hiding = maybe False fst mllies
|
||||
minQLength = length "import qualified "
|
||||
qLengthReal =
|
||||
let qualifiedPart = if q then length "qualified " else 0
|
||||
safePart = if safe then length "safe " else 0
|
||||
pkgPart = maybe 0 ((+ 1) . Text.length) pkgNameT
|
||||
srcPart = if src then length "{-# SOURCE #-} " else 0
|
||||
in length "import " + srcPart + safePart + qualifiedPart + pkgPart
|
||||
qLength = max minQLength qLengthReal
|
||||
-- Cost in columns of importColumn
|
||||
asCost = length "as "
|
||||
bindingCost = if hiding then length "hiding ( " else length "( "
|
||||
nameCost = Text.length modNameT + qLength
|
||||
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
|
||||
, maybe docEmpty (appSep . docLit) pkgNameT
|
||||
]
|
||||
indentName =
|
||||
if compact then id else docEnsureIndent (BrIndentSpecial qLength)
|
||||
modNameD =
|
||||
indentName $ appSep $ docLit modNameT
|
||||
hidDoc =
|
||||
if hiding then appSep $ docLit $ Text.pack "hiding" else docEmpty
|
||||
importHead = docSeq [importQualifiers, modNameD]
|
||||
bindingsD = case mllies of
|
||||
Nothing -> docEmpty
|
||||
Just (_, llies) -> do
|
||||
hasComments <- hasAnyCommentsBelow llies
|
||||
if compact
|
||||
then docSeq [hidDoc, layoutLLIEs True llies]
|
||||
else do
|
||||
ieDs <- layoutAnnAndSepLLIEs llies
|
||||
docWrapNodeRest llies $ case ieDs of
|
||||
-- ..[hiding].( )
|
||||
[] -> if hasComments
|
||||
then docPar
|
||||
(docSeq [hidDoc, docParenLSep, docWrapNode llies docEmpty])
|
||||
docParenR
|
||||
else docSeq [hidDoc, docParenLSep, docSeparator, docParenR]
|
||||
-- ..[hiding].( b )
|
||||
[ieD] -> docAltFilter
|
||||
[ ( not hasComments
|
||||
, docSeq
|
||||
[ hidDoc
|
||||
, docParenLSep
|
||||
, docForceSingleline $ ieD
|
||||
, docSeparator
|
||||
, docParenR
|
||||
]
|
||||
)
|
||||
, ( otherwise
|
||||
, docPar
|
||||
(docSeq [hidDoc, docParenLSep, docNonBottomSpacing ieD])
|
||||
docParenR
|
||||
)
|
||||
]
|
||||
-- ..[hiding].( b
|
||||
-- , b'
|
||||
-- )
|
||||
(ieD:ieDs') ->
|
||||
docPar (docSeq [hidDoc, docSetBaseY $ docSeq [docParenLSep, ieD]])
|
||||
$ docLines
|
||||
$ ieDs'
|
||||
++ [docParenR]
|
||||
bindingLine =
|
||||
docEnsureIndent (BrIndentSpecial (importCol - bindingCost)) bindingsD
|
||||
makeAsDoc asT =
|
||||
docSeq [appSep $ docLit $ Text.pack "as", appSep $ docLit asT]
|
||||
if compact
|
||||
then
|
||||
let asDoc = maybe docEmpty makeAsDoc masT
|
||||
in docAlt
|
||||
[ docForceSingleline $ docSeq [importHead, asDoc, bindingsD]
|
||||
, docAddBaseY BrIndentRegular $
|
||||
docPar (docSeq [importHead, asDoc]) bindingsD
|
||||
]
|
||||
else
|
||||
case masT of
|
||||
Just n | enoughRoom -> docLines [docSeq [importHead, asDoc], bindingLine]
|
||||
| otherwise -> docLines [importHead, asDoc, bindingLine]
|
||||
where
|
||||
enoughRoom = nameCost < importAsCol - asCost
|
||||
asDoc =
|
||||
docEnsureIndent (BrIndentSpecial (importAsCol - asCost))
|
||||
$ makeAsDoc n
|
||||
Nothing | enoughRoom -> docSeq [importHead, bindingLine]
|
||||
| otherwise -> docLines [importHead, bindingLine]
|
||||
where enoughRoom = nameCost < importCol - bindingCost
|
||||
_ -> docEmpty
|
|
@ -0,0 +1,62 @@
|
|||
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') = case mod' of
|
||||
-- Implicit module Main
|
||||
HsModule Nothing _ imports _ _ _ -> docLines $ map layoutImport imports
|
||||
HsModule (Just n) les imports _ _ _ -> do
|
||||
let tn = Text.pack $ moduleNameString $ unLoc n
|
||||
allowSingleLineExportList <- mAsk
|
||||
<&> _conf_layout
|
||||
.> _lconfig_allowSingleLineExportList
|
||||
.> confUnpack
|
||||
docLines
|
||||
$ docSeq
|
||||
[ docNodeAnnKW lmod Nothing docEmpty
|
||||
-- A pseudo node that serves merely to force documentation
|
||||
-- before the node
|
||||
, docNodeMoveToKWDP lmod AnnModule $ docAltFilter
|
||||
[ (,) allowSingleLineExportList $ docForceSingleline $ docSeq
|
||||
[ appSep $ docLit $ Text.pack "module"
|
||||
, appSep $ docLit tn
|
||||
, docWrapNode lmod $ appSep $ case les of
|
||||
Nothing -> docEmpty
|
||||
Just x -> layoutLLIEs True x
|
||||
, docLit $ Text.pack "where"
|
||||
]
|
||||
, (,) otherwise $ docLines
|
||||
[ docAddBaseY BrIndentRegular $ docPar
|
||||
(docSeq [appSep $ docLit $ Text.pack "module", docLit tn]
|
||||
)
|
||||
(docWrapNode lmod $ case les of
|
||||
Nothing -> docEmpty
|
||||
Just x -> layoutLLIEs False x
|
||||
)
|
||||
, docLit $ Text.pack "where"
|
||||
]
|
||||
]
|
||||
]
|
||||
: map layoutImport imports
|
|
@ -301,6 +301,8 @@ transformAlts briDoc =
|
|||
reWrap . BDFAnnotationRest annKey <$> rec bd
|
||||
BDFAnnotationKW annKey kw bd ->
|
||||
reWrap . BDFAnnotationKW annKey kw <$> rec bd
|
||||
BDFMoveToKWDP annKey kw bd ->
|
||||
reWrap . BDFMoveToKWDP annKey kw <$> rec bd
|
||||
BDFLines [] -> return $ reWrap BDFEmpty -- evil transformation. or harmless.
|
||||
BDFLines (l:lr) -> do
|
||||
ind <- _acp_indent <$> mGet
|
||||
|
@ -319,11 +321,16 @@ transformAlts briDoc =
|
|||
BrIndentNone -> 0
|
||||
BrIndentRegular -> indAmount
|
||||
BrIndentSpecial i -> i
|
||||
mSet $ acp { _acp_indentPrep = 0 -- TODO: i am not sure this is valid,
|
||||
-- in general.
|
||||
, _acp_indent = _acp_indent acp + indAdd
|
||||
, _acp_line = _acp_line acp + indAdd
|
||||
}
|
||||
mSet $ acp
|
||||
{ _acp_indentPrep = 0
|
||||
-- TODO: i am not sure this is valid, in general.
|
||||
, _acp_indent = _acp_indent acp + indAdd
|
||||
, _acp_line = max (_acp_line acp) (_acp_indent acp + indAdd)
|
||||
-- we cannot use just _acp_line acp + indAdd because of the case
|
||||
-- where there are multiple BDFEnsureIndents in the same line.
|
||||
-- Then, the actual indentation is relative to the current
|
||||
-- indentation, not the current cursor position.
|
||||
}
|
||||
r <- rec bd
|
||||
acp' <- mGet
|
||||
mSet $ acp' { _acp_indent = _acp_indent acp }
|
||||
|
@ -455,6 +462,7 @@ getSpacing !bridoc = rec bridoc
|
|||
BDFAnnotationPrior _annKey bd -> rec bd
|
||||
BDFAnnotationKW _annKey _kw bd -> rec bd
|
||||
BDFAnnotationRest _annKey bd -> rec bd
|
||||
BDFMoveToKWDP _annKey _kw bd -> rec bd
|
||||
BDFLines [] -> return
|
||||
$ LineModeValid
|
||||
$ VerticalSpacing 0 VerticalSpacingParNone False
|
||||
|
@ -700,6 +708,7 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
|
|||
BDFAnnotationPrior _annKey bd -> rec bd
|
||||
BDFAnnotationKW _annKey _kw bd -> rec bd
|
||||
BDFAnnotationRest _annKey bd -> rec bd
|
||||
BDFMoveToKWDP _annKey _kw bd -> rec bd
|
||||
BDFLines [] -> return $ [VerticalSpacing 0 VerticalSpacingParNone False]
|
||||
BDFLines ls@(_:_) -> do
|
||||
-- we simply assume that lines is only used "properly", i.e. in
|
||||
|
|
|
@ -128,6 +128,7 @@ transformSimplifyColumns = Uniplate.rewrite $ \case
|
|||
BDAnnotationPrior{} -> Nothing
|
||||
BDAnnotationKW{} -> Nothing
|
||||
BDAnnotationRest{} -> Nothing
|
||||
BDMoveToKWDP{} -> Nothing
|
||||
BDEnsureIndent{} -> Nothing
|
||||
BDSetParSpacing{} -> Nothing
|
||||
BDForceParSpacing{} -> Nothing
|
||||
|
|
|
@ -178,6 +178,7 @@ data ColSig
|
|||
| ColTuple
|
||||
| ColTuples
|
||||
| ColOpPrefix -- merge with ColList ? other stuff?
|
||||
| ColImport
|
||||
|
||||
-- TODO
|
||||
deriving (Eq, Ord, Data.Data.Data, Show)
|
||||
|
@ -232,6 +233,7 @@ data BriDoc
|
|||
| BDAnnotationPrior AnnKey BriDoc
|
||||
| BDAnnotationKW AnnKey (Maybe AnnKeywordId) BriDoc
|
||||
| BDAnnotationRest AnnKey BriDoc
|
||||
| BDMoveToKWDP AnnKey AnnKeywordId BriDoc
|
||||
| BDLines [BriDoc]
|
||||
| BDEnsureIndent BrIndent BriDoc
|
||||
-- the following constructors are only relevant for the alt transformation
|
||||
|
@ -277,6 +279,7 @@ data BriDocF f
|
|||
| BDFAnnotationPrior AnnKey (f (BriDocF f))
|
||||
| BDFAnnotationKW AnnKey (Maybe AnnKeywordId) (f (BriDocF f))
|
||||
| BDFAnnotationRest AnnKey (f (BriDocF f))
|
||||
| BDFMoveToKWDP AnnKey AnnKeywordId (f (BriDocF f))
|
||||
| BDFLines [(f (BriDocF f))]
|
||||
| BDFEnsureIndent BrIndent (f (BriDocF f))
|
||||
| BDFForceMultiline (f (BriDocF f))
|
||||
|
@ -310,6 +313,7 @@ instance Uniplate.Uniplate BriDoc where
|
|||
uniplate (BDAnnotationPrior annKey bd) = plate BDAnnotationPrior |- annKey |* bd
|
||||
uniplate (BDAnnotationKW annKey kw bd) = plate BDAnnotationKW |- annKey |- kw |* bd
|
||||
uniplate (BDAnnotationRest annKey bd) = plate BDAnnotationRest |- annKey |* bd
|
||||
uniplate (BDMoveToKWDP annKey kw bd) = plate BDMoveToKWDP |- annKey |- kw |* bd
|
||||
uniplate (BDLines lines) = plate BDLines ||* lines
|
||||
uniplate (BDEnsureIndent ind bd) = plate BDEnsureIndent |- ind |* bd
|
||||
uniplate (BDForceMultiline bd) = plate BDForceMultiline |* bd
|
||||
|
@ -341,6 +345,7 @@ unwrapBriDocNumbered tpl = case snd tpl of
|
|||
BDFAnnotationPrior annKey bd -> BDAnnotationPrior annKey $ rec bd
|
||||
BDFAnnotationKW annKey kw bd -> BDAnnotationKW annKey kw $ rec bd
|
||||
BDFAnnotationRest annKey bd -> BDAnnotationRest annKey $ rec bd
|
||||
BDFMoveToKWDP annKey kw bd -> BDMoveToKWDP annKey kw $ rec bd
|
||||
BDFLines lines -> BDLines $ rec <$> lines
|
||||
BDFEnsureIndent ind bd -> BDEnsureIndent ind $ rec bd
|
||||
BDFForceMultiline bd -> BDForceMultiline $ rec bd
|
||||
|
@ -376,6 +381,7 @@ briDocSeqSpine = \case
|
|||
BDAnnotationPrior _annKey bd -> briDocSeqSpine bd
|
||||
BDAnnotationKW _annKey _kw bd -> briDocSeqSpine bd
|
||||
BDAnnotationRest _annKey bd -> briDocSeqSpine bd
|
||||
BDMoveToKWDP _annKey _kw bd -> briDocSeqSpine bd
|
||||
BDLines lines -> foldl' (\(!()) -> briDocSeqSpine) () lines
|
||||
BDEnsureIndent _ind bd -> briDocSeqSpine bd
|
||||
BDForceMultiline bd -> briDocSeqSpine bd
|
||||
|
|
Loading…
Reference in New Issue