Add function to generate compact language pragmas

2 files changed, 36 insertions, 3 deletions

diff --git a/src/StylishHaskell/Stylish/LanguagePragmas.hs b/src/StylishHaskell/Stylish/LanguagePragmas.hs
index 017c64d..5b6adde 100644
--- a/src/StylishHaskell/Stylish/LanguagePragmas.hs
+++ b/src/StylishHaskell/Stylish/LanguagePragmas.hs
@@ -34,8 +34,8 @@ firstLocation = minimum . map (blockStart . fst)
 
 --------------------------------------------------------------------------------
 -- | TODO: multiple lines if longer than 80 columns
-prettyPragmas :: [String] -> Lines
-prettyPragmas pragmas' =
+verticalPragmas :: [String] -> Lines
+verticalPragmas pragmas' =
     [ "{-# LANGUAGE " ++ padRight longest pragma ++ " #-}"
     | pragma <- pragmas'
     ]
@@ -44,6 +44,12 @@ prettyPragmas pragmas' =
 
 
 --------------------------------------------------------------------------------
+compactPragmas :: [String] -> Lines
+compactPragmas pragmas' = wrap 80 "{-# LANGUAGE" 13 $
+    map (++ ",") (init pragmas') ++ [last pragmas', "#-}"]
+
+
+--------------------------------------------------------------------------------
 stylish :: Bool -> Stylish
 stylish removeRedundant ls (module', _)
     | null pragmas' = ls
@@ -57,7 +63,7 @@ stylish removeRedundant ls (module', _)
     uniques  = filterRedundant $ nub $ sort $ snd =<< pragmas'
     loc      = firstLocation pragmas'
     deletes  = map (delete . fst) pragmas'
-    changes  = insert loc (prettyPragmas uniques) : deletes
+    changes  = insert loc (compactPragmas uniques) : deletes
 
 
 --------------------------------------------------------------------------------
diff --git a/src/StylishHaskell/Util.hs b/src/StylishHaskell/Util.hs
index 5a4372f..6154a9d 100644
--- a/src/StylishHaskell/Util.hs
+++ b/src/StylishHaskell/Util.hs
@@ -4,6 +4,7 @@ module StylishHaskell.Util
     , padRight
     , everything
     , infoPoints
+    , wrap
     ) where
 
 
@@ -17,6 +18,10 @@ import qualified Language.Haskell.Exts.Annotated as H
 
 
 --------------------------------------------------------------------------------
+import           StylishHaskell.Stylish
+
+
+--------------------------------------------------------------------------------
 nameToString :: H.Name l -> String
 nameToString (H.Ident _ str)  = str
 nameToString (H.Symbol _ str) = str
@@ -35,3 +40,25 @@ everything = G.everything (++) (maybeToList . cast)
 --------------------------------------------------------------------------------
 infoPoints :: H.SrcSpanInfo -> [((Int, Int), (Int, Int))]
 infoPoints = H.srcInfoPoints >>> map (H.srcSpanStart &&& H.srcSpanEnd)
+
+
+--------------------------------------------------------------------------------
+wrap :: Int       -- ^ Maximum line width
+     -> String    -- ^ Leading string
+     -> Int       -- ^ Indentation
+     -> [String]  -- ^ Strings to add/wrap
+     -> Lines     -- ^ Resulting lines
+wrap maxWidth leading indent strs =
+    let (ls, curr, _) = foldl step ([], leading, length leading) strs
+    in ls ++ [curr]
+  where
+    -- TODO: In order to optimize this, use a difference list instead of a
+    -- regular list for 'ls'.
+    step (ls, curr, width) str
+        | width' > maxWidth = (ls ++ [curr], spaces ++ str, indent + len)
+        | otherwise         = (ls, curr ++ " " ++ str, width')
+      where
+        len    = length str
+        width' = width + 1 + len
+
+    spaces = replicate indent ' '