Sorting of import sub-lists

2 files changed, 43 insertions, 25 deletions

diff --git a/src/Language/Haskell/Stylish/Step/Imports.hs b/src/Language/Haskell/Stylish/Step/Imports.hs
index 2dd6a2a..17bc746 100644
--- a/src/Language/Haskell/Stylish/Step/Imports.hs
+++ b/src/Language/Haskell/Stylish/Step/Imports.hs
@@ -11,7 +11,7 @@ module Language.Haskell.Stylish.Step.Imports
 
 --------------------------------------------------------------------------------
 import           Control.Arrow                   ((&&&))
-import           Data.Char                       (isAlpha, toLower)
+import           Data.Char                       (toLower)
 import           Data.List                       (intercalate, sortBy)
 import           Data.Maybe                      (isJust, maybeToList)
 import           Data.Ord                        (comparing)
@@ -24,7 +24,6 @@ import           Language.Haskell.Stylish.Editor
 import           Language.Haskell.Stylish.Step
 import           Language.Haskell.Stylish.Util
 
-
 --------------------------------------------------------------------------------
 data Align = Align
     { importAlign   :: ImportAlign
@@ -82,26 +81,34 @@ compareImports = comparing (map toLower . importName &&& H.importQualified)
 compareImportSpecs :: H.ImportSpec l -> H.ImportSpec l -> Ordering
 compareImportSpecs = comparing key
   where
-    key :: H.ImportSpec l -> (Int, Int, String)
-    key (H.IVar _ _ x)       = let n = nameToString x in (1, operator n, n)
-    key (H.IAbs _ x)         = (0, 0, nameToString x)
-    key (H.IThingAll _ x)    = (0, 0, nameToString x)
-    key (H.IThingWith _ x _) = (0, 0, nameToString x)
-
-    operator []      = 0  -- But this should not happen
-    operator (x : _) = if isAlpha x then 0 else 1
+    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.IThingAll _ x)    = (0, False, nameToString x)
+    key (H.IThingWith _ x _) = (0, False, nameToString x)
 
 
 --------------------------------------------------------------------------------
 -- | Sort the input spec list inside an 'H.ImportDecl'
 sortImportSpecs :: H.ImportDecl l -> H.ImportDecl l
-sortImportSpecs imp = imp {H.importSpecs = fmap sort $ H.importSpecs imp}
+sortImportSpecs imp = imp {H.importSpecs = fmap sort' $ H.importSpecs imp}
   where
-    sort (H.ImportSpecList l h specs) = H.ImportSpecList l h $
+    sort' (H.ImportSpecList l h specs) = H.ImportSpecList l h $
         sortBy compareImportSpecs specs
 
 
 --------------------------------------------------------------------------------
+-- | Order of imports in sublist is:
+-- Constructors, accessors/methods, operators.
+compareImportSubSpecs :: H.CName l -> H.CName l -> Ordering
+compareImportSubSpecs = comparing key
+  where
+    key :: H.CName l -> (Int, Bool, String)
+    key (H.ConName _ x) = (0, False,        nameToString x)
+    key (H.VarName _ x) = (1, isOperator x, nameToString x)
+
+
+--------------------------------------------------------------------------------
 -- | By default, haskell-src-exts pretty-prints
 --
 -- > import Foo (Bar(..))
@@ -111,16 +118,23 @@ sortImportSpecs imp = imp {H.importSpecs = fmap sort $ H.importSpecs imp}
 -- > import Foo (Bar (..))
 --
 -- instead.
-prettyImportSpec :: H.ImportSpec l -> String
-prettyImportSpec (H.IThingAll  _ n)     = H.prettyPrint n ++ " (..)"
-prettyImportSpec (H.IThingWith _ n cns) = H.prettyPrint n ++ " (" ++
-    intercalate ", " (map H.prettyPrint cns) ++ ")"
-prettyImportSpec x                      = H.prettyPrint x
+prettyImportSpec :: (Ord l) => Bool -> H.ImportSpec l -> String
+prettyImportSpec separate = prettyImportSpec'
+  where
+    prettyImportSpec' (H.IThingAll  _ n)     = H.prettyPrint n ++ sep "(..)"
+    prettyImportSpec' (H.IThingWith _ n cns) = H.prettyPrint n
+        ++ sep "("
+        ++ intercalate ", "
+          (map H.prettyPrint $ sortBy compareImportSubSpecs cns)
+        ++ ")"
+    prettyImportSpec' x                      = H.prettyPrint x
+
+    sep = if separate then (' ' :) else id
 
 
 --------------------------------------------------------------------------------
-prettyImport :: Int -> Align -> Bool -> Bool -> Int -> H.ImportDecl l
-             -> [String]
+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
@@ -204,11 +218,7 @@ prettyImport columns Align{..} padQualified padName longest imp =
     mapSpecs f = case importSpecs of
         Nothing -> []     -- Import everything
         Just [] -> ["()"] -- Instance only imports
-        Just is -> f $ map format is
-      where
-        format
-          | separateLists = prettyImportSpec
-          | otherwise = H.prettyPrint
+        Just is -> f $ map (prettyImportSpec separateLists) is
 
 
 --------------------------------------------------------------------------------
diff --git a/src/Language/Haskell/Stylish/Util.hs b/src/Language/Haskell/Stylish/Util.hs
index 6621108..39add70 100644
--- a/src/Language/Haskell/Stylish/Util.hs
+++ b/src/Language/Haskell/Stylish/Util.hs
@@ -1,6 +1,7 @@
 --------------------------------------------------------------------------------
 module Language.Haskell.Stylish.Util
     ( nameToString
+    , isOperator
     , indent
     , padRight
     , everything
@@ -17,9 +18,10 @@ module Language.Haskell.Stylish.Util
 
 --------------------------------------------------------------------------------
 import           Control.Arrow                   ((&&&), (>>>))
+import           Data.Char                       (isAlpha)
 import           Data.Data                       (Data)
 import qualified Data.Generics                   as G
-import           Data.Maybe                      (maybeToList)
+import           Data.Maybe                      (fromMaybe, listToMaybe, maybeToList)
 import           Data.Typeable                   (cast)
 import qualified Language.Haskell.Exts.Annotated as H
 
@@ -35,6 +37,12 @@ nameToString (H.Symbol _ str) = str
 
 
 --------------------------------------------------------------------------------
+isOperator :: H.Name l -> Bool
+isOperator = fromMaybe False
+    . (fmap (not . isAlpha) . listToMaybe)
+    . nameToString
+
+--------------------------------------------------------------------------------
 indent :: Int -> String -> String
 indent len = (indentPrefix len ++)