----------------------------------------------------------------------
-- |
-- 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