module Main (main) where
import Control.Applicative (many, (<**>))
import Data.Foldable (for_)
import System.Directory (doesDirectoryExist, getDirectoryContents)
import System.Exit (exitFailure)
import System.FilePath (takeDirectory, (</>))
import System.IO.Unsafe (unsafeInterleaveIO)
import qualified Data.ByteString as BS
import qualified Options.Applicative as O
import CabalFmt (cabalFmt)
import CabalFmt.Error (renderError)
import CabalFmt.Monad (runCabalFmt)
import CabalFmt.Options
main :: IO ()
main = do
(inplace, opts', filepaths) <- O.execParser optsP'
-- glob all files, only when a single filepath is given.
files <- case filepaths of
[fp] -> getFiles (takeDirectory fp)
_ -> return []
let opts = opts' { optFileList = files }
case filepaths of
[] -> BS.getContents >>= main' False opts "<stdin>"
(_:_) -> for_ filepaths $ \filepath ->
BS.readFile filepath >>= main' inplace opts filepath
where
optsP' = O.info (optsP <**> O.helper) $ mconcat
[ O.fullDesc
, O.progDesc "Reformat .cabal files"
, O.header "cabal-fmt - .cabal file reformatter"
]
main' :: Bool -> Options -> FilePath -> BS.ByteString -> IO ()
main' inplace opts filepath input =
case runCabalFmt opts (cabalFmt filepath input) of
Right output
| inplace -> writeFile filepath output
| otherwise -> putStr output
Left err -> do
renderError err
exitFailure
-------------------------------------------------------------------------------
-- Options parser
-------------------------------------------------------------------------------
optsP :: O.Parser (Bool, Options, [FilePath])
optsP = (,,)
<$> O.flag False True (O.short 'i' <> O.long "inplace" <> O.help "process files in-place")
<*> optsP'
<*> many (O.strArgument (O.metavar "FILE" <> O.help "input files"))
where
optsP' = Options
<$> O.option O.auto (O.long "indent" <> O.value (optIndent defaultOptions) <> O.help "Indentation" <> O.showDefault)
<*> pure (optSpecVersion defaultOptions)
<*> pure []
-------------------------------------------------------------------------------
-- Files
-------------------------------------------------------------------------------
getFiles :: FilePath -> IO [FilePath]
getFiles = getDirectoryContentsRecursive' check where
check "dist-newstyle" = False
check ('.' : _) = False
check _ = True
-- | List all the files in a directory and all subdirectories.
--
-- The order places files in sub-directories after all the files in their
-- parent directories. The list is generated lazily so is not well defined if
-- the source directory structure changes before the list is used.
--
-- /Note:/ From @Cabal@'s "Distribution.Simple.Utils"
getDirectoryContentsRecursive'
:: (FilePath -> Bool) -- ^ Check, whether to recurse
-> FilePath -- ^ top dir
-> IO [FilePath]
getDirectoryContentsRecursive' ignore' topdir = recurseDirectories [""]
where
recurseDirectories :: [FilePath] -> IO [FilePath]
recurseDirectories [] = return []
recurseDirectories (dir:dirs) = unsafeInterleaveIO $ do
(files, dirs') <- collect [] [] =<< getDirectoryContents (topdir </> dir)
files' <- recurseDirectories (dirs' ++ dirs)
return (files ++ files')
where
collect files dirs' [] = return (reverse files
,reverse dirs')
collect files dirs' (entry:entries) | ignore entry
= collect files dirs' entries
collect files dirs' (entry:entries) = do
let dirEntry = dir </> entry
isDirectory <- doesDirectoryExist (topdir </> dirEntry)
if isDirectory
then collect files (dirEntry:dirs') entries
else collect (dirEntry:files) dirs' entries
ignore ['.'] = True
ignore ['.', '.'] = True
ignore x = not (ignore' x)