charter/charter/Main.hs

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