{-# LANGUAGE OverloadedStrings #-} module Main where import qualified Data.Text as T import Lens.Family import qualified System.Console.GetOpt as Opt import qualified System.Environment as Sys import qualified System.Exit as Sys import qualified Charter as C data Option = AddBinary T.Text | SetCategory T.Text | SetSynopsis T.Text | SetDescription T.Text | SetLicense T.Text | SetRoot T.Text | AddMod T.Text | AddDep T.Text | AddUsualDeps deriving (Eq, Show, Ord) options :: [Opt.OptDescr Option] options = [ Opt.Option ['b'] ["bin"] (Opt.ReqArg (AddBinary . T.pack) "PROGRAM NAME") "Add another binary target to this Cabal file" , Opt.Option ['m'] ["module"] (Opt.ReqArg (AddMod . T.pack) "MODULE NAME") "Add another library module to this Cabal file" , Opt.Option ['r'] ["root"] (Opt.ReqArg (SetRoot . T.pack) "DIRECTORY") "Set the root directory for this project" , Opt.Option ['c'] ["category"] (Opt.ReqArg (SetCategory . T.pack) "CATEGORY") "Set the category for this project" , Opt.Option ['s'] ["synopsis"] (Opt.ReqArg (SetSynopsis . T.pack) "SYNOPSIS") "Set the synopsis for this project" , Opt.Option ['d'] ["description"] (Opt.ReqArg (SetDescription . T.pack) "DESCRIPTION") "Set the description for this project" , Opt.Option ['l'] ["license"] (Opt.ReqArg (SetLicense . T.pack) "LICENSE") "Set the license for this project" , Opt.Option ['a'] ["add-dep"] (Opt.ReqArg (AddDep . T.pack) "PACKAGE") "Add a dependency to this application" , Opt.Option ['A'] ["add-usual-deps"] (Opt.NoArg AddUsualDeps) "Add the typical set of dependencies to this application" ] usageInfo :: String usageInfo = Opt.usageInfo header options where header = "Usage: charter (quick|executable|library) [name]" process :: [Option] -> C.Project -> Either String C.Project process opts p = foldl (>>=) (return p) (map go opts) where go (AddBinary n) proj = return $ proj & C.binDetails %~ (C.mkBinary n :) go (AddMod m) proj = return $ proj & C.libDetails %~ fmap (& C.libMods %~ (m :)) go (SetCategory s) proj = return $ proj & C.projectDetails . C.projectCategory .~ Just s go (SetSynopsis s) proj = return $ proj & C.projectDetails . C.projectSynopsis .~ Just s go (SetDescription s) proj = return $ proj & C.projectDetails . C.projectDescription .~ Just s go (SetLicense license) proj | not (license `elem` C.validLicenses) = Left $ concat [ "Unknown license: `" , T.unpack license , "'\n\nValid Cabal licenses include:\n - " , T.unpack (T.intercalate "\n - " C.validLicenses) ] | otherwise = return $ proj & C.projectDetails . C.projectLicense .~ Just license go (SetRoot _) proj = return proj go (AddDep dep) proj = return $ proj & C.binDetails %~ fmap (& C.execDeps %~ (dep :)) & C.libDetails %~ fmap (& C.libDeps %~ (dep :)) go (AddUsualDeps) proj = return $ proj & C.binDetails %~ fmap (& C.execDeps %~ (C.usualDeps ++)) & C.libDetails %~ fmap (& C.libDeps %~ (C.usualDeps ++)) setupProject :: String -> String -> IO C.Project setupProject typ name = do details <- C.projectDefaults (T.pack name) case typ of "quick" -> return (C.quickBin details) "executable" -> return (C.projectBin details) "library" -> return (C.library details) _ -> Sys.die ("unknown project type: " ++ typ ++ "\n" ++ usageInfo) main :: IO () main = do args <- Sys.getArgs case Opt.getOpt Opt.Permute options args of (os, [typ, name], []) -> do proj <- process os <$> setupProject typ name case proj of Right p -> C.createProject p Left err -> Sys.die err (_, _, errs) -> do mapM_ putStrLn errs Sys.die usageInfo