Add import and module support #83
|
@ -67,6 +67,9 @@ library {
|
||||||
Language.Haskell.Brittany.Internal.Layouters.Expr
|
Language.Haskell.Brittany.Internal.Layouters.Expr
|
||||||
Language.Haskell.Brittany.Internal.Layouters.Stmt
|
Language.Haskell.Brittany.Internal.Layouters.Stmt
|
||||||
Language.Haskell.Brittany.Internal.Layouters.Pattern
|
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.Alt
|
||||||
Language.Haskell.Brittany.Internal.Transformations.Floating
|
Language.Haskell.Brittany.Internal.Transformations.Floating
|
||||||
Language.Haskell.Brittany.Internal.Transformations.Par
|
Language.Haskell.Brittany.Internal.Transformations.Par
|
||||||
|
|
|
@ -558,3 +558,282 @@ func =
|
||||||
]
|
]
|
||||||
++ [ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc]
|
++ [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 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 )
|
||||||
|
|
|
@ -593,6 +593,256 @@ func =
|
||||||
]
|
]
|
||||||
++ [ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc]
|
++ [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)
|
||||||
|
|
||||||
###############################################################################
|
###############################################################################
|
||||||
###############################################################################
|
###############################################################################
|
||||||
|
@ -1128,4 +1378,3 @@ foo =
|
||||||
## ]
|
## ]
|
||||||
## where
|
## where
|
||||||
## role = stringProperty "WM_WINDOW_ROLE"
|
## role = stringProperty "WM_WINDOW_ROLE"
|
||||||
|
|
||||||
|
|
|
@ -33,6 +33,7 @@ import Language.Haskell.Brittany.Internal.LayouterBasics
|
||||||
|
|
||||||
import Language.Haskell.Brittany.Internal.Layouters.Type
|
import Language.Haskell.Brittany.Internal.Layouters.Type
|
||||||
import Language.Haskell.Brittany.Internal.Layouters.Decl
|
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.Utils
|
||||||
import Language.Haskell.Brittany.Internal.Backend
|
import Language.Haskell.Brittany.Internal.Backend
|
||||||
import Language.Haskell.Brittany.Internal.BackendUtils
|
import Language.Haskell.Brittany.Internal.BackendUtils
|
||||||
|
@ -248,30 +249,8 @@ parsePrintModuleTests conf filename input = do
|
||||||
-- else return $ TextL.toStrict $ Text.Builder.toLazyText out
|
-- else return $ TextL.toStrict $ Text.Builder.toLazyText out
|
||||||
|
|
||||||
ppModule :: GenLocated SrcSpan (HsModule RdrName) -> PPM ()
|
ppModule :: GenLocated SrcSpan (HsModule RdrName) -> PPM ()
|
||||||
ppModule lmod@(L loc m@(HsModule _name _exports _imports decls _ _)) = do
|
ppModule lmod@(L _loc _m@(HsModule _name _exports _ decls _ _)) = do
|
||||||
let emptyModule = L loc m { hsmodDecls = [] }
|
post <- ppPreamble lmod
|
||||||
(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
|
|
||||||
decls `forM_` \decl -> do
|
decls `forM_` \decl -> do
|
||||||
filteredAnns <- mAsk <&> \annMap ->
|
filteredAnns <- mAsk <&> \annMap ->
|
||||||
Map.findWithDefault Map.empty (ExactPrint.Types.mkAnnKey decl) annMap
|
Map.findWithDefault Map.empty (ExactPrint.Types.mkAnnKey decl) annMap
|
||||||
|
@ -341,6 +320,51 @@ ppDecl d@(L loc decl) = case decl of
|
||||||
layoutBriDoc briDoc
|
layoutBriDoc briDoc
|
||||||
_ -> briDocMToPPM (briDocByExactNoComment d) >>= layoutBriDoc
|
_ -> 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 :: Sig RdrName -> String
|
||||||
_sigHead = \case
|
_sigHead = \case
|
||||||
TypeSig names _ ->
|
TypeSig names _ ->
|
||||||
|
|
|
@ -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 "'"
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,133 @@
|
||||||
|
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, docSeq [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 :: Located [LIE RdrName] -> ToBriDocM BriDocNumbered
|
||||||
|
layoutLLIEs 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, docSeq $ docLit (Text.pack "("):ieDs ++ [docParenR])
|
||||||
|
, (otherwise, docPar (docSetBaseY $ docSeq [docParenLSep, ieDsH]) $
|
||||||
|
docLines $ ieDsT
|
||||||
|
++ [docParenR])
|
||||||
|
]
|
|
@ -0,0 +1,134 @@
|
||||||
|
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
|
||||||
|
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 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] -> if hasComments
|
||||||
|
then docPar (docSeq [hidDoc, docParenLSep, ieD]) docParenR
|
||||||
|
else docSeq [hidDoc, docParenLSep, ieD, docSeparator, 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, docSetBaseY $ 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 < importCol - asCost
|
||||||
|
asDoc =
|
||||||
|
docEnsureIndent (BrIndentSpecial (importCol - asCost))
|
||||||
|
$ makeAsDoc n
|
||||||
|
Nothing | enoughRoom -> docSeq [importHead, bindingLine]
|
||||||
|
| otherwise -> docLines [importHead, bindingLine]
|
||||||
|
where enoughRoom = nameCost < importCol - bindingCost
|
||||||
|
_ -> docEmpty
|
|
@ -0,0 +1,58 @@
|
||||||
|
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
|
||||||
|
exportsDoc = maybe docEmpty layoutLLIEs les
|
||||||
|
docLines
|
||||||
|
$ docSeq
|
||||||
|
[ docWrapNode lmod docEmpty
|
||||||
|
-- A pseudo node that serves merely to force documentation
|
||||||
|
-- before the node
|
||||||
|
, docAlt
|
||||||
|
( [ docForceSingleline $ docSeq
|
||||||
|
[ appSep $ docLit $ Text.pack "module"
|
||||||
|
, appSep $ docLit tn
|
||||||
|
, appSep exportsDoc
|
||||||
|
, docLit $ Text.pack "where"
|
||||||
|
]
|
||||||
|
]
|
||||||
|
++ [ docLines
|
||||||
|
[ docAddBaseY BrIndentRegular $ docPar
|
||||||
|
( docSeq
|
||||||
|
[appSep $ docLit $ Text.pack "module", docLit tn]
|
||||||
|
)
|
||||||
|
(docForceMultiline exportsDoc)
|
||||||
|
, docLit $ Text.pack "where"
|
||||||
|
]
|
||||||
|
]
|
||||||
|
)
|
||||||
|
]
|
||||||
|
: map layoutImport imports
|
|
@ -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)
|
||||||
|
|
Loading…
Reference in New Issue
These are the only ones that look weird to me. The indentation depends on the length of the
Thing
identifier. I don't think I've ever actually had an import like this, but I think I'd format it as:Ah I should have expected this. I'll take a look.