summaryrefslogtreecommitdiffhomepage
path: root/lib/Language/Haskell/Stylish.hs
blob: a767889e7ad273880d37fb82f0203fa950afac84 (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
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
{-# LANGUAGE LambdaCase #-}
--------------------------------------------------------------------------------
module Language.Haskell.Stylish
    ( -- * Run
      runSteps
      -- * Steps
    , simpleAlign
    , imports
    , languagePragmas
    , tabs
    , trailingWhitespace
    , unicodeSyntax
      -- ** Helpers
    , findHaskellFiles
    , stepName
      -- * Config
    , module Language.Haskell.Stylish.Config
      -- * Misc
    , module Language.Haskell.Stylish.Verbose
    , version
    , format
    , ConfigPath(..)
    , Lines
    , Step
    ) where


--------------------------------------------------------------------------------
import           Control.Monad                                    (foldM)
import           System.Directory                                 (doesDirectoryExist,
                                                                   doesFileExist,
                                                                   listDirectory)
import           System.FilePath                                  (takeExtension,
                                                                   (</>))

--------------------------------------------------------------------------------
import           Language.Haskell.Stylish.Config
import           Language.Haskell.Stylish.Parse
import           Language.Haskell.Stylish.Step
import qualified Language.Haskell.Stylish.Step.Imports            as Imports
import qualified Language.Haskell.Stylish.Step.LanguagePragmas    as LanguagePragmas
import qualified Language.Haskell.Stylish.Step.SimpleAlign        as SimpleAlign
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                            (version)


--------------------------------------------------------------------------------
simpleAlign :: Maybe Int  -- ^ Columns
            -> SimpleAlign.Config
            -> Step
simpleAlign = SimpleAlign.step


--------------------------------------------------------------------------------
imports :: Maybe Int -- ^ columns
        -> Imports.Options
        -> Step
imports = Imports.step


--------------------------------------------------------------------------------
languagePragmas :: Maybe Int -- ^ columns
                -> LanguagePragmas.Style
                -> Bool -- ^ Pad to same length in vertical mode?
                -> Bool -- ^ remove redundant?
                -> String -- ^ language prefix
                -> Step
languagePragmas = LanguagePragmas.step


--------------------------------------------------------------------------------
tabs :: Int -- ^ number of spaces
     -> Step
tabs = Tabs.step


--------------------------------------------------------------------------------
trailingWhitespace :: Step
trailingWhitespace = TrailingWhitespace.step


--------------------------------------------------------------------------------
unicodeSyntax :: Bool -- ^ add language pragma?
              -> String -- ^ language prefix
              -> Step
unicodeSyntax = UnicodeSyntax.step


--------------------------------------------------------------------------------
runStep :: Extensions -> Maybe FilePath -> Lines -> Step -> Either String Lines
runStep exts mfp ls = \case
  Step _name step ->
    step ls <$> parseModule exts mfp (unlines ls)

--------------------------------------------------------------------------------
runSteps ::
     Extensions
  -> Maybe FilePath
  -> [Step]
  -> Lines
  -> Either String Lines
runSteps exts mfp steps ls =
 foldM (runStep exts mfp) ls steps

newtype ConfigPath = ConfigPath { unConfigPath :: FilePath }

-- |Formats given contents optionally using the config provided as first param.
-- The second file path is the location from which the contents were read.
-- If provided, it's going to be printed out in the error message.
format :: Maybe ConfigPath -> Maybe FilePath -> String -> IO (Either String Lines)
format maybeConfigPath maybeFilePath contents = do
  conf <- loadConfig (makeVerbose True) (fmap unConfigPath maybeConfigPath)
  pure $ runSteps (configLanguageExtensions conf) maybeFilePath (configSteps conf) $ lines contents


--------------------------------------------------------------------------------
-- | Searches Haskell source files in any given folder recursively.
findHaskellFiles :: Bool -> [FilePath] -> IO [FilePath]
findHaskellFiles v fs = mapM (findFilesR v) fs >>= return . concat


--------------------------------------------------------------------------------
findFilesR :: Bool -> FilePath -> IO [FilePath]
findFilesR _ []   = return []
findFilesR v path = do
  doesFileExist path >>= \case
    True -> return [path]
    _    -> doesDirectoryExist path >>= \case
      True  -> findFilesRecursive path >>=
        return . filter (\x -> takeExtension x == ".hs")
      False -> do
        makeVerbose v ("Input folder does not exists: " <> path)
        findFilesR v []
  where
    findFilesRecursive :: FilePath -> IO [FilePath]
    findFilesRecursive = listDirectoryFiles findFilesRecursive

    listDirectoryFiles :: (FilePath -> IO [FilePath])
                       -> FilePath -> IO [FilePath]
    listDirectoryFiles go topdir = do
      ps <- listDirectory topdir >>=
        mapM (\x -> do
                 let dir = topdir </> x
                 doesDirectoryExist dir >>= \case
                   True  -> go dir
                   False -> return [dir])
      return $ concat ps