-- | The Cartel abstract syntax tree
--
-- Use this module if you want access to the data constructors in the
-- AST; the functions and values exported through "Cartel" should be
-- enough for most uses.  Use of this module will not violate any
-- invariants; this stuff is in a separate module merely for the sake
-- of tidiness of the documentation in "Cartel".
--
-- Cabal already has an AST that it uses.  Cartel could, perhaps,
-- have re-used these structures.  Cartel does not do this for three
-- reasons.  First, the Cabal API is a bit untidy, partially because
-- it has to do things that Cartel doesn't have to worry about, but
-- also because the comments in the Cabal modules themselves
-- indicate that the whole thing could use a refactoring.  Second,
-- the Cabal developers make no commitment to keep that API stable.
-- Third, the Cartel API tries only to replicate format of the
-- plain-text Cabal file, which will be much more stable than the
-- Cabal API.
module Cartel.Ast where

import qualified Data.Char as C
import qualified System.FilePath as P
import Data.Word
import System.FilePath
import Data.List (sortBy, intersperse)
import Data.Monoid
import qualified System.Directory as D
import Control.Monad.IO.Class
import Cartel.Types
import Cartel.Betsy

-- * Basic types

-- * Blank

-- | Typeclass for things that can be blank.  More specifically,
-- @blank a@ results in an item that, when rendered in a Cabal file,
-- is the null string.  'blank' can be useful to indicate that you
-- have no options, and you can also use it in combination with record
-- syntax when you want to specify just a few options.

class Blank a where
  blank :: a

-- * Repositories

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

repoHead :: RepoKind
repoHead = Head

repoThis :: RepoKind
repoThis = This

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

darcs, git, svn, mercurial, bazaar, archVcs, monotone :: Vcs
cvs
  :: NonEmptyString
  -- ^ The named module
  -> Vcs
darcs = Darcs
git = Git
svn = Svn
cvs = Cvs
mercurial = Mercurial
bazaar = Bazaar
archVcs = ArchVcs
monotone = Monotone

-- | A single @repository@ section.
data Repository = Repository
  { repoVcs :: Maybe Vcs
  -- ^ What kind of 'Vcs' this is.  This is required.

  , repoKind :: Maybe RepoKind
  -- ^ The kind of repository ('repoHead' or 'repoThis').  Required.

  , repoTag :: String
  -- ^ Repository tag.  This is required for the 'repoThis' repository
  -- kind and is optional for the 'repoHead' repository kind.

  , repoLocation :: NonEmptyString
  -- ^ URL for the location of the repository--for example, for a
  -- @darcs@ repo this might be @http:\/\/code.haskell.org\/foo\/@; for
  -- git, this might be @git:\/\/github.com\/foo\/bar.git@.

  , repoBranch :: String
  -- ^ The repository branch.

  , repoSubdir :: String
  -- ^ The repository subdirectory.
  } deriving (Eq, Ord, Show)

instance Blank Repository where
  blank = Repository Nothing Nothing "" "" "" ""

-- | Creates a 'Section' that is a 'Repository' for a Github head.
-- For example, for Cartel, use @githubHead \"massysett\" \"cartel\"@.
githubHead
  :: NonEmptyString
  -- ^ The Github account name
  -> NonEmptyString
  -- ^ The Github project name within the account
  -> Section
githubHead acct proj
  = SecRepo $ blank { repoVcs = Just Git
                    , repoKind = Just Head
                    , repoLocation = loc
                    }
  where
    loc = "https://github.com/" ++ acct ++ "/" ++ proj ++ ".git"

-- | Creates a 'Section' for a repository.
repository :: Repository -> Section
repository = SecRepo

-- * Logicals

-- | Condition; for use in a 'CondTree' and ultimately in a
-- 'CondBlock', which implements Cabal's @if-then-else@ feature.
data CondLeaf
  = OS NonEmptyString
  -- ^ Tests if the current operating system is the given name,
  -- case-insensitive
  | Arch NonEmptyString
  -- ^ Tests if the current architecture is the given name,
  -- case-insensitive
  | Impl Compiler Constraint
  -- ^ Tests for the configured Haskell implementation
  | CFlag FlagName
  -- ^ Evalutes to the current assignment of the flag of the given
  -- name.  To get a flag, use 'makeFlag'.
  | CTrue
  -- ^ Always True
  | CFalse
  -- ^ Always False
  deriving (Eq, Ord, Show)

-- | For use in a 'CondTree' or 'ConstrTree'.
data Logical
  = Or
  | And
  deriving (Eq, Ord, Show)

-- | Whether @or equal to@ comparisions are also true.
newtype OrEqualTo = OrEqualTo Bool
  deriving (Eq, Ord, Show)

-- | Expresses comparisons between versions.
data VersionComp
  = LessThan OrEqualTo
  | GreaterThan OrEqualTo
  | EqualTo
  deriving (Eq, Ord, Show)

-- | Expresses a tree of constraints.  This is how you represent
-- more complex dependency relationships.
data ConstrTree
  = Leaf VersionComp Version
  | Branch Logical ConstrTree ConstrTree
  deriving (Eq, Ord, Show)


-- | Expresses any version constraint, including no version
-- constraint.
data Constraint
  = AnyVersion
  | Constrained ConstrTree
  deriving (Eq, Ord, Show)

-- | Conditions.  Ultimately these are used in a 'CondBlock'.
data Condition
  = CLeaf CondLeaf
  | CBranch Logical Condition Condition
  | CNegate Condition
  deriving (Eq, Ord, Show)

-- | Like 'not', which is what I would have named it but for the
-- conflict.  Only 'Condition's have this sort of operation; Cabal
-- does not have a (documented, at least) way to express this for
-- package constraints.
invert :: Condition -> Condition
invert = CNegate

-- | Conditional blocks.  These implement the @if-then-else@ feature
-- of Cabal files.  You must have at least one thing to do if the
-- condition is True; the if-false block is optional.
data CondBlock a = CondBlock
  { condIf :: Condition
  -- ^ If this condition is true . . . 
  , ifTrue :: (a, [a])
  -- ^ . . . then do this . . .
  , ifFalse :: [a]
  -- ^ . . . or if it's false, do this instead.
  } deriving (Eq, Ord, Show)

instance Functor CondBlock where
  fmap f (CondBlock i (t1, ts) flse)
    = CondBlock i (f t1, fmap f ts) (fmap f flse)

class LogicTree a where
  (&&&) :: a -> a -> a
  (|||) :: a -> a -> a

instance LogicTree Constraint where
  AnyVersion &&& x = x
  Constrained x &&& AnyVersion = Constrained x
  Constrained x &&& Constrained y = Constrained (x &&& y)

  AnyVersion ||| _ = AnyVersion
  Constrained _ ||| AnyVersion = AnyVersion
  Constrained x ||| Constrained y = Constrained (x ||| y)

instance LogicTree ConstrTree where
  l &&& r = Branch And l r
  l ||| r = Branch Or l r

instance LogicTree Condition where
  l &&& r = CBranch And l r
  l ||| r = CBranch Or l r

infixr 3 &&&
infixr 2 |||

-- | Less than
lt :: Version -> Constraint
lt = Constrained . Leaf (LessThan (OrEqualTo False))

-- | Greater than
gt :: Version -> Constraint
gt = Constrained . Leaf (GreaterThan (OrEqualTo False))

-- | Equal to
eq :: Version -> Constraint
eq = Constrained . Leaf EqualTo

-- | Less than or equal to
ltEq :: Version -> Constraint
ltEq = Constrained . Leaf (LessThan (OrEqualTo True))

-- | Greater than or equal to
gtEq :: Version -> Constraint
gtEq = Constrained . Leaf (GreaterThan (OrEqualTo True))

-- | Matches any version at all (in a Cabal file, this is represented
-- as an empty string).
anyVersion :: Constraint
anyVersion = AnyVersion


-- | Creates a package interval that is closed on the left, open on
-- the right.  Useful for the common case under the PVP to specify
-- that you depend on a version that is at least a particular
-- version, but less than another version.
--
-- > closedOpen "bytestring" [0,17] [0,19] ==> bytestring >= 0.17 && < 0.19

closedOpen
  :: NonEmptyString
  -- ^ Package name
  -> Version
  -- ^ Version number for lower bound
  -> Version
  -- ^ Version number for upper bound
  -> Package
  -- ^ Resulting 'Package'
closedOpen n l u = Package n (gtEq l &&& lt u)

-- | Specifies a particular API version.  Useful to lock your
-- package dependencies down to a particular API version.
--
-- > apiVersion "base" [1] ==> base >= 1 && < 2
-- > apiVersion "base" [1,2] ==> base >= 1.2 && < 1.3
-- > apiVersion "base" [1,2,3] ==> base >= 1.2.3 && < 1.2.4

apiVersion :: NonEmptyString -> Version -> Package
apiVersion n v = closedOpen n v u
  where
    u = case v of
      [] -> error "apiVersion: requires a non-empty list argument"
      _ -> init v ++ [succ (last v)]

-- | Depends on the version given, up to the next breaking API
-- change.
--
-- > nextBreaking "base" [4] ==> base >= 4 && < 4.1
-- > nextBreaking "base" [4,1] ==> base >= 4.1 && < 4.2
-- > nextBreaking "base" [4,7,0,0] ==> base >= 4.7.0.0 && < 4.8

nextBreaking
  :: NonEmptyString
  -> Version
  -> Package
nextBreaking n v = closedOpen n v u
  where
    u = case v of
      [] -> error "nextBreaking: requires a non-empty list argument"
      x:[] -> [x, 1]
      x:y:_ -> x : succ y : []

-- | Depends on the version given, up to the next time the first
-- digit increments.  Useful for @base@.
--
-- > nextBreaking "base" [4] ==> base >= 4 && < 5

nextMajor
  :: NonEmptyString
  -> Version
  -> Package
nextMajor n v = closedOpen n v u
  where
    u = case v of
      [] -> error "nextMajor: requires a non-empty list argument"
      x:_ -> succ x : []

-- | Depends on exactly this version only.
--
-- > exactly "base" [4,5,0,0] ==> base ==4.5.0.0

exactly :: NonEmptyString -> Version -> Package
exactly n v = Package n (eq v)

-- | Allows any version of a package.

unconstrained
  :: NonEmptyString
  -- ^ Name of package
  -> Package
unconstrained nm = Package nm anyVersion

-- | Builds @if@ statements.  For example:
--
-- > condition (flag "buildExe") (buildable True, []) [buildable False]
--
-- A little more complicated:
--
-- > condition (flag "buildExe" &&& system "windows")
-- >   (buildable True, []) [buildable False]
condBlock
  :: HasBuildInfo a
  => Condition
  -- ^ Condition to satisfy
  -> (a, [a])
  -- ^ Use these results if condition is true
  -> [a]
  -- ^ Use these results if condition if false
  -> a
condBlock tree ifT ifF =
  conditional $ CondBlock tree ifT ifF

-- | Operating system; tested against @System.Info.os@ on the
-- target system.
system :: NonEmptyString -> Condition
system = CLeaf . OS

-- | Argument is matched against @System.Info.arch@ on the target
-- system.
arch :: NonEmptyString -> Condition
arch = CLeaf . Arch

-- | Tests for the configured Haskell implementation.
impl :: Compiler -> Constraint -> Condition
impl cm cn = CLeaf $ Impl cm cn

-- | 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.
flag :: FlagName -> Condition
flag = CLeaf . CFlag

-- | Always true.
true :: Condition
true = CLeaf CTrue

-- | Always false.
false :: Condition
false = CLeaf CFalse

-- * Versions

-- | 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 'Word', as
-- each number cannot be negative.  In addition, this list should
-- never be empty.  However, this is just a type synonym for a list of
-- 'Word', so the type system does not enforce the requirement that
-- this list be non-empty.
type Version = [Word]

-- * Packages

-- | A single package, consisting of a package name and an optional
-- set of constraints.  Used when specifying 'buildDepends',
-- 'buildTools', and 'pkgConfigDepends'.
--
-- Some functions exist to ease the creation of a 'Package'.  For a
-- package with no version constrains, simply do something like
-- @'unconstrained' \"QuickCheck\"@.  Common use cases are
-- covered in the functions in the \"Package Helpers\" section below.
-- For something more complicated, use the functions in the
-- \"Logicals\" sections above, along with the '&&&' and '|||'
-- combinators, to create your own 'Constraint' and then use it with
-- the 'package' function.

data Package = Package NonEmptyString Constraint
  deriving (Eq, Ord, Show)

-- | Builds a 'Package'.
package
  :: NonEmptyString
  -- ^ The name of the package
  -> Constraint
  -- ^ Version constraints.
  -> Package
package = Package

-- * Build information

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

-- | Sets Haskell 98 as the @default-language@.
--
-- Currently not documented in Cabal, see
--
-- <https://github.com/haskell/cabal/issues/1894>
haskell98 :: HasBuildInfo a => a
haskell98 = buildInfo $ DefaultLanguage Haskell98

-- | Sets Haskell 2010 as the @default-language@.
--
-- Currently not documented in Cabal, see
--
-- <https://github.com/haskell/cabal/issues/1894>
haskell2010 :: HasBuildInfo a => a
haskell2010 = buildInfo $ DefaultLanguage Haskell2010

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

  | OtherModules [NonEmptyString]
  -- ^ 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 [NonEmptyString]
  -- ^ Root directories for the module hierarchy

  | Extensions [NonEmptyString]

  | DefaultExtensions [NonEmptyString]
  | OtherExtensions [NonEmptyString]

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

  | Buildable Bool
  -- ^ Is this component buildable?

  | GHCOptions [NonEmptyString]
  | GHCProfOptions [NonEmptyString]
  | GHCSharedOptions [NonEmptyString]
  | HugsOptions [NonEmptyString]
  | Nhc98Options [NonEmptyString]
  | Includes [NonEmptyString]
  -- ^ 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 [NonEmptyString]
  -- ^ 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 [NonEmptyString]
  -- ^ List of diretories to search for header files when dealing
  -- with C compilations.

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

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

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

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

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

  | LDOptions [NonEmptyString]
  -- ^ Linker options.

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

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

  | DefaultLanguage DefaultLanguage

  deriving (Eq, Ord, Show)

-- * Libraries

-- | A field in the @Library@ section of the Cabal file.  A
-- @Library@ section can have multiple fields.
data LibraryField
  = ExposedModules [NonEmptyString]
  -- ^ Exposed modules.  'modules' can help you generate this, without
  -- you having to manually list each module and keep the list up to
  -- date.

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

-- | Whether a library is exposed.  GHC can hide libraries.
exposed :: Bool -> LibraryField
exposed = Exposed

-- | A library's exposed modules.  'modules' can help you generate
-- this, without you having to manually list each module and keep the
-- list up to date.
exposedModules :: [NonEmptyString] -> LibraryField
exposedModules = ExposedModules

-- * Executables

-- | A single field in an 'Executable' section.  An 'Executable'
-- section may have multiple fields.
data ExecutableField
  = ExeConditional (CondBlock ExecutableField)
  -- ^ An 'Executable' section can contain conditional blocks.

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

  | ExeMainIs NonEmptyString
  -- ^ The name of the @.hs@ or @.lhs@ file containing the @Main@
  -- module.  Note that it is the @.hs@ filename that must be listed,
  -- even if that file is generated using a preprocessor.  The source
  -- file must be relative to one of the directories listed in
  -- 'hsSourceDirs'.

  deriving (Eq, Ord, Show)

-- | An entire @Executable@ section.
data Executable = Executable
  { exeName :: NonEmptyString
  -- ^ The name of the executable that Cabal will build.
  , exeFields :: [ExecutableField]
  -- ^ An executable can contain zero or more 'ExecutableField's.
  } deriving (Eq, Ord, Show)

-- | Builds a 'Section' for executable files.
executable
  :: NonEmptyString
  -- ^ The name of the executable that Cabal will build.
  -> [ExecutableField]
  -- ^ An executable can contain zero or more 'ExecutableField's.
  -> Section
executable nm fs = SecExe (Executable nm fs)

-- * Test suites

-- | 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
  -- @test-main-is@ field is required.

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

detailed :: TestSuiteField
detailed = TestSuiteType Detailed

-- | A single field value in a 'TestSuite' section.  A single test
-- suite section may contain mulitple fields.
data TestSuiteField
  = TestConditional (CondBlock TestSuiteField)
  -- ^ The 'TestSuite' may contain zero or more conditional blocks.
  | TestInfo BuildInfoField
  -- ^ The 'TestSuite' may contain zero or more build information
  -- fields.
  | TestMainIs NonEmptyString
  -- ^ The name of the @.hs@ or @.lhs@ file containing the @Main@
  -- module.  Note that it is the @.hs@ filename that must be listed,
  -- even if that file is generated using a preprocessor.  The source
  -- file must be relative to one of the directories listed in
  -- 'hsSourceDirs'.
  --
  -- This is required when using 'ExitcodeStdio' and disallowed when
  -- using 'Detailed'.

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

  deriving (Eq, Ord, Show)

-- | The module exporting the @tests@ symbol.  This is required when
-- using 'Detailed' and disallowed when using 'ExitcodeStdio'.
testModule :: NonEmptyString -> TestSuiteField
testModule = TestModule

-- | An entire @test-suite@ section.
data TestSuite = TestSuite
  { testSuiteName :: NonEmptyString
  -- ^ The executable name for the resulting test suite
  , testSuiteFields :: [TestSuiteField]
  -- ^ Zero or more 'TestSuiteField's.
  } deriving (Eq, Ord, Show)

-- | Builds a 'Section' for test suites.
testSuite
  :: NonEmptyString
  -- ^ The executable name for the resulting test suite
  -> [TestSuiteField]
  -- ^ Zero or more 'TestSuiteField's.
  -> Section
testSuite nm fs = SecTest (TestSuite nm fs)

-- * Benchmarks

data BenchmarkType
  = BenchExitCode
  -- ^ @exitcode-stdio-1.0@, currently the only supported benchmark interface.
  deriving (Eq, Ord, Show)

-- | A single field in a @Benchmark@ section.
data BenchmarkField
  = BenchmarkConditional (CondBlock BenchmarkField)
  | BenchmarkInfo BuildInfoField
  | BenchmarkType BenchmarkType
  | BenchmarkMainIs NonEmptyString
  -- ^ The name of the @.hs@ or @.lhs@ file containing the @Main@
  -- module.  Note that it is the @.hs@ filename that must be listed,
  -- even if that file is generated using a preprocessor.  The source
  -- file must be relative to one of the directories listed in
  -- 'hsSourceDirs'.
  deriving (Eq, Ord, Show)

-- | An entire @Benchmark@ section.
data Benchmark = Benchmark
  { benchmarkName :: NonEmptyString
  -- ^ The name of the executable file that will be the benchmark
  , benchmarkFields :: [BenchmarkField]
  -- ^ Zero or more benchmark fields.
  } deriving (Eq, Ord, Show)

-- | Builds a 'Section' for benchmarks.
benchmark
  :: NonEmptyString
  -- ^ The name of the executable file that will be the benchmark
  -> [BenchmarkField]
  -- ^ Zero or more benchmark fields.
  -> Section
benchmark nm fs = SecBench (Benchmark nm fs)

-- * Overloaded fields

-- | Things that can be an item in a build information field in a
-- Cabal file.
class HasBuildInfo a where

  -- | Takes a conditional block and wraps it in the field type.
  conditional :: CondBlock a -> a

  -- | Takes a build information field and wraps it in the field
  -- type.
  buildInfo :: BuildInfoField -> a

instance HasBuildInfo LibraryField where
  conditional = LibConditional
  buildInfo = LibInfo

instance HasBuildInfo ExecutableField where
  conditional = ExeConditional
  buildInfo = ExeInfo

instance HasBuildInfo TestSuiteField where
  conditional = TestConditional
  buildInfo = TestInfo

instance HasBuildInfo BenchmarkField where
  conditional = BenchmarkConditional
  buildInfo = BenchmarkInfo

-- # Build info helpers

-- | A list of packages needed to build this component
buildDepends :: HasBuildInfo a => [Package] -> a
buildDepends = buildInfo . BuildDepends

-- | 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.
--
-- 'modules' can help greatly with maintenance of
-- this field.

otherModules :: HasBuildInfo a => [NonEmptyString] -> a
otherModules = buildInfo . OtherModules

-- | Root directories for the module hierarchy
hsSourceDirs :: HasBuildInfo a => [NonEmptyString] -> a
hsSourceDirs = buildInfo . HsSourceDirs

-- | Haskell extensions used by every module.  With version 1.22 of
-- the Cabal library, using this field might get you this warning:
--
-- > Warning: For packages using 'cabal-version: >= 1.10' the
-- > 'extensions' field is deprecated. The new 'default-extensions'
-- > field lists extensions that are used in all modules in the
-- > component, while the 'other-extensions' field lists extensions
-- > that are used in some modules, e.g. via the {-# LANGUAGE #-}
-- > pragma.
extensions :: HasBuildInfo a => [NonEmptyString] -> a
extensions = buildInfo . Extensions

-- | Default extensions.  See 'extensions' for details.  Currently
-- undocumented, see <https://github.com/haskell/cabal/issues/1517>
defaultExtensions :: HasBuildInfo a => [NonEmptyString] -> a
defaultExtensions = buildInfo . DefaultExtensions

-- | Other extensions.  See 'extensions' for details.  Currently
-- undocumented, see <https://github.com/haskell/cabal/issues/1517>
otherExtensions :: HasBuildInfo a => [NonEmptyString] -> a
otherExtensions = buildInfo . OtherExtensions


-- | Programs needed to build this package, such as c2hs.
buildTools :: HasBuildInfo a => [Package] -> a
buildTools = buildInfo . BuildTools

-- | Is this component buildable?
buildable :: HasBuildInfo a => Bool -> a
buildable = buildInfo . Buildable

ghcOptions :: HasBuildInfo a => [NonEmptyString] -> a
ghcOptions = buildInfo . GHCOptions

ghcProfOptions :: HasBuildInfo a => [NonEmptyString] -> a
ghcProfOptions = buildInfo . GHCProfOptions

ghcSharedOptions :: HasBuildInfo a => [NonEmptyString] -> a
ghcSharedOptions = buildInfo . GHCSharedOptions

hugsOptions :: HasBuildInfo a => [NonEmptyString] -> a
hugsOptions = buildInfo . HugsOptions

nhc98Options :: HasBuildInfo a => [NonEmptyString] -> a
nhc98Options = buildInfo . Nhc98Options

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

includes :: HasBuildInfo a => [NonEmptyString] -> a
includes = buildInfo . Includes

-- | 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@.
installIncludes :: HasBuildInfo a => [NonEmptyString] -> a
installIncludes = buildInfo . InstallIncludes

-- | List of diretories to search for header files when dealing
-- with C compilations.
includeDirs :: HasBuildInfo a => [NonEmptyString] -> a
includeDirs = buildInfo . IncludeDirs

-- | C sources to be compiled and lined with the Haskell files.
cSources :: HasBuildInfo a => [NonEmptyString] -> a
cSources = buildInfo . CSources

-- | Extra libraries to link with.
extraLibraries :: HasBuildInfo a => [NonEmptyString] -> a
extraLibraries = buildInfo . ExtraLibraries

-- | Directories to search for libraries.
extraLibDirs :: HasBuildInfo a => [NonEmptyString] -> a
extraLibDirs = buildInfo . ExtraLibDirs

-- | C Compiler options.
ccOptions :: HasBuildInfo a => [NonEmptyString] -> a
ccOptions = buildInfo . CCOptions

-- | C Preprocessor options.  Undocumented, see
-- <https://github.com/haskell/cabal/issues/646>
cppOptions :: HasBuildInfo a => [NonEmptyString] -> a
cppOptions = buildInfo . CPPOptions

-- | Linker options.
ldOptions :: HasBuildInfo a => [NonEmptyString] -> a
ldOptions = buildInfo . LDOptions

-- | List of pkg-config packages needed to build this component.
pkgConfigDepends :: HasBuildInfo a => [Package] -> a
pkgConfigDepends = buildInfo . PkgConfigDepends

-- | OS X frameworks.
frameworks :: HasBuildInfo a => [NonEmptyString] -> a
frameworks = buildInfo . Frameworks

-- | Sections that build executables.  These are the 'Executable',
-- 'Benchmark', and 'TestSuite' sections.
class BuildsExe a where
  mainIs :: NonEmptyString -> a
  -- ^ Overloaded function allowing you to use 'mainIs' for an
  -- 'Executable', 'Benchmark', or 'TestSuite' section.

instance BuildsExe ExecutableField where
  mainIs = ExeMainIs

instance BuildsExe TestSuiteField where
  mainIs = TestMainIs

instance BuildsExe BenchmarkField where
  mainIs = BenchmarkMainIs

-- | Sections that build executables that can be @exitcode-stdio-1.0@.
-- These are the 'Benchmark' and 'TestSuite' sections.
class BuildsExitcode a where
  exitcodeStdio :: a
  -- ^ Returns a field that is @exitcode-stdio-1.0@

instance BuildsExitcode TestSuiteField where
  exitcodeStdio = TestSuiteType ExitcodeStdio

instance BuildsExitcode BenchmarkField where
  exitcodeStdio = BenchmarkType BenchExitCode

-- | Builds two fields.  The first indicates that this is an
-- @exitcode-stdio-1.0@ executable; the second is the appropriate
-- @main-is@ field.
exitcodeFields
  :: (BuildsExitcode a, BuildsExe a)
  => NonEmptyString
  -- ^ Value for @main-is@ field
  -> [a]
exitcodeFields m = [exitcodeStdio, mainIs m]

-- * Getting module lists

-- | Gets all Haskell modules in a given directory tree.  Allows you
-- to specify what extensions you are interested in.  For this to work
-- best, you will want to keep all your library modules in their own
-- directory, such as @lib/@.  You can also separate executables and
-- test suites this way.  'hsSourceDirs' will then tell Cabal to use
-- these directories.

modulesWithExtensions
  :: MonadIO m
  => [NonEmptyString]
  -- ^ Look for files that have these extensions.  'fileExtensions'
  -- covers the most common cases.  Files without one of these
  -- extensions are ignored.  Files and directories that do not begin
  -- with an uppercase letter are ignored.  (This also ignores files
  -- that start with a dot.)  Directories with a dot anywhere in the
  -- name are ignored.
  --
  -- Do not include the leading dot with the extension.  For example,
  -- to look for Haskell and literate Haskell files only, use
  --
  -- > ["hs", "lhs"]

  -> FilePath
  -- ^ Start searching within this directory.

  -> Betsy m [NonEmptyString]
  -- ^ A list of Haskell modules in the given directory tree.  The
  -- file contents are not examined; only the file names matter.
  -- Returned as a list of dotted names.

modulesWithExtensions exts fp
  = liftIO $ modulesWithExtensionsIO exts fp


-- | Same as
--
-- @
-- 'modulesWithExtensions' 'fileExtensions'
-- @
modules
  :: MonadIO m
  => FilePath
  -> Betsy m [NonEmptyString]
modules = modulesWithExtensions fileExtensions

-- | Common extensions of Haskell files and files that are
-- preprocessed into Haskell files.  Includes:
--
-- * hs (Haskell)
--
-- * lhs (literate Haskell)
--
-- * gc (greencard)
--
-- * chs (c2hs)
--
-- * hsc (hsc2hs)
--
-- * y and ly (happy)
--
-- * x (alex)
--
-- * cpphs

fileExtensions :: [String]
fileExtensions =
  [ "hs"
  , "lhs"
  , "gc"
  , "chs"
  , "hsc"
  , "y"
  , "ly"
  , "x"
  , "cpphs"
  ]

interestingFile
  :: [String]
  -- ^ Extensions of module files
  -> FilePath
  -> Bool

interestingFile xs s = case s of
  "" -> False
  x:_
    | not (C.isUpper x) -> False
    | otherwise -> let mayExt = P.takeExtension s
                   in case mayExt of
                       [] -> False
                       _ : ext -> ext `elem` xs

interestingDir :: FilePath -> Bool
interestingDir p = case p of
  [] -> False
  x:_
    | not (C.isUpper x) -> False
    | otherwise -> not $ '.' `elem` p

-- | Gets all Haskell modules in a given directory tree.  Only files
-- with one of the extensions listed in 'fileExtensions' are
-- returned.  Files and directories that do not begin with an
-- uppercase letter are ignored.  (This also ignores files that
-- start with a dot.)  Directories with a dot anywhere in the name
-- are ignored.

modulesIO
  :: FilePath
  -- ^ Start searching within this directory.
  -> IO [String]
  -- ^ A list of Haskell modules in the given directory tree.  The
  -- file contents are not examined; only the file names matter.
  -- Returned as a list of dotted names.
modulesIO = modulesWithExtensionsIO fileExtensions


-- | Gets all Haskell modules in a given directory tree.  Allows you
-- to specify what extensions you are interested in.

modulesWithExtensionsIO
  :: [String]
  -- ^ Look for files that have one of these extensions.
  -- 'fileExtensions' covers the most common cases.  Files without
  -- one of these extensions are ignored.  Files and directories
  -- that do not begin with an uppercase letter are ignored.  (This
  -- also ignores files that start with a dot.)  Directories with a
  -- dot anywhere in the name are ignored.
  --
  -- Do not include the leading dot with the extension.  For
  -- example, to look for Haskell and literate Haskell files only, use
  --
  -- > ["hs", "lhs"]

  -> FilePath
  -- ^ Start searching within this directory.

  -> IO [String]
  -- ^ A list of Haskell modules in the given directory tree.  The
  -- file contents are not examined; only the file names matter.
  -- Returned as a list of dotted names.

modulesWithExtensionsIO exts start
  = fmap (map modName . sortBy sorter . map reverse)
  $ modulesInDir exts start []
  where
    modName = concat . intersperse "."

sorter :: [String] -> [String] -> Ordering
sorter x y = mconcat (zipWith compare x y) <> compare lenX lenY
  where
    (lenX, lenY) = (length x, length y)

modulesInDir
  :: [String]
  -- ^ Extensions of module files
  -> FilePath
  -- Search is rooted in this directory
  -> [FilePath]
  -- ^ Stack of directories we're in
  -> IO [[String]]
  -- ^ Returns a list of modules in this directory.
modulesInDir exts start dirs = do
  cs <- D.getDirectoryContents (start </> P.joinPath (reverse dirs))
  fmap concat . mapM (processFile exts start dirs) $ cs

processFile
  :: [String]
  -- ^ Extensions of module files
  -> FilePath
  -- ^ Search is rooted in this directory
  -> [FilePath]
  -- Stack of directories we're in, including current directory
  -> FilePath
  -- ^ Interesting file under investigation
  -> IO [[String]]
processFile exts start dirs this = do
  isDir <- D.doesDirectoryExist
    (start </> (P.joinPath . reverse $ this : dirs))
  if isDir
    then if interestingDir this
          then modulesInDir exts start (this : dirs)
          else return []
    else return $ if interestingFile exts this
          then [(P.dropExtension this : dirs)]
          else []

-- * Section

-- | A single section in a Cabal file; this may be a source
-- repository, executable, test suite, or benchmark.  You build a
-- 'Section' with the 'repository', 'executable', 'testSuite', and
-- 'benchmark' functions.
data Section
  = SecRepo Repository
  | SecExe Executable
  | SecTest TestSuite
  | SecBench Benchmark
  deriving (Eq, Ord, Show)

-- * Properties

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

simple, configure, make, custom :: BuildType
simple = Simple
configure = Configure
make = Make
custom = Custom

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

gpl, agpl, lgpl, bsd2, bsd3, bsd4, mit, mpl, apache, publicDomain,
  allRightsReserved, otherLicense :: License

gpl = GPL
agpl = AGPL
lgpl = LGPL
bsd2 = BSD2
bsd3 = BSD3
bsd4 = BSD4
mit = MIT
mpl = MPL
apache = Apache
publicDomain = PublicDomain
allRightsReserved = AllRightsReserved
otherLicense = OtherLicense

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

ghc, nhc, yhc, hugs, helium, jhc, lhc :: Compiler
ghc = GHC
nhc = NHC
yhc = YHC
hugs = Hugs
helium = Helium
jhc = JHC
lhc = LHC

-- | Global package properties.
data Properties = Properties
  { name :: String
  , version :: Version
  , cabalVersion :: Maybe (Word, Word)
  , buildType :: Maybe BuildType
  , license :: Maybe License
  , licenseFile :: String
  , licenseFiles :: [NonEmptyString]
  , copyright :: String
  , author :: String
  , maintainer :: String
  , stability :: String
  , homepage :: String
  , bugReports :: String
  , packageUrl :: String
  , synopsis :: String
  , description :: [String]
  , category :: String
  -- ^ According to the \"Developing Cabal Packages\" document, this
  -- should simply be an email address.
  , testedWith :: [(Compiler, Constraint)]
  , dataFiles :: [NonEmptyString]
  , dataDir :: String
  , extraSourceFiles :: [NonEmptyString]
  , extraDocFiles :: [NonEmptyString]
  , extraTmpFiles :: [NonEmptyString]
  } deriving (Eq, Ord, Show)

instance Blank Properties where
  blank = Properties
    { name = ""
    , version = []
    , cabalVersion = Nothing
    , buildType = Nothing
    , license = Nothing
    , licenseFile = ""
    , licenseFiles = []
    , copyright = ""
    , author = ""
    , maintainer = ""
    , stability = ""
    , homepage = ""
    , bugReports = ""
    , packageUrl = ""
    , synopsis = ""
    , description = []
    , category = ""
    , testedWith = []
    , dataFiles = []
    , dataDir = ""
    , extraSourceFiles = []
    , extraDocFiles = []
    , extraTmpFiles = []
    }

-- * Cabal

-- | Represents an entire Cabal file.
data Cabal = Cabal
  { properties :: Properties
  , library :: [LibraryField]
  , sections :: [Section]
  , flags :: [Flag]
  } deriving (Eq, Ord, Show)

instance Blank Cabal where
  blank = Cabal blank [] [] []