restyle-0.1.0: Main.hs
----------------------------------------------------------------------
-- |
-- Module : Main
-- Copyright : (c) 2010 Daniel Fischer
-- Licence : MIT
--
-- Maintainer : Daniel Fischer <daniel.is.fischer@web.de>
-- Stability : experimental
-- Portability : portable
--
-- The executable to convert single files or entire directory trees
-- between camel case and separated words style.
----------------------------------------------------------------------
module Main (main) where
import System.Environment (getArgs)
import System.Console.GetOpt
import System.Directory
import System.FilePath
import qualified System.IO.UTF8 as S
import Data.Char (isAlphaNum)
import Data.Version
import Data.List
import Control.Monad (when)
import Data.Transform.Camel
import Data.Transform.UnCamel
import Data.Transform.Separators
main :: IO ()
main = do
args <- getArgs
case getWork args of
Left str -> putStrLn str
Right cf -> do
let proc = worker cf
shibboleth = case fileType cf of
HTML -> (== ".html") . takeExtension
HS -> (== ".hs") . takeExtension
case input cf of
Just (Left fn) -> let outfile = case output cf of
Left ou -> ou
Right d -> joinPath [d,fn]
in do
createDirectoryIfMissing True (takeDirectory outfile)
transform proc fn outfile
Just (Right dir) -> let look = case recursive cf of
Just b -> b
Nothing -> error "Insanity!!"
odir = case output cf of
Right d -> d
in labour (transform proc) shibboleth look dir odir
labour :: (FilePath -> FilePath -> IO ()) -> (FilePath -> Bool) -> Bool -> FilePath -> FilePath -> IO ()
labour tf test more ind odir = do
isd <- doesDirectoryExist ind
when isd $ do
createDirectoryIfMissing True odir
conts <- getDirectoryContents ind
(dirs,files) <- partitionDirs (ind </>) $ filter ((/= '.') . head) conts
let rdirs
| more = dirs
| otherwise = []
(wrk,cpy) = partition test files
mapM_ (\fn -> tf (ind </> fn) (odir </> fn)) wrk
mapM_ (\fn -> copyFile (ind </> fn) (odir </> fn)) cpy
mapM_ (\dr -> labour tf test more (ind </> dr) (odir </> dr)) rdirs
transform :: (String -> String) -> FilePath -> FilePath -> IO ()
transform process infile outfile
= S.readFile infile >>= S.writeFile outfile . process
partitionDirs :: (FilePath -> FilePath) -> [FilePath] -> IO ([FilePath],[FilePath])
partitionDirs jn = partDirs jn [] []
partDirs :: (FilePath -> FilePath) -> [FilePath] -> [FilePath] -> [FilePath] -> IO ([FilePath],[FilePath])
partDirs _ dirs files [] = return (dirs,files)
partDirs jn dirs files (fp : fps) = do
isDir <- doesDirectoryExist (jn fp)
if isDir
then partDirs jn (fp:dirs) files fps
else partDirs jn dirs (fp:files) fps
myVersion :: Version
myVersion = Version{ versionBranch = [0,1,0], versionTags = [] }
worker :: Config -> String -> String
worker cf = f s
where
s = case separator cf of
Hyphen -> hyphen
Under -> lowLine
DoubleLow -> doubleLowLine
WideLow -> wideLowLine
Other c -> c
f = case fileType cf of
HTML -> unCamelHTML
HS -> case target cf of
Camel -> camelSource
Sep -> unCamelSource
data Config
= Conf
{ info :: Bool
, version :: Bool
, fileType :: FileType
, target :: Target
, separator :: Separator
, recursive :: Maybe Bool
, input :: Maybe (Either FilePath Directory)
, output :: Either FilePath Directory
}
defaultConf :: Config
defaultConf
= Conf
{ info = False
, version = False
, fileType = HS
, target = Sep
, separator = Hyphen
, recursive = Just True
, input = Nothing
, output = Right "Restyled"
}
data FileType = HTML | HS
data Target = Camel | Sep
data Separator = Hyphen | Under | DoubleLow | WideLow | Other Char
type Directory = FilePath
sanitiseConfig :: Config -> Config
sanitiseConfig cf
| insane cf = cf{ info = True }
| otherwise = cf
insane :: Config -> Bool
insane cf
| info cf || version cf = False
insane (Conf{ fileType = HTML, target = Camel }) = True
insane (Conf{ input = Nothing }) = True
insane (Conf{ input = Just (Left _), recursive = Just _ }) = True
insane (Conf{ fileType = HTML, input = Just (Left fn) })
| takeExtension fn /= ".html" = True
insane (Conf{ fileType = HS, input = Just (Left fn) })
| takeExtension fn /= ".hs" = True
insane cf@(Conf{ input = Just (Right _) }) = case output cf of
Left _ -> True
_ -> case recursive cf of
Nothing -> True
_ -> False
insane _ = False
options :: [OptDescr (Config -> Config)]
options =
[ Option ['?','h'] ["help","usage","info"] (NoArg (\cf -> cf{ info = True }))
"Print this message."
, Option ['V'] ["version"] (NoArg (\cf -> cf{ version = True }))
"Print version number and exit."
, Option ['H'] ["HTML","html"] (NoArg (\cf -> cf{ fileType = HTML, target = Sep }))
"UnCamel html file[s]"
{- , Option ['S'] ["source","hs","haskell"] (NoArg (\cf -> cf{ fileType = HS }))
"Process Haskell source code (default)."
, Option ['t'] ["target"] (ReqArg parseT "c[amel]|u[ncamel]|s[eparate_words]")
"Target of transformation. Default is separate_words. Target camel doesn't work with HTML files." -}
, Option ['c'] ["camel"] (NoArg (\cf -> cf{ fileType = HS, target = Camel }))
"Transform source to camel case. Inconsistent with --html."
, Option ['s'] ["sep","separator"] (ReqArg parseS "SEP")
"Separation character to insert or remove (default is Unicode hyphen [U+2010], must not be alphanumeric)."
{- , Option ['h'] ["hyphen"] (NoArg (\cf -> cf{ separator = Hyphen }))
"Hyphen as separation character (default)." -}
, Option ['u'] ["underscore"] (NoArg (\cf -> cf{ separator = Under }))
"Underscore as separation character."
, Option ['d'] ["double"] (NoArg (\cf -> cf{ separator = DoubleLow }))
"Double low line as separation character."
, Option ['w'] ["wide"] (NoArg (\cf -> cf{ separator = WideLow }))
"Wide low line as separation character."
{- , Option ['r'] ["rec"] (NoArg (\cf -> cf{ recursive = Just True }))
"Transform directory contents recursively (default)." -}
, Option ['n'] ["nonrec"] (NoArg (\cf -> cf{ recursive = Just False }))
"Ignore subdirectories and only treat files in INDIR. Default is recursively processing subdirectories."
, Option ['f'] ["file"] (ReqArg parseF "INFILE")
"Transform only specified file, which must have a .hs or .html extension."
, Option ['i','D'] ["indir","dir"] (ReqArg (\dr cf -> cf{ input = Just (Right dr) }) "INDIR")
"Directory whose contents is to be transformed. Either this option or the file option is mandatory."
, Option ['o'] ["out","odir"] (ReqArg (\dr cf -> cf{ output = Right dr }) "OUTDIR")
"Directory in which to write processed files. This better be not INDIR and in case of recursive processing neither a subdirectory thereof. Default is 'Restyled'."
, Option ['t'] ["ofile","outfile"] (ReqArg (\fn cf -> cf{ output = Left fn }) "OUTFILE")
"Name of file to write (only if a single file is processed). Must be different from INFILE. Inconsistent with --odir."
]
parseT :: String -> Config -> Config
parseT str cf
= case str of
('c':_) -> cf{ fileType = HS, target = Camel }
('u':_) -> cf{ target = Sep }
('s':_) -> cf{ target = Sep }
_ -> cf{ info = True }
parseS :: String -> Config -> Config
parseS str cf
= case str of
(h:_) | not (isAlphaNum h) -> cf{ separator = Other h }
_ -> cf{ info = True }
parseF :: String -> Config -> Config
parseF str cf
= case takeExtension str of
ext | ext == ".hs" -> cf{ fileType = HS, recursive = Nothing, input = Just (Left str) }
| ext == ".html" -> cf{ fileType = HTML, target = Sep, recursive = Nothing, input = Just (Left str) }
_ -> cf{ info = True }
generalUsage :: String
generalUsage = unlines
[ "Usage: restyle OPTIONS"
, "At least one of the options --help, --version, --indir=INDIR, --file=INFILE or their equivalents must be given."
, "Unless otherwise specified, restyle converts Haskell source files from camel case to separated words."
, "If an entire directory (hierarchy) shall be converted, files of other types are copied to the target location to create a working source or documentation tree with minimal effort."
, "Conflicting options may be resolved in an arbitrary manner. If the order of the conflicting options doesn't lead to an automatic resolution, this message is displayed."
]
getWork :: [String] -> Either String Config
getWork args
= case getOpt RequireOrder options args of
(o,n,e)
| null n && null e -> case foldl (flip id) defaultConf o of
cf | info cf -> Left usage
| version cf -> Left (showVersion myVersion)
| otherwise -> Right cf
| otherwise -> Left (concat e ++ unlines n ++ usage)
where
usage = usageInfo generalUsage options