-- | Cartel - a library to specify Cabal files in Haskell
--
-- The Cabal file format works very well for small projects.
-- However, in big projects with a library, many executables, and
-- test suites, some irritations emerge.  You need to specify
-- dependencies in multiple places, leading to redundancy.  You also
-- have to manually add in new modules, make sure you list all
-- modules (a real pain with executables, as problems may arise only
-- after you build a distribution tarball), and update your module
-- lists when you refactor.
--
-- Specifying your Cabal files in Haskell rather than in a
-- plain-text file format helps deal with a lot of these problems.
-- You have the full power of Haskell to make definitions in one
-- place and then reuse them.  You can also dynamically read a tree
-- of modules and use the result, thus avoiding the need to manually
-- update your module lists.
--
-- A disadvantage to Cartel is that is more verbose than a vanilla
-- Cabal file.  In addition, you also have to remember to generate the
-- new Cabal file whenever you change the script that generates your
-- Cabal file.
--
-- To the extent possible, Cartel uses the Haskell type system to
-- prevent you from making mistakes in your Cabal file.  For example,
-- the 'Betsy' type prevents you from using 'flag's that you have not
-- declared, and you can't put an 'exposedModules' field in anything
-- but a library.  However, Cartel does not prevent against all
-- errors.  For example, Cartel does nothing to prevent you from
-- applying a function that calls for a 'NonEmptyString' to a string
-- that is, in fact, empty.  Another example is that Cabal requires
-- executables to have a @main-is@ field, but Cartel does not force
-- you to include one.  Ultimately your Cabal file might still have
-- errors that you have to fix by changing the program that generates
-- the file.
--
-- Everything you usually need is in this module.  Other Cartel
-- modules contain implementation details.  /See first/ the
-- 'NonEmptyString' type synonym, which has important details on how
-- to regard 'String's and 'NonEmptyString's as you read the
-- documentation.  Also, examine "Cartel.GenCartelCabal", which
-- generates Cartel's own Cabal file using Cartel.
--
-- Hopefully this module's documentation is organized so that
-- top-to-bottom reading will make sense.

module Cartel
  ( -- * Basic types and classes
    Word
  , NonEmptyString
  , Blank(..)
  , Version

  -- * Sections
  , Section

  -- * Repositories
  -- ** Version control systems
  , Vcs
  , darcs, git, svn, mercurial, bazaar, archVcs, monotone, cvs

  -- ** Repository kinds
  , RepoKind
  , repoHead, repoThis
  -- ** Building repositories
  , Repository(..)
  , githubHead
  , repository

  -- * Logicals
  , LogicTree(..)
  , invert

  -- ** Constraints
  , Constraint
  , lt
  , gt
  , eq
  , ltEq
  , gtEq
  , anyVersion

  -- ** Conditionals
  , Compiler
  , ghc, nhc, yhc, hugs, helium, jhc, lhc
  , Condition
  , system
  , arch
  , impl
  , flag
  , true
  , false
  , condBlock

  -- * Packages
  , Package
  , package

  -- ** Package helpers
  , closedOpen
  , apiVersion
  , nextBreaking
  , nextMajor
  , exactly
  , unconstrained

  -- * Build information

  -- | Libraries, executables, test suites, and benchmarks all share
  -- common fields for build information.  'BuildInfoField' represents
  -- these common fields, and 'HasBuildInfo' is a typeclass encompassing
  -- libraries, executables, test suites, and benchmarks.  You can
  -- build these fields for any of these sections using the functions
  -- and values listed here.
  , BuildInfoField
  , HasBuildInfo
  , haskell98
  , haskell2010
  , buildDepends
  , otherModules
  , hsSourceDirs
  , extensions
  , buildTools
  , buildable
  , ghcOptions
  , ghcProfOptions
  , ghcSharedOptions
  , hugsOptions
  , nhc98Options
  , includes
  , installIncludes
  , includeDirs
  , cSources
  , extraLibraries
  , extraLibDirs
  , ccOptions
  , cppOptions
  , ldOptions
  , pkgConfigDepends
  , frameworks

  -- * BuildsExe
  --
  -- | Benchmarks, test suites, and executables have common fields;
  -- the 'BuildsExe' class captures these.
  , BuildsExe(..)

  -- * Exitcode executables
  --
  -- | Test suites and benchmarks are capable of building things of
  -- type @exitcode-stdio-1.0@; the 'BuildsExitcode' class reflects
  -- this.
  , BuildsExitcode(..)
  , exitcodeFields

  -- * Betsy
  , Betsy

  -- ** Flags
  , FlagName
  , FlagOpts(..)
  , makeFlag
  , currentFlags

  -- * Libraries
  --
  -- | A library consists of one or more 'LibraryField's.  Typically
  -- you will return these fields inside of the 'Betsy' type through
  -- the 'defaultMain' function.  To build a 'LibraryField', you will
  -- mostly use the bindings in the \"Build Information\" section of
  -- this module.  You will also need 'exposedModules' and you might
  -- use 'exposed' and 'condBlock'.
  , LibraryField
  , exposed
  , exposedModules

  -- * Executables
  --
  -- | An executable consists of one more more 'ExecutableField's.
  -- You build an executable by passing one or more 'ExecutableField's
  -- to the 'executable' function.  To get an 'ExecutableField', you
  -- will mostly use the bindings in the \"Build Information\" section
  -- of this module, as well as 'mainIs'.  You might also need
  -- 'condBlock'.
  , ExecutableField
  , executable

  -- * Test suites
  --
  -- | A test suite consists of one more more 'TestSuiteField's.  You
  -- build an test suite by passing one or more 'TestSuiteField's to
  -- the 'testSuite' function.  To get a 'TestSuiteField', you will
  -- mostly use the bindings in the \"Build Information\" section of
  -- this module.  You might also need the 'testModule',
  -- 'exitcodeStdio', 'mainIs', 'detailed', 'condBlock', and
  -- 'exitcodeFields' bindings.
  , detailed
  , TestSuiteField
  , testModule
  , testSuite

  -- * Benchmarks
  -- 
  -- | A benchmark consists of one more more 'BenchmarkField's.  You
  -- build an benchmark by passing one or more 'BenchmarkField's to
  -- the 'benchmark' function.  To get an 'BenchmarkField', you will
  -- mostly use the bindings in the \"Build Information\" section of
  -- this module.  You might also need the 'exitcodeStdio',
  -- 'exitcodeFields', and 'condBlock' bindings.
  , BenchmarkField
  , benchmark

  -- * Getting module lists
  , fileExtensions
  , modulesWithExtensions
  , modules

  -- * Properties
  -- ** Build types
  , BuildType
  , simple, configure, make, custom
  -- ** Licenses
  , License
  , gpl, agpl, lgpl, bsd2, bsd3, bsd4, mit, mpl, apache, publicDomain
  , allRightsReserved, otherLicense
  , Properties(..)

  -- * Cabal file
  --
  -- | Usually you will not need this type, as 'defaultMain' produces
  -- a 'Cabal' value for you, but you will need it if you want to use
  -- 'bestyToCabalString'.
  , Cabal
  , cabal

  -- * Generating Cabal files
  -- ** defaultMain - usually all you need
  , defaultMain

  -- ** Other bindings - for more unusual uses
  , Error(..)
  , Renderable(..)
  , RenderableIndented(..)
  , renderBetsy
  , betsyToCabalStringIO

  ) where

-- # begin imports

import Cartel.Ast
import Cartel.Render
import qualified System.IO as IO
import Data.Time
import qualified Cartel.Version
import Data.List (intersperse)
import System.Exit (exitFailure, exitSuccess)
import System.Environment (getProgName)
import Data.Word
import Control.Monad.IO.Class
import Cartel.Betsy
import Cartel.Types

-- # end imports

-- | Pure function to obtain Cabal text.
renderBetsy
  :: Functor m
  => Betsy m Cabal
  -> m (Either Error String)
  -- ^ Returns either an error message or the generated Cabal text.
renderBetsy = fmap k . runBetsy
  where
    k ei = case ei of
      Left e -> Left e
      Right (cbl, fls) -> Right
        . vsep
        $ [ renderIndented 0 cbl
          , renderIndented 0 fls ]

-- | Renders a header for the Cabal file.
header
  :: String
  -- ^ Name of program used
  -> ZonedTime
  -- ^ When this output is being created
  -> String
header nm zt = hdr
  where
    hdr = unlines $
      [ "-- This Cabal file generated using the Cartel library."
      , "-- Cartel is available at:"
      , "-- http://www.github.com/massysett/cartel"
      , "--"
      ] ++ case nm of
            [] -> []
            _ -> ["-- Script name used to generate: " ++ nm]
      ++
      [ "-- Generated on: " ++ show zt
      , "-- Cartel library version: " ++ showVer
      ]
    showVer = concat
      . intersperse "."
      . map show
      $ Cartel.Version.version


-- | Like 'renderBetsy' but also uses 'IO' to prepend a header
-- that has the name of the program that is running this function, and
-- the current date and time.
betsyToCabalStringIO
  :: (MonadIO m, Functor m)
  => Betsy m Cabal
  -> m (Either Error String)
betsyToCabalStringIO wg = do
  ei <- renderBetsy wg
  case ei of
    Left e -> return $ Left e
    Right cbl -> do
      pn <- liftIO getProgName
      zt <- liftIO getZonedTime
      return . Right $ (header pn zt) ++ cbl


-- | Generates a Cabal file.  If you have no library, just leave the
-- list of 'LibraryField' empty.  Include any and all executables,
-- test suites, benchmarks, and repositories in the list of 'Section'.
-- Ensures that the generated Cabal file also includes any flags you
-- made with 'makeFlag'.  If there is an error (such as a duplicate
-- flag) an error message is printed to standard error and the program
-- invokes 'exitFailure'; otherwise, the generated Cabal file is
-- printed to standard output and the program invokes 'exitSuccess'.
defaultMain
  :: Betsy IO (Properties, [LibraryField], [Section])
  -> IO ()
defaultMain wg = do
  let conv (p, ls, ss) = Cabal p ls ss
  ei <- betsyToCabalStringIO (fmap conv wg)
  case ei of
    Left e -> do
      IO.hPutStrLn IO.stderr . renderIndented 0 $ e
      exitFailure
    Right str -> do
      IO.hSetBinaryMode IO.stdout False
      IO.hSetEncoding IO.stdout IO.utf8
      putStr str
      exitSuccess