summaryrefslogtreecommitdiffhomepage
path: root/src/Language/Haskell/Stylish/Util.hs
blob: 004c3f16a54659d9107fa6bafbb00934100cf7d0 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
--------------------------------------------------------------------------------
module Language.Haskell.Stylish.Util
    ( nameToString
    , indent
    , padRight
    , everything
    , infoPoints
    , wrap

    , withHead
    , withLast
    , withInit
    ) where


--------------------------------------------------------------------------------
import           Control.Arrow                   ((&&&), (>>>))
import           Data.Data                       (Data)
import qualified Data.Generics                   as G
import           Data.Maybe                      (maybeToList)
import           Data.Typeable                   (cast)
import qualified Language.Haskell.Exts.Annotated as H


--------------------------------------------------------------------------------
import           Language.Haskell.Stylish.Step


--------------------------------------------------------------------------------
nameToString :: H.Name l -> String
nameToString (H.Ident _ str)  = str
nameToString (H.Symbol _ str) = str


--------------------------------------------------------------------------------
indent :: Int -> String -> String
indent len str = replicate len ' ' ++ str


--------------------------------------------------------------------------------
padRight :: Int -> String -> String
padRight len str = str ++ replicate (len - length str) ' '


--------------------------------------------------------------------------------
everything :: (Data a, Data b) => a -> [b]
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 ind 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
        | 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


--------------------------------------------------------------------------------
withHead :: (a -> a) -> [a] -> [a]
withHead _ []       = []
withHead f (x : xs) = f x : xs


--------------------------------------------------------------------------------
withLast :: (a -> a) -> [a] -> [a]
withLast _ []       = []
withLast f (x : []) = [f x]
withLast f (x : xs) = x : withLast f xs


--------------------------------------------------------------------------------
withInit :: (a -> a) -> [a] -> [a]
withInit _ []       = []
withInit _ (x : []) = [x]
withInit f (x : xs) = f x : withInit f xs