-- | An abstract syntax tree for Cabal files.  There are thoughts in
-- the "Cartel" module documentation on why this wheel is reinvented
-- rather than reusing the types already available in the Cabal
-- library.
--
-- The 'Cabal' data type represents the root of the Cabal file; all
-- other types in this file are ultimately components of the 'Cabal'
-- type.
--
-- Much documentation in this module is copied from the
-- /Developing Cabal Packages/ guide at
--
-- <http://www.haskell.org/cabal/users-guide/developing-packages.html>

module Cartel.Ast
  (
  -- * Constraint trees
    Logical(..)
  , Version(..)
  , Constraint(..)
  , ConstrTree(..)

  -- * Global package description
  , BuildType(..)
  , License(..)
  , Compiler(..)
  , Properties(..)

  -- * Repositories
  , RepoKind(..)
  , Vcs(..)
  , Repository(..)

  -- * Flags
  , Flag(..)

  -- * Build information
  , Package(..)
  , Language(..)
  , BuildInfoField(..)

  -- * Conditionals
  , Condition(..)
  , CondTree(..)
  , CondBlock(..)

  -- * Libraries
  , LibraryField(..)
  , Library(..)

  -- * Executables
  , ExecutableField(..)
  , Executable(..)

  -- * Test suites
  , TestSuiteType(..)
  , TestSuiteField(..)
  , TestSuite(..)

  -- * Benchmarks
  , BenchmarkField(..)
  , Benchmark(..)

  -- * Cabal
  , Cabal(..)

  ) where

-- | A version number.  The Cabal documentation says this
-- \"usually\" consists of a sequence of natural numbers separated
-- by dots.  Though this suggests that a version number could
-- contain something other than natural numbers, in fact the types
-- in the Cabal library do not allow anything other than numbers and
-- you will get a parse error if you try to use anything else.
--
-- Therefore Cartel's 'Version' type only allows a list of 'Int' in
-- a version number.
newtype Version = Version { unVersion :: [Int] }
  deriving (Eq, Ord, Show)

data BuildType
  = Simple
  | Configure
  | Make
  | Custom
  deriving (Eq, Ord, Show)

data License
  = GPL
  | AGPL
  | LGPL
  | BSD2
  | BSD3
  | BSD4
  | MIT
  | MPL
  | Apache
  | PublicDomain
  | AllRightsReserved
  | OtherLicense
  deriving (Eq, Ord, Show)

data Compiler
  = GHC
  | NHC
  | YHC
  | Hugs
  | Helium
  | JHC
  | LHC
  deriving (Eq, Ord, Show)

-- | A version constraint; used primarily when specifying the build
-- dependencies of a package.  For example, to specify
-- @less than version 1.0@, use @Constraint LT (Version [1,0])@.
--
-- There is no way to express @less than or equal to@ or @greater
-- than or equal to@; for that, use 'ConstrTree'.
data Constraint = Constraint
  { csComparison :: Ordering
  , csVersion :: Version
  } deriving (Eq, Ord, Show)

data Logical
  = Or
  | And
  deriving (Eq, Ord, Show)

-- | Expresses a tree of constraints.  This is how you represent
-- more complex dependency relationships.  For example, to represent
-- @less than or equal to version 1.0@, use
--
-- >> let one = Version [1,0]
-- >> in Branch Or (Constraint LT one) (Constraint EQ one)
--
-- Combinators in "Cartel.Tools" help you build the most common
-- cases.
data ConstrTree
  = Leaf Constraint
  | Branch Logical ConstrTree ConstrTree
  deriving (Eq, Ord, Show)

-- | Global package properties.  Most of the 'String' fields are
-- optional; to leave them blank, use the empty string.  To future
-- proof your code, use 'Cartel.Empty.empty', which provides
-- this record already filled in with default values (which are
-- typically blank.)  Then you only alter the fields you wish to
-- fill in.

data Properties = Properties
  { prName :: String
  -- ^ Unique name of package, without the version number

  , prVersion :: Version
  -- ^ Package version number

  , prCabalVersion :: (Int, Int)
  -- ^ Version of Cabal that the package uses; for instance, for
  -- 1.20, use @(1, 20)

  , prBuildType :: BuildType

  , prLicense :: License

  , prLicenseFile :: String
  -- ^ The file containing the precise copyright license

  , prLicenseFiles :: [String]
  -- ^ Multiple license files; use in addition to, or instead of,
  -- 'prLicenseFile'

  , prCopyright :: String
  -- ^ Copyright notice; typically the name of the holder of the
  -- copyright and the year(s) for which copyright is claimed

  , prAuthor :: String
  -- ^ Original package author

  , prMaintainer :: String
  -- ^ Current package maintainer; this is an email address to which
  -- users should send bug reports, feature requests, and patches.

  , prStability :: String
  -- ^ Package stability level, e.g. @alpha@, @stable@, etc.

  , prHomepage :: String
  -- ^ URL of package homepage

  , prBugReports :: String
  -- ^ URL where users should direct bug reports.  Should be either
  -- a @mailto:@ URL for a person or mailing list, or an @http:@ or
  -- @https:@ URL for an online bug tracking system.

  , prPackageUrl :: String
  -- ^ The location of a source bundle for the package.

  , prSynopsis :: String
  -- ^ Short, one-line synopsis of what the package does

  , prDescription :: [String]
  -- ^ Each line of the long description.  Do not include the
  -- newlines themselves.  If you wish to include a blank line,
  -- include a list item that is the empty string; upon rendering, a
  -- single period will be inserted, as Cabal requires when
  -- inputting blank lines.

  , prCategory :: String
  -- ^ A comma-separated list of categories to use on Hackage.

  , prTestedWith :: [(Compiler, ConstrTree)]
  -- ^ Compilers and versions against which the package has been
  -- tested.

  , prDataFiles :: [String]
  -- ^ List of files to be installed for run-time use by the
  -- package.

  , prDataDir :: String
  -- ^ The directory where Cabal looks for data files to install,
  -- relative to the source directory.  By default Cabal looks in
  -- the source directory itself.

  , prExtraSourceFiles :: [String]
  -- ^ List of additional files to be included in source
  -- distributions built with @setup sdist@.  This can use a limited
  -- form of @*@ wildcards in file names.

  , prExtraDocFiles :: [String]
  -- ^ List of additional files to be included in source
  -- distributions, and also copied to the html directory when
  -- Haddock documentation is generated. As with data-files it can
  -- use a limited form of @*@ wildcards in file names.

  , prExtraTmpFiles :: [String]
  -- ^ List of additional files or directories to be removed by
  -- @setup clean@.  These would typically be additional files
  -- created by additional hooks.

  } deriving (Eq, Ord, Show)

-- | A field in the @Library@ section of the Cabal file.  A
-- @Library@ section can have multiple fields.
data LibraryField
  = LibExposedModules [String]
  -- ^ Exposed modules.  'Cartel.Tools.modules' can help you
  -- generate this.

  | LibExposed Bool
  -- ^ Is the library exposed?  GHC can hide libraries.

  | LibConditional (CondBlock LibraryField)
  -- ^ The @Library@ section can contain conditional blocks.

  | LibInfo BuildInfoField
  -- ^ The @Library@ section can contain build information.
  deriving (Eq, Ord, Show)

-- | The entire @Library@ section.
newtype Library = Library
  { libFields :: [LibraryField]
  } deriving (Eq, Ord, Show)

-- | A single field in an @Executable@ section.  An @Executable@
-- section may have multiple fields.
data ExecutableField

  = ExeMainIs String
  -- ^ @main-is@.  This field is required.

  | ExeConditional (CondBlock ExecutableField)
  -- ^ An @Executable@ section can contain conditional blocks.

  | ExeInfo BuildInfoField
  -- ^ An @Executable@ section can contain one or more build
  -- information fields.

  deriving (Eq, Ord, Show)

-- | An entire @Executable@ section.
data Executable = Executable
  { exeName :: String
  -- ^ The name of the executable that Cabal will build.
  , exeFields :: [ExecutableField]
  -- ^ Zero or more fields associated with this executable.
  } deriving (Eq, Ord, Show)

-- | What kind of test suite is this?
data TestSuiteType
  = ExitcodeStdio
  -- ^ An @exitcode-stdio-1.0@ test.  The @String@ is the name of
  -- the file containing the executable code.  In this case, the
  -- 'TestMainIs' field is required.

  | Detailed
  -- ^ The @detailed-1.0@ test.  In this case, the 'TestModule'
  -- field is required.
  deriving (Eq, Ord, Show)

-- | A single field value in a test suite section.  A single test
-- suite section may contain mulitple fields.
data TestSuiteField
  = TestType TestSuiteType
  -- ^ What kind of test this is

  | TestMainIs String
  -- ^ The name of the @.hs@ or @.lhs@ file containing the @Main@
  -- module.  The @.hs@ filename must be listed, even if that file
  -- is generated with a preprocessor.  The file must be relatie to
  -- one of the directories listed in 'HsSourceDirs'.  This field
  -- is required when using 'ExitcodeStdio' and disallowed when
  -- using 'Detailed'.

  | TestModule String
  -- ^ The module exporting the @tests@ symbol.  This field is
  -- required when using 'Detailed' and disallowed when using
  -- 'ExitcodeStdio'.

  | TestConditional (CondBlock TestSuiteField)
  -- ^ A test may contain zero or more conditional blocks.

  | TestInfo BuildInfoField
  -- ^ A test suite can contain build information fields.

  deriving (Eq, Ord, Show)

-- | An entire test suite section.
data TestSuite = TestSuite
  { tsName :: String
  -- ^ The executable name of the resulting test suite
  , tsFields :: [TestSuiteField]
  -- ^ Zero or more fields configuring the test.
  } deriving (Eq, Ord, Show)

-- | A single field in a @Benchmark@ section.  Because Cabal
-- currently supports only one benchmark interface, which is
-- @exitcode-stdio-1.0@, all Cartel-generated files using benchmarks
-- will have benchmarks of this type.
data BenchmarkField
  = BenchmarkConditional (CondBlock BenchmarkField)
  -- ^ A benchmark can have conditional blocks.
  | BenchmarkInfo BuildInfoField
  -- ^ A benchmark can have build information fields.
  deriving (Eq, Ord, Show)

data Benchmark = Benchmark
  { bmName :: String
  -- ^ The name of the benchmark that will be built
  , bmMainIs :: String
  -- ^ The @.hs@ or @.lhs@ file containing the @Main@ module.
  , bmFields :: [BenchmarkField]
  -- ^ Zero or more benchmark fields.
  } deriving (Eq, Ord, Show)

-- | A single package, consisting of a package name and an optional
-- set of constraints.  Used when specifying 'BuildDepends',
-- 'BuildTools', and 'PkgConfigDepends'.
data Package = Package
  { packName :: String
  , packConstraints :: Maybe ConstrTree
  } deriving (Eq, Ord, Show)

-- | Default language.  Currently not documented in Cabal docs, see
--
-- <https://github.com/haskell/cabal/issues/1894>
data Language
  = Haskell98
  | Haskell2010
  deriving (Eq, Ord, Show)

-- | A single field of build information.  This can appear in a
-- Library, Executable, Test-Suite, or Benchmark.
data BuildInfoField
  = BuildDepends [Package]
  -- ^ A list of packages needed to build this component

  | OtherModules [String]
  -- ^ Modules used but not exposed.  For libraries, these are
  -- hidden modules; for executable, these are auxiliary modules to
  -- be linked with the file in the @main-is@ field.
  --
  -- 'Cartel.Tools.modules' can help greatly with maintenance of
  -- this field.

  | HsSourceDirs [String]
  -- ^ Root directories for the module hierarchy

  | Extensions [String]
  -- ^ Haskell extensions used by every module.

  | BuildTools [Package]
  -- ^ Programs needed to build this package, such as c2hs.

  | Buildable Bool
  -- ^ Is this component buildable?

  | GHCOptions [String]
  | GHCProfOptions [String]
  | GHCSharedOptions [String]
  | HugsOptions [String]
  | Nhc98Options [String]
  | Includes [String]
  -- ^ Header files to be included in any compilations via C.
  -- Applies to both header files that are already installed on the
  -- system and to those coming with the package to be installed.

  | InstallIncludes [String]
  -- ^ Header files to be installed into @$libdir/includes@ when the
  -- package is installed.  These files should be found in relative
  -- to the top of the source tree or relative to one of the
  -- directories listed in @include-dirs@.

  | IncludeDirs [String]
  -- ^ List of diretories to search for header files when dealing
  -- with C compilations.

  | CSources [String]
  -- ^ C sources to be compiled and lined with the Haskell files.

  | ExtraLibraries [String]
  -- ^ Extra libraries to link with.

  | ExtraLibDirs [String]
  -- ^ Directories to search for libraries.

  | CCOptions [String]
  -- ^ C Compiler options.

  | CPPOptions [String]
  -- ^ C Preprocessor options.  Undocumented, see
  -- <https://github.com/haskell/cabal/issues/646>

  | LDOptions [String]
  -- ^ Linker options.

  | PkgConfigDepends [Package]
  -- ^ List of pkg-config packages needed to build this component.

  | Frameworks [String]
  -- ^ OS X frameworks.

  | DefaultLanguage Language
  deriving (Eq, Ord, Show)

-- | Conditions to use in the @if@ statement when defining
-- conitional blocks.
data Condition
  = OS String
  -- ^ Operating system; tested against @System.Info.os@ on the
  -- target system.

  | Arch String
  -- ^ Argument is matched against @System.Info.arch@ on the target
  -- system.

  | Impl (Compiler, Maybe ConstrTree)
  -- ^ Tests for the configured Haskell implementation.

  | CFlag String
  -- ^ Evaluates to the current assignment of the flag of the given
  -- name.  Flag names are case insensitive.  Testing for flags that
  -- have not been introduced with a flag section is an error.

  | CTrue
  -- ^ Always true.

  | CFalse
  -- ^ Always false.

  deriving (Eq, Ord, Show)

-- | Tree of conditions to use in a 'CondBlock'.
data CondTree
  = CLeaf Condition
  | CBranch Logical CondTree CondTree
  | CNegate CondTree
  deriving (Eq, Ord, Show)

-- | An @if-then-else@ block.
data CondBlock a = CondBlock
  { condIf :: CondTree
  , ifTrue :: [a]
  , ifElse :: [a]
  } deriving (Eq, Ord, Show)

instance Functor CondBlock where
  fmap f (CondBlock t ts es) = CondBlock t (map f ts) (map f es)

-- | What kind of VCS repository is this?
data RepoKind

  = Head
  -- ^ The latest development branch of the repository

  | This
  -- ^ The sources for this release of this package.
  deriving (Eq, Ord, Show)

data Vcs
  = Darcs
  | Git
  | Svn
  | Cvs String
  -- ^ The argument 'String' is the named module
  | Mercurial
  | Bazaar
  | ArchVcs
  | Monotone
  deriving (Eq, Ord, Show)

data Repository = Repository
  { repoVcs :: Vcs
  -- ^ Specifies the version control system in use.

  , repoKind :: RepoKind
  -- ^ Whether this is a @head@, which refers to the latest
  -- development branch of the package, or a @this@, which contains
  -- the sources for this release of the package.

  , repoLocation :: String
  -- ^ A URL giving the location of the repository.  Will vary by
  -- repository type; for git, you may use a @git://@ URL, for
  -- example.  This field is required.

  , repoBranch :: String
  -- ^ For example, CVS, SVN, and git can have multiple branches in
  -- a single repository; darcs cannot.  If you need to specify a
  -- branch, do it here.  This field is optional.

  , repoTag :: String
  -- ^ A repository tag.  It is required for the @this@ repo kind.
  -- It is optional for the @head@ repo kind.  The tag will often be
  -- a version number of some kind and should point the user to the
  -- sources in the repo that correspond to a particular package
  -- version.

  , repoSubdir :: String
  -- ^ Some projects put the sources for multiple packages under a
  -- single source repository. This field lets you specify the
  -- relative path from the root of the repository to the top
  -- directory for the package, ie the directory containing the
  -- package’s .cabal file.
  --
  -- This field is optional. It defaults to empty which corresponds
  -- to the root directory of the repository.

  } deriving (Eq, Ord, Show)

-- | A single flag.
data Flag = Flag
  { flName :: String
  -- ^ The name of the flag; other parts of the Cabal file refer to
  -- the flag using this name.

  , flDescription :: String
  -- ^ A description of the flag (typically one line long.)

  , flDefault :: Bool
  -- ^ Default value of this flag.

  , flManual :: Bool
  -- ^ If True, then Cabal will not change this flag's value as it
  -- tries to build the package.  If False, then Cabal will first
  -- try to satisfy dependencies with the default flag value and
  -- then, if that is not possible, with the negated value.

  } deriving (Eq, Ord, Show)

-- | Data for the entire Cabal file.
data Cabal = Cabal
  { cProperties :: Properties
  , cRepositories :: [Repository]
  , cFlags :: [Flag]
  , cLibrary :: Maybe Library
  , cExecutables :: [Executable]
  , cTestSuites :: [TestSuite]
  , cBenchmarks :: [Benchmark]
  } deriving (Eq, Ord, Show)