Merge branch 'master' of https://github.com/JOndra91/stylish-haskell into JOndra91-master

5 files changed, 276 insertions, 102 deletions

diff --git a/src/Language/Haskell/Stylish.hs b/src/Language/Haskell/Stylish.hs
index 7a52aa2..b8620ae 100644
--- a/src/Language/Haskell/Stylish.hs
+++ b/src/Language/Haskell/Stylish.hs
@@ -53,6 +53,7 @@ imports = Imports.step
 --------------------------------------------------------------------------------
 languagePragmas :: Int -- ^ columns
                 -> LanguagePragmas.Style
+                -> Bool -- ^ Pad to same length in vertical mode?
                 -> Bool -- ^ remove redundant?
                 -> Step
 languagePragmas = LanguagePragmas.step
diff --git a/src/Language/Haskell/Stylish/Config.hs b/src/Language/Haskell/Stylish/Config.hs
index 0304ae5..271a461 100644
--- a/src/Language/Haskell/Stylish/Config.hs
+++ b/src/Language/Haskell/Stylish/Config.hs
@@ -10,23 +10,25 @@ module Language.Haskell.Stylish.Config
 
 
 --------------------------------------------------------------------------------
-import           Control.Applicative                    (pure, (<$>), (<*>))
-import           Control.Monad                          (forM, mzero)
-import           Data.Aeson                             (FromJSON (..))
-import qualified Data.Aeson                             as A
-import qualified Data.Aeson.Types                       as A
-import qualified Data.ByteString                        as B
-import           Data.List                              (inits, intercalate)
-import           Data.Map                               (Map)
-import qualified Data.Map                               as M
-import           Data.Yaml                              (decodeEither)
+import           Control.Applicative                              (pure, (<$>),
+                                                                   (<*>))
+import           Control.Monad                                    (forM, mzero)
+import           Data.Aeson                                       (FromJSON (..))
+import qualified Data.Aeson                                       as A
+import qualified Data.Aeson.Types                                 as A
+import qualified Data.ByteString                                  as B
+import           Data.List                                        (inits,
+                                                                   intercalate)
+import           Data.Map                                         (Map)
+import qualified Data.Map                                         as M
+import           Data.Yaml                                        (decodeEither)
 import           System.Directory
-import           System.FilePath                        (joinPath, splitPath,
-                                                         (</>))
+import           System.FilePath                                  (joinPath,
+                                                                   splitPath,
+                                                                   (</>))
 
 
 --------------------------------------------------------------------------------
-import           Paths_stylish_haskell                  (getDataFileName)
 import           Language.Haskell.Stylish.Step
 import qualified Language.Haskell.Stylish.Step.Imports            as Imports
 import qualified Language.Haskell.Stylish.Step.LanguagePragmas    as LanguagePragmas
@@ -35,6 +37,7 @@ import qualified Language.Haskell.Stylish.Step.Tabs               as Tabs
 import qualified Language.Haskell.Stylish.Step.TrailingWhitespace as TrailingWhitespace
 import qualified Language.Haskell.Stylish.Step.UnicodeSyntax      as UnicodeSyntax
 import           Language.Haskell.Stylish.Verbose
+import           Paths_stylish_haskell                            (getDataFileName)
 
 
 --------------------------------------------------------------------------------
@@ -161,7 +164,14 @@ parseEnum strs _   (Just k) = case lookup k strs of
 parseImports :: Config -> A.Object -> A.Parser Step
 parseImports config o = Imports.step
     <$> pure (configColumns config)
-    <*> (o A..:? "align" >>= parseEnum aligns Imports.Global)
+    <*> (Imports.Align
+        <$> (o A..:? "align" >>= parseEnum aligns Imports.Global)
+        <*> (o A..:? "list_align" >>= parseEnum listAligns Imports.AfterAlias)
+        <*> (o A..:? "long_list_align"
+            >>= parseEnum longListAligns Imports.Inline)
+        <*> (maybe 4 (max 1) <$> o A..:? "list_padding")
+            -- ^ Padding have to be at least 1. Default is 4.
+        <*> o A..:? "separate_lists" A..!= True)
   where
     aligns =
         [ ("global", Imports.Global)
@@ -170,18 +180,33 @@ parseImports config o = Imports.step
         , ("none",   Imports.None)
         ]
 
+    listAligns =
+        [ ("new line",    Imports.NewLine)
+        , ("with alias",  Imports.WithAlias)
+        , ("after alias", Imports.AfterAlias)
+        ]
+
+    longListAligns =
+        [ ("inline",             Imports.Inline)
+        , ("new line",           Imports.InlineWithBreak)
+        , ("new line-multiline", Imports.InlineToMultiline)
+        , ("multiline",          Imports.Multiline)
+        ]
+
 
 --------------------------------------------------------------------------------
 parseLanguagePragmas :: Config -> A.Object -> A.Parser Step
 parseLanguagePragmas config o = LanguagePragmas.step
     <$> pure (configColumns config)
     <*> (o A..:? "style" >>= parseEnum styles LanguagePragmas.Vertical)
+    <*> o A..:? "align" A..!= True
     <*> o A..:? "remove_redundant" A..!= True
   where
     styles =
         [ ("vertical",     LanguagePragmas.Vertical)
         , ("compact",      LanguagePragmas.Compact)
-        , ("compact_line", LanguagePragmas.CompactLine)]
+        , ("compact_line", LanguagePragmas.CompactLine)
+        ]
 
 
 --------------------------------------------------------------------------------
diff --git a/src/Language/Haskell/Stylish/Step/Imports.hs b/src/Language/Haskell/Stylish/Step/Imports.hs
index b58a8e3..14bb818 100644
--- a/src/Language/Haskell/Stylish/Step/Imports.hs
+++ b/src/Language/Haskell/Stylish/Step/Imports.hs
@@ -1,13 +1,19 @@
+{-# LANGUAGE RecordWildCards #-}
 --------------------------------------------------------------------------------
 module Language.Haskell.Stylish.Step.Imports
     ( Align (..)
+    , ImportAlign (..)
+    , ListAlign (..)
+    , LongListAlign (..)
     , step
     ) where
 
 
 --------------------------------------------------------------------------------
+
 import           Control.Arrow                   ((&&&))
-import           Data.Char                       (isAlpha, toLower)
+import           Data.Char                       (toLower)
+import           Data.Functor                    ((<$>))
 import           Data.List                       (intercalate, sortBy)
 import           Data.Maybe                      (isJust, maybeToList)
 import           Data.Ord                        (comparing)
@@ -20,15 +26,35 @@ import           Language.Haskell.Stylish.Editor
 import           Language.Haskell.Stylish.Step
 import           Language.Haskell.Stylish.Util
 
-
 --------------------------------------------------------------------------------
-data Align
+data Align = Align
+    { importAlign   :: ImportAlign
+    , listAlign     :: ListAlign
+    , longListAlign :: LongListAlign
+    , listPadding   :: Int
+    , separateLists :: Bool
+    }
+    deriving (Eq, Show)
+
+data ImportAlign
     = Global
     | File
     | Group
     | None
     deriving (Eq, Show)
 
+data ListAlign
+    = NewLine
+    | WithAlias
+    | AfterAlias
+    deriving (Eq, Show)
+
+data LongListAlign
+    = Inline
+    | InlineWithBreak
+    | InlineToMultiline
+    | Multiline
+    deriving (Eq, Show)
 
 --------------------------------------------------------------------------------
 imports :: H.Module l -> [H.ImportDecl l]
@@ -58,26 +84,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 = 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(..))
@@ -87,38 +121,100 @@ 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 -> Bool -> Bool -> Int -> H.ImportDecl l -> [String]
-prettyImport columns padQualified padName longest imp =
-    wrap columns base (length base + 2) $
-    (if hiding then ("hiding" :) else id) $
-    case importSpecs of
-        Nothing -> []     -- Import everything
-        Just [] -> ["()"] -- Instance only imports
-        Just is ->
-            withInit (++ ",") $
-            withHead ("(" ++) $
-            withLast (++ ")") $
-            map prettyImportSpec $
-            is
+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
+        InlineToMultiline -> longListWrapper inlineWrap inlineToMultilineWrap
+        Multiline -> longListWrapper inlineWrap multilineWrap
   where
-    base = unwords $ concat
-         [ ["import"]
-         , qualified
-         , (fmap show $ maybeToList $ H.importPkg imp)
-         , [(if hasExtras && padName then padRight longest else id)
-            (importName imp)]
-         , ["as " ++ as | H.ModuleName _ as <- maybeToList $ H.importAs imp]
-         ]
-
-    (hiding, importSpecs) = case H.importSpecs imp of
+    longListWrapper shortWrap longWrap
+        | listAlign == NewLine
+        || length shortWrap > 1
+        || length (head shortWrap) > columns
+            = longWrap
+        | otherwise = shortWrap
+
+    inlineWrap = inlineWrapper
+        $ mapSpecs
+        $ withInit (++ ",")
+        . withHead ("(" ++)
+        . withLast (++ ")")
+
+    inlineWrapper = case listAlign of
+        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
+        ( mapSpecs
+        $ withInit (++ ",")
+        . withHead ("(" ++)
+        . withLast (++ ")"))
+
+    inlineToMultilineWrap
+        | length inlineWithBreakWrap > 2
+        || any ((> columns) . length) (tail inlineWithBreakWrap)
+            = multilineWrap
+        | otherwise = inlineWithBreakWrap
+
+    -- 'wrapRest 0' ensures that every item of spec list is on new line.
+    multilineWrap = paddedNoSpecBase : wrapRest 0 listPadding
+        ( mapSpecs
+          ( withHead ("( " ++)
+          . withTail (", " ++))
+        ++ [")"])
+
+    paddedBase = base $ padImport $ importName imp
+
+    paddedNoSpecBase = base $ padImportNoSpec $ importName imp
+
+    padImport = if hasExtras && padName
+        then padRight longest
+        else id
+
+    padImportNoSpec = if (isJust (H.importAs imp) || hasHiding) && padName
+        then padRight longest
+        else id
+
+    base' baseName importAs hasHiding' = unwords $ concat $ filter (not . null)
+        [ ["import"]
+        , qualified
+        , show <$> maybeToList (H.importPkg imp)
+        , [baseName]
+        , importAs
+        , hasHiding'
+        ]
+
+    base baseName = base' baseName
+        ["as " ++ as | H.ModuleName _ as <- maybeToList $ H.importAs imp]
+        ["hiding" | hasHiding]
+
+    inlineBaseLength = length $ base' (padImport $ importName imp) [] []
+
+    afterAliasBaseLength = length $ base' (padImport $ importName imp)
+        ["as " ++ as | H.ModuleName _ as <- maybeToList $ H.importAs imp] []
+
+    (hasHiding, importSpecs) = case H.importSpecs imp of
         Just (H.ImportSpecList _ h l) -> (h, Just l)
         _                             -> (False, Nothing)
 
@@ -129,21 +225,29 @@ prettyImport columns padQualified padName longest imp =
         | padQualified          = ["         "]
         | otherwise             = []
 
+    mapSpecs f = case importSpecs of
+        Nothing -> []     -- Import everything
+        Just [] -> ["()"] -- Instance only imports
+        Just is -> f $ map (prettyImportSpec separateLists) is
+
 
 --------------------------------------------------------------------------------
-prettyImportGroup :: Int -> Align -> Bool -> Int -> [H.ImportDecl LineBlock]
+prettyImportGroup :: Int -> Align -> Bool -> Int
+                  -> [H.ImportDecl LineBlock]
                   -> Lines
 prettyImportGroup columns align fileAlign longest imps =
-    concatMap (prettyImport columns padQual padName longest') $
+    concatMap (prettyImport columns align padQual padName longest') $
     sortBy compareImports imps
   where
-    longest' = case align of
+    align' = importAlign align
+
+    longest' = case align' of
         Group -> longestImport imps
         _     -> longest
 
-    padName = align /= None
+    padName = align' /= None
 
-    padQual = case align of
+    padQual = case align' of
         Global -> True
         File   -> fileAlign
         Group  -> any H.importQualified imps
@@ -157,16 +261,17 @@ step columns = makeStep "Imports" . step' columns
 
 --------------------------------------------------------------------------------
 step' :: Int -> Align -> Lines -> Module -> Lines
-step' columns align ls (module', _) = flip applyChanges ls
+step' columns align ls (module', _) = applyChanges
     [ change block $ const $
         prettyImportGroup columns align fileAlign longest importGroup
     | (block, importGroup) <- groups
     ]
+    ls
   where
     imps    = map sortImportSpecs $ imports $ fmap linesFromSrcSpan module'
     longest = longestImport imps
     groups  = groupAdjacent [(H.ann i, i) | i <- imps]
 
-    fileAlign = case align of
+    fileAlign = case importAlign align of
         File -> any H.importQualified imps
         _    -> False
diff --git a/src/Language/Haskell/Stylish/Step/LanguagePragmas.hs b/src/Language/Haskell/Stylish/Step/LanguagePragmas.hs
index 209b2f2..0239736 100644
--- a/src/Language/Haskell/Stylish/Step/LanguagePragmas.hs
+++ b/src/Language/Haskell/Stylish/Step/LanguagePragmas.hs
@@ -42,11 +42,15 @@ firstLocation = minimum . map (blockStart . fst)
 
 
 --------------------------------------------------------------------------------
-verticalPragmas :: Int -> [String] -> Lines
-verticalPragmas longest pragmas' =
-    [ "{-# LANGUAGE " ++ padRight longest pragma ++ " #-}"
+verticalPragmas :: Int -> Bool -> [String] -> Lines
+verticalPragmas longest align pragmas' =
+    [ "{-# LANGUAGE " ++ pad pragma ++ " #-}"
     | pragma <- pragmas'
     ]
+  where
+    pad
+      | align = padRight longest
+      | otherwise = id
 
 
 --------------------------------------------------------------------------------
@@ -56,17 +60,23 @@ compactPragmas columns pragmas' = wrap columns "{-# LANGUAGE" 13 $
 
 
 --------------------------------------------------------------------------------
-compactLinePragmas :: Int -> [String] -> Lines
-compactLinePragmas _ [] = []
-compactLinePragmas columns pragmas' =
-  let maxWidth = columns - 16
-      longest  = maximum $ map length prags
-      prags    = map truncateComma $ wrap maxWidth "" 1 $
-                    map (++ ",") (init pragmas') ++ [last pragmas']
-  in map (wrapLanguage . padRight longest) prags
+compactLinePragmas :: Int -> Bool -> [String] -> Lines
+compactLinePragmas _ _ [] = []
+compactLinePragmas columns align pragmas' = map (wrapLanguage . pad) prags
   where
     wrapLanguage ps = "{-# LANGUAGE" ++ ps ++  " #-}"
 
+    maxWidth = columns - 16
+
+    longest  = maximum $ map length prags
+
+    pad
+      | align = padRight longest
+      | otherwise = id
+
+    prags = map truncateComma $ wrap maxWidth "" 1 $
+      map (++ ",") (init pragmas') ++ [last pragmas']
+
 
 --------------------------------------------------------------------------------
 truncateComma :: String -> String
@@ -77,10 +87,10 @@ truncateComma xs
 
 
 --------------------------------------------------------------------------------
-prettyPragmas :: Int -> Int -> Style -> [String] -> Lines
-prettyPragmas _       longest Vertical    = verticalPragmas longest
-prettyPragmas columns _       Compact     = compactPragmas columns
-prettyPragmas columns _       CompactLine = compactLinePragmas columns
+prettyPragmas :: Int -> Int -> Bool -> Style -> [String] -> Lines
+prettyPragmas _    longest align Vertical    = verticalPragmas longest align
+prettyPragmas cols _       _     Compact     = compactPragmas cols
+prettyPragmas cols _       align CompactLine = compactLinePragmas cols align
 
 
 --------------------------------------------------------------------------------
@@ -100,13 +110,13 @@ filterRedundant isRedundant' = snd . foldr filterRedundant' (S.empty, [])
         known' = xs' `S.union` known
 
 --------------------------------------------------------------------------------
-step :: Int -> Style -> Bool -> Step
-step columns style = makeStep "LanguagePragmas" . step' columns style
+step :: Int -> Style -> Bool -> Bool -> Step
+step = (((makeStep "LanguagePragmas" .) .) .) . step'
 
 
 --------------------------------------------------------------------------------
-step' :: Int -> Style -> Bool -> Lines -> Module -> Lines
-step' columns style removeRedundant ls (module', _)
+step' :: Int -> Style -> Bool -> Bool -> Lines -> Module -> Lines
+step' columns style align removeRedundant ls (module', _)
     | null pragmas' = ls
     | otherwise     = applyChanges changes ls
   where
@@ -118,7 +128,7 @@ step' columns style removeRedundant ls (module', _)
     longest  = maximum $ map length $ snd =<< pragmas'
     groups   = [(b, concat pgs) | (b, pgs) <- groupAdjacent pragmas']
     changes  =
-        [ change b (const $ prettyPragmas columns longest style pg)
+        [ change b (const $ prettyPragmas columns longest align style pg)
         | (b, pg) <- filterRedundant isRedundant' groups
         ]
 
diff --git a/src/Language/Haskell/Stylish/Util.hs b/src/Language/Haskell/Stylish/Util.hs
index 004c3f1..ed5de91 100644
--- a/src/Language/Haskell/Stylish/Util.hs
+++ b/src/Language/Haskell/Stylish/Util.hs
@@ -1,23 +1,27 @@
 --------------------------------------------------------------------------------
 module Language.Haskell.Stylish.Util
     ( nameToString
+    , isOperator
     , indent
     , padRight
     , everything
     , infoPoints
     , wrap
+    , wrapRest
 
     , withHead
-    , withLast
     , withInit
+    , withTail
+    , withLast
     ) where
 
 
 --------------------------------------------------------------------------------
 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
 
@@ -33,8 +37,19 @@ nameToString (H.Symbol _ str) = str
 
 
 --------------------------------------------------------------------------------
+isOperator :: H.Name l -> Bool
+isOperator = fromMaybe False
+    . (fmap (not . isAlpha) . listToMaybe)
+    . nameToString
+
+--------------------------------------------------------------------------------
 indent :: Int -> String -> String
-indent len str = replicate len ' ' ++ str
+indent len = (indentPrefix len ++)
+
+
+--------------------------------------------------------------------------------
+indentPrefix :: Int -> String
+indentPrefix = (`replicate` ' ')
 
 
 --------------------------------------------------------------------------------
@@ -58,21 +73,34 @@ wrap :: Int       -- ^ Maximum line width
      -> Int       -- ^ Indentation
      -> [String]  -- ^ Strings to add/wrap
      -> Lines     -- ^ Resulting lines
-wrap maxWidth leading ind strs =
-    let (ls, curr, _) = foldl step ([], leading, length leading) strs
-    in ls ++ [curr]
+wrap maxWidth leading ind = wrap' leading
   where
-    -- TODO: In order to optimize this, use a difference list instead of a
-    -- regular list for 'ls'.
-    step (ls, curr, width) str
-        | nextLine  = (ls ++ [curr], indent ind str, ind + len)
-        | otherwise = (ls, curr ++ " " ++ str, width')
-      where
-        -- Put it on the next line if it would make the current line too long,
-        -- AND if it doesn't make the next line too long.
-        nextLine = width' > maxWidth && ind + len <= maxWidth
-        len      = length str
-        width'   = width + 1 + len
+    wrap' ss [] = [ss]
+    wrap' ss (str:strs)
+        | overflows ss str =
+            ss : wrapRest maxWidth ind (str:strs)
+        | otherwise = wrap' (ss ++ " " ++ str) strs
+
+    overflows ss str = length ss > maxWidth ||
+        ((length ss + length str) >= maxWidth && ind + length str  <= maxWidth)
+
+
+--------------------------------------------------------------------------------
+wrapRest :: Int
+         -> Int
+         -> [String]
+         -> Lines
+wrapRest maxWidth ind = reverse . wrapRest' [] ""
+  where
+    wrapRest' ls ss []
+        | null ss = ls
+        | otherwise = ss:ls
+    wrapRest' ls ss (str:strs)
+        | null ss = wrapRest' ls (indent ind str) strs
+        | overflows ss str = wrapRest' (ss:ls) "" (str:strs)
+        | otherwise = wrapRest' ls (ss ++ " " ++ str) strs
+
+    overflows ss str = (length ss + length str + 1) >= maxWidth
 
 
 --------------------------------------------------------------------------------
@@ -84,12 +112,17 @@ withHead f (x : xs) = f x : xs
 --------------------------------------------------------------------------------
 withLast :: (a -> a) -> [a] -> [a]
 withLast _ []       = []
-withLast f (x : []) = [f x]
+withLast f [x] = [f x]
 withLast f (x : xs) = x : withLast f xs
 
 
 --------------------------------------------------------------------------------
 withInit :: (a -> a) -> [a] -> [a]
 withInit _ []       = []
-withInit _ (x : []) = [x]
+withInit _ [x] = [x]
 withInit f (x : xs) = f x : withInit f xs
+
+--------------------------------------------------------------------------------
+withTail :: (a -> a) -> [a] -> [a]
+withTail _ [] = []
+withTail f (x : xs) = x : map f xs