-- | This program generates Cartel's own Cabal file.  It's included
-- here in the library to provide a live, type-checked, compilable
-- example.  You will want to look at the source code itself, as the
-- Haddocks won't show you much.

module Cartel.GenCartelCabal where

import Cartel
import qualified Cartel.Version

-- Dependencies

base :: Package
base = closedOpen "base" [4,5,0,0] [4,8]

directory :: Package
directory = closedOpen "directory" [1,1,0,2] [1,3]

filepath :: Package
filepath = closedOpen "filepath" [1,3,0,0] [1,4]

time :: Package
time = closedOpen "time" [1,4] [1,6]

quickcheck :: Package
quickcheck = nextBreaking "QuickCheck" [2,7]

random :: Package
random = closedOpen "random" [1,1] [1,2]

transformers :: Package
transformers = nextBreaking "transformers" [0,4]

multiarg :: Package
multiarg = nextBreaking "multiarg" [0,30,0,0]

quickpull :: Package
quickpull = nextBreaking "quickpull" [0,4,0,0]

libDepends :: [Package]
libDepends =
  [ base, directory, filepath, time, transformers ]

testDepends :: [Package]
testDepends = [ multiarg, quickcheck, random, quickpull ]

commonOptions :: HasBuildInfo a => [a]
commonOptions =
  [ ghcOptions ["-Wall"]
  , hsSourceDirs ["lib"]
  , buildDepends libDepends
  ]

testOptions :: HasBuildInfo a => [a]
testOptions
  = hsSourceDirs ["tests"]
  : buildDepends testDepends
  : commonOptions

main :: IO ()
main = defaultMain $ do
  libModules <- modules "lib"
  flagVisual <- makeFlag "visual"
    (FlagOpts { flagDescription = "Build cartel-visual-test executable."
              , flagDefault = False
              , flagManual = True
              })
  testMods <- modules "tests"
  return
    ( blank
      { name = "cartel"
        , version = Cartel.Version.version
        , buildType = Just simple
        , category = "Distribution"
        , maintainer = "omari@smileystation.com"
        , synopsis = "Specify Cabal files in Haskell"
        , description =
            [ "By specifying your Cabal files in Haskell, you have the power"
            , "of Haskell at your disposal to reduce redundancy.  You can"
            , "also read in trees of module names dynamically, which saves"
            , "you from manually maintaining lists of module names."
            , ""
            , "See the documentation in the \"Cartel\" module for details."
            ]
        , license = Just bsd3
        , licenseFile = "LICENSE"
        , copyright = "Copyright 2014-2015 Omari Norman"
        , author = "Omari Norman"
        , stability = "Experimental"
        , cabalVersion = Just (1,16)
        , homepage = "http://www.github.com/massysett/cartel"
        , bugReports = "http://www.github.com/massysett/cartel/issues"
        , testedWith = let f v = (ghc, eq v)
                       in map f [[7,6,3], [7,8,2]]
        , extraSourceFiles = ["README.md"]
      }
    , exposedModules libModules : haskell2010 : commonOptions

    , [ githubHead "massysett" "cartel"
      , executable "cartel-visual-test"
        [ condBlock (flag flagVisual)
          ( buildable True
          , otherModules testMods : testOptions
          )
          [ buildable False
          ]
        , haskell2010
        , mainIs "cartel-visual-test.hs"
        ]
      , testSuite "cartel-properties"
        $ haskell2010 
        : otherModules testMods 
        : testOptions
        ++ exitcodeFields "cartel-properties.hs"
        
      ]
    )