summaryrefslogtreecommitdiffhomepage
path: root/lib/Language/Haskell/Stylish/Step/Imports.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Language/Haskell/Stylish/Step/Imports.hs')
-rw-r--r--lib/Language/Haskell/Stylish/Step/Imports.hs114
1 files changed, 91 insertions, 23 deletions
diff --git a/lib/Language/Haskell/Stylish/Step/Imports.hs b/lib/Language/Haskell/Stylish/Step/Imports.hs
index 82ba96f..29b8cc2 100644
--- a/lib/Language/Haskell/Stylish/Step/Imports.hs
+++ b/lib/Language/Haskell/Stylish/Step/Imports.hs
@@ -1,21 +1,28 @@
{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings #-}
--------------------------------------------------------------------------------
module Language.Haskell.Stylish.Step.Imports
- ( Align (..)
+ ( Options (..)
+ , defaultOptions
, ImportAlign (..)
, ListAlign (..)
, LongListAlign (..)
+ , EmptyListAlign (..)
+ , ListPadding (..)
, step
) where
--------------------------------------------------------------------------------
import Control.Arrow ((&&&))
+import Control.Monad (void)
import Data.Char (toLower)
import Data.List (intercalate, sortBy)
import Data.Maybe (isJust, maybeToList)
import Data.Ord (comparing)
-import qualified Language.Haskell.Exts.Annotated as H
+import qualified Language.Haskell.Exts as H
+import qualified Data.Aeson as A
+import qualified Data.Aeson.Types as A
--------------------------------------------------------------------------------
@@ -25,13 +32,28 @@ import Language.Haskell.Stylish.Step
import Language.Haskell.Stylish.Util
--------------------------------------------------------------------------------
-data Align = Align
- { importAlign :: ImportAlign
- , listAlign :: ListAlign
- , longListAlign :: LongListAlign
- , listPadding :: Int
- , separateLists :: Bool
+data Options = Options
+ { importAlign :: ImportAlign
+ , listAlign :: ListAlign
+ , longListAlign :: LongListAlign
+ , emptyListAlign :: EmptyListAlign
+ , listPadding :: ListPadding
+ , separateLists :: Bool
+ } deriving (Eq, Show)
+
+defaultOptions :: Options
+defaultOptions = Options
+ { importAlign = Global
+ , listAlign = AfterAlias
+ , longListAlign = Inline
+ , emptyListAlign = Inherit
+ , listPadding = LPConstant 4
+ , separateLists = True
}
+
+data ListPadding
+ = LPConstant Int
+ | LPModuleName
deriving (Eq, Show)
data ImportAlign
@@ -47,6 +69,11 @@ data ListAlign
| AfterAlias
deriving (Eq, Show)
+data EmptyListAlign
+ = Inherit
+ | RightAfter
+ deriving (Eq, Show)
+
data LongListAlign
= Inline
| InlineWithBreak
@@ -83,8 +110,8 @@ compareImportSpecs :: H.ImportSpec l -> H.ImportSpec l -> Ordering
compareImportSpecs = comparing key
where
key :: H.ImportSpec l -> (Int, Bool, String)
- key (H.IVar _ x) = (1, isOperator x, nameToString x)
- key (H.IAbs _ _ x) = (0, False, nameToString x)
+ key (H.IVar _ x) = (1, isOperator x, nameToString x)
+ key (H.IAbs _ _ x) = (0, False, nameToString x)
key (H.IThingAll _ x) = (0, False, nameToString x)
key (H.IThingWith _ x _) = (0, False, nameToString x)
@@ -135,14 +162,22 @@ prettyImportSpec separate = prettyImportSpec'
--------------------------------------------------------------------------------
prettyImport :: (Ord l, Show l) =>
- Int -> Align -> Bool -> Bool -> Int -> H.ImportDecl l -> [String]
-prettyImport columns Align{..} padQualified padName longest imp =
- case longListAlign of
- Inline -> inlineWrap
- InlineWithBreak -> longListWrapper inlineWrap inlineWithBreakWrap
+ Int -> Options -> Bool -> Bool -> Int -> H.ImportDecl l -> [String]
+prettyImport columns Options{..} padQualified padName longest imp
+ | (void `fmap` H.importSpecs imp) == emptyImportSpec = emptyWrap
+ | otherwise = case longListAlign of
+ Inline -> inlineWrap
+ InlineWithBreak -> longListWrapper inlineWrap inlineWithBreakWrap
InlineToMultiline -> longListWrapper inlineWrap inlineToMultilineWrap
- Multiline -> longListWrapper inlineWrap multilineWrap
+ Multiline -> longListWrapper inlineWrap multilineWrap
where
+ emptyImportSpec = Just (H.ImportSpecList () False [])
+ -- "import" + space + qualifiedLength has space in it.
+ listPadding' = listPaddingValue (6 + 1 + qualifiedLength) listPadding
+ where
+ qualifiedLength =
+ if null qualified then 0 else 1 + sum (map length qualified)
+
longListWrapper shortWrap longWrap
| listAlign == NewLine
|| length shortWrap > 1
@@ -150,6 +185,10 @@ prettyImport columns Align{..} padQualified padName longest imp =
= longWrap
| otherwise = shortWrap
+ emptyWrap = case emptyListAlign of
+ Inherit -> inlineWrap
+ RightAfter -> [paddedNoSpecBase ++ " ()"]
+
inlineWrap = inlineWrapper
$ mapSpecs
$ withInit (++ ",")
@@ -157,13 +196,13 @@ prettyImport columns Align{..} padQualified padName longest imp =
. withLast (++ ")")
inlineWrapper = case listAlign of
- NewLine -> (paddedNoSpecBase :) . wrapRest columns listPadding
+ NewLine -> (paddedNoSpecBase :) . wrapRest columns listPadding'
WithAlias -> wrap columns paddedBase (inlineBaseLength + 1)
-- Add 1 extra space to ensure same padding as in original code.
AfterAlias -> withTail (' ' :)
. wrap columns paddedBase (afterAliasBaseLength + 1)
- inlineWithBreakWrap = paddedNoSpecBase : wrapRest columns listPadding
+ inlineWithBreakWrap = paddedNoSpecBase : wrapRest columns listPadding'
( mapSpecs
$ withInit (++ ",")
. withHead ("(" ++)
@@ -176,7 +215,7 @@ prettyImport columns Align{..} padQualified padName longest imp =
| otherwise = inlineWithBreakWrap
-- 'wrapRest 0' ensures that every item of spec list is on new line.
- multilineWrap = paddedNoSpecBase : wrapRest 0 listPadding
+ multilineWrap = paddedNoSpecBase : wrapRest 0 listPadding'
( mapSpecs
( withHead ("( " ++)
. withTail (", " ++))
@@ -196,6 +235,8 @@ prettyImport columns Align{..} padQualified padName longest imp =
base' baseName importAs hasHiding' = unwords $ concat $ filter (not . null)
[ ["import"]
+ , source
+ , safe
, qualified
, show <$> maybeToList (H.importPkg imp)
, [baseName]
@@ -220,9 +261,22 @@ prettyImport columns Align{..} padQualified padName longest imp =
qualified
| H.importQualified imp = ["qualified"]
- | padQualified = [" "]
+ | padQualified =
+ if H.importSrc imp
+ then []
+ else if H.importSafe imp
+ then [" "]
+ else [" "]
| otherwise = []
+ safe
+ | H.importSafe imp = ["safe"]
+ | otherwise = []
+
+ source
+ | H.importSrc imp = ["{-# SOURCE #-}"]
+ | otherwise = []
+
mapSpecs f = case importSpecs of
Nothing -> [] -- Import everything
Just [] -> ["()"] -- Instance only imports
@@ -230,7 +284,7 @@ prettyImport columns Align{..} padQualified padName longest imp =
--------------------------------------------------------------------------------
-prettyImportGroup :: Int -> Align -> Bool -> Int
+prettyImportGroup :: Int -> Options -> Bool -> Int
-> [H.ImportDecl LineBlock]
-> Lines
prettyImportGroup columns align fileAlign longest imps =
@@ -253,12 +307,12 @@ prettyImportGroup columns align fileAlign longest imps =
--------------------------------------------------------------------------------
-step :: Int -> Align -> Step
+step :: Int -> Options -> Step
step columns = makeStep "Imports" . step' columns
--------------------------------------------------------------------------------
-step' :: Int -> Align -> Lines -> Module -> Lines
+step' :: Int -> Options -> Lines -> Module -> Lines
step' columns align ls (module', _) = applyChanges
[ change block $ const $
prettyImportGroup columns align fileAlign longest importGroup
@@ -273,3 +327,17 @@ step' columns align ls (module', _) = applyChanges
fileAlign = case importAlign align of
File -> any H.importQualified imps
_ -> False
+
+--------------------------------------------------------------------------------
+listPaddingValue :: Int -> ListPadding -> Int
+listPaddingValue _ (LPConstant n) = n
+listPaddingValue n LPModuleName = n
+
+--------------------------------------------------------------------------------
+
+instance A.FromJSON ListPadding where
+ parseJSON (A.String "module_name") = return LPModuleName
+ parseJSON (A.Number n) | n' >= 1 = return $ LPConstant n'
+ where
+ n' = truncate n
+ parseJSON v = A.typeMismatch "'module_name' or >=1 number" v
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-02 22:04:18 +0000