{-# LANGUAGE DeriveGeneric #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Client.Init.Types
-- Copyright   :  (c) Brent Yorgey, Benedikt Huber 2009
-- License     :  BSD-like
--
-- Maintainer  :  cabal-devel@haskell.org
-- Stability   :  provisional
-- Portability :  portable
--
-- Some types used by the 'cabal init' command.
--
-----------------------------------------------------------------------------
module Distribution.Client.Init.Types where

import Distribution.Client.Compat.Prelude
import Prelude ()

import Distribution.Simple.Setup (Flag(..), toFlag )

import Distribution.Types.Dependency as P
import Distribution.Version
import Distribution.Verbosity
import qualified Distribution.Package as P
import Distribution.SPDX.License (License)
import Distribution.ModuleName
import Distribution.CabalSpecVersion
import Language.Haskell.Extension ( Language(..), Extension )

import qualified Text.PrettyPrint as Disp
import qualified Distribution.Compat.CharParsing as P
import qualified Data.Map as Map

-- | InitFlags is really just a simple type to represent certain
--   portions of a .cabal file.  Rather than have a flag for EVERY
--   possible field, we just have one for each field that the user is
--   likely to want and/or that we are likely to be able to
--   intelligently guess.
data InitFlags =
    InitFlags { InitFlags -> Flag Bool
interactive    :: Flag Bool
              , InitFlags -> Flag Bool
quiet          :: Flag Bool
              , InitFlags -> Flag FilePath
packageDir     :: Flag FilePath
              , InitFlags -> Flag Bool
noComments     :: Flag Bool
              , InitFlags -> Flag Bool
minimal        :: Flag Bool
              , InitFlags -> Flag Bool
simpleProject  :: Flag Bool

              , InitFlags -> Flag PackageName
packageName  :: Flag P.PackageName
              , InitFlags -> Flag Version
version      :: Flag Version
              , InitFlags -> Flag CabalSpecVersion
cabalVersion :: Flag CabalSpecVersion
              , InitFlags -> Flag License
license      :: Flag License
              , InitFlags -> Flag FilePath
author       :: Flag String
              , InitFlags -> Flag FilePath
email        :: Flag String
              , InitFlags -> Flag FilePath
homepage     :: Flag String

              , InitFlags -> Flag FilePath
synopsis     :: Flag String
              , InitFlags -> Flag (Either FilePath Category)
category     :: Flag (Either String Category)
              , InitFlags -> Maybe [FilePath]
extraSrc     :: Maybe [String]

              , InitFlags -> Flag PackageType
packageType  :: Flag PackageType
              , InitFlags -> Flag FilePath
mainIs       :: Flag FilePath
              , InitFlags -> Flag Language
language     :: Flag Language

              , InitFlags -> Maybe [ModuleName]
exposedModules :: Maybe [ModuleName]
              , InitFlags -> Maybe [ModuleName]
otherModules   :: Maybe [ModuleName]
              , InitFlags -> Maybe [Extension]
otherExts      :: Maybe [Extension]

              , InitFlags -> Maybe [Dependency]
dependencies    :: Maybe [P.Dependency]
              , InitFlags -> Maybe [FilePath]
applicationDirs :: Maybe [String]
              , InitFlags -> Maybe [FilePath]
sourceDirs      :: Maybe [String]
              , InitFlags -> Maybe [FilePath]
buildTools      :: Maybe [String]

              , InitFlags -> Flag Bool
initializeTestSuite :: Flag Bool
              , InitFlags -> Maybe [FilePath]
testDirs            :: Maybe [String]

              , InitFlags -> Flag FilePath
initHcPath    :: Flag FilePath

              , InitFlags -> Flag Verbosity
initVerbosity :: Flag Verbosity
              , InitFlags -> Flag Bool
overwrite     :: Flag Bool
              }
  deriving (Int -> InitFlags -> ShowS
[InitFlags] -> ShowS
InitFlags -> FilePath
(Int -> InitFlags -> ShowS)
-> (InitFlags -> FilePath)
-> ([InitFlags] -> ShowS)
-> Show InitFlags
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [InitFlags] -> ShowS
$cshowList :: [InitFlags] -> ShowS
show :: InitFlags -> FilePath
$cshow :: InitFlags -> FilePath
showsPrec :: Int -> InitFlags -> ShowS
$cshowsPrec :: Int -> InitFlags -> ShowS
Show, (forall x. InitFlags -> Rep InitFlags x)
-> (forall x. Rep InitFlags x -> InitFlags) -> Generic InitFlags
forall x. Rep InitFlags x -> InitFlags
forall x. InitFlags -> Rep InitFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InitFlags x -> InitFlags
$cfrom :: forall x. InitFlags -> Rep InitFlags x
Generic)

  -- the Monoid instance for Flag has later values override earlier
  -- ones, which is why we want Maybe [foo] for collecting foo values,
  -- not Flag [foo].

data BuildType = LibBuild | ExecBuild
  deriving BuildType -> BuildType -> Bool
(BuildType -> BuildType -> Bool)
-> (BuildType -> BuildType -> Bool) -> Eq BuildType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BuildType -> BuildType -> Bool
$c/= :: BuildType -> BuildType -> Bool
== :: BuildType -> BuildType -> Bool
$c== :: BuildType -> BuildType -> Bool
Eq

-- The type of package to initialize.
data PackageType = Library | Executable | LibraryAndExecutable
  deriving (Int -> PackageType -> ShowS
[PackageType] -> ShowS
PackageType -> FilePath
(Int -> PackageType -> ShowS)
-> (PackageType -> FilePath)
-> ([PackageType] -> ShowS)
-> Show PackageType
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [PackageType] -> ShowS
$cshowList :: [PackageType] -> ShowS
show :: PackageType -> FilePath
$cshow :: PackageType -> FilePath
showsPrec :: Int -> PackageType -> ShowS
$cshowsPrec :: Int -> PackageType -> ShowS
Show, ReadPrec [PackageType]
ReadPrec PackageType
Int -> ReadS PackageType
ReadS [PackageType]
(Int -> ReadS PackageType)
-> ReadS [PackageType]
-> ReadPrec PackageType
-> ReadPrec [PackageType]
-> Read PackageType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PackageType]
$creadListPrec :: ReadPrec [PackageType]
readPrec :: ReadPrec PackageType
$creadPrec :: ReadPrec PackageType
readList :: ReadS [PackageType]
$creadList :: ReadS [PackageType]
readsPrec :: Int -> ReadS PackageType
$creadsPrec :: Int -> ReadS PackageType
Read, PackageType -> PackageType -> Bool
(PackageType -> PackageType -> Bool)
-> (PackageType -> PackageType -> Bool) -> Eq PackageType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageType -> PackageType -> Bool
$c/= :: PackageType -> PackageType -> Bool
== :: PackageType -> PackageType -> Bool
$c== :: PackageType -> PackageType -> Bool
Eq)

displayPackageType :: PackageType -> String
displayPackageType :: PackageType -> FilePath
displayPackageType PackageType
LibraryAndExecutable = FilePath
"Library and Executable"
displayPackageType PackageType
pkgtype              = PackageType -> FilePath
forall a. Show a => a -> FilePath
show PackageType
pkgtype

instance Monoid InitFlags where
  mempty :: InitFlags
mempty = InitFlags
forall a. (Generic a, GMonoid (Rep a)) => a
gmempty
  mappend :: InitFlags -> InitFlags -> InitFlags
mappend = InitFlags -> InitFlags -> InitFlags
forall a. Semigroup a => a -> a -> a
(<>)

instance Semigroup InitFlags where
  <> :: InitFlags -> InitFlags -> InitFlags
(<>) = InitFlags -> InitFlags -> InitFlags
forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend

defaultInitFlags :: InitFlags
defaultInitFlags :: InitFlags
defaultInitFlags  = InitFlags
forall a. Monoid a => a
mempty
    { initVerbosity :: Flag Verbosity
initVerbosity = Verbosity -> Flag Verbosity
forall a. a -> Flag a
toFlag Verbosity
normal
    }

-- | Some common package categories (non-exhaustive list).
data Category
    = Codec
    | Concurrency
    | Control
    | Data
    | Database
    | Development
    | Distribution
    | Game
    | Graphics
    | Language
    | Math
    | Network
    | Sound
    | System
    | Testing
    | Text
    | Web
    deriving (ReadPrec [Category]
ReadPrec Category
Int -> ReadS Category
ReadS [Category]
(Int -> ReadS Category)
-> ReadS [Category]
-> ReadPrec Category
-> ReadPrec [Category]
-> Read Category
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Category]
$creadListPrec :: ReadPrec [Category]
readPrec :: ReadPrec Category
$creadPrec :: ReadPrec Category
readList :: ReadS [Category]
$creadList :: ReadS [Category]
readsPrec :: Int -> ReadS Category
$creadsPrec :: Int -> ReadS Category
Read, Int -> Category -> ShowS
[Category] -> ShowS
Category -> FilePath
(Int -> Category -> ShowS)
-> (Category -> FilePath) -> ([Category] -> ShowS) -> Show Category
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Category] -> ShowS
$cshowList :: [Category] -> ShowS
show :: Category -> FilePath
$cshow :: Category -> FilePath
showsPrec :: Int -> Category -> ShowS
$cshowsPrec :: Int -> Category -> ShowS
Show, Category -> Category -> Bool
(Category -> Category -> Bool)
-> (Category -> Category -> Bool) -> Eq Category
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Category -> Category -> Bool
$c/= :: Category -> Category -> Bool
== :: Category -> Category -> Bool
$c== :: Category -> Category -> Bool
Eq, Eq Category
Eq Category
-> (Category -> Category -> Ordering)
-> (Category -> Category -> Bool)
-> (Category -> Category -> Bool)
-> (Category -> Category -> Bool)
-> (Category -> Category -> Bool)
-> (Category -> Category -> Category)
-> (Category -> Category -> Category)
-> Ord Category
Category -> Category -> Bool
Category -> Category -> Ordering
Category -> Category -> Category
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Category -> Category -> Category
$cmin :: Category -> Category -> Category
max :: Category -> Category -> Category
$cmax :: Category -> Category -> Category
>= :: Category -> Category -> Bool
$c>= :: Category -> Category -> Bool
> :: Category -> Category -> Bool
$c> :: Category -> Category -> Bool
<= :: Category -> Category -> Bool
$c<= :: Category -> Category -> Bool
< :: Category -> Category -> Bool
$c< :: Category -> Category -> Bool
compare :: Category -> Category -> Ordering
$ccompare :: Category -> Category -> Ordering
$cp1Ord :: Eq Category
Ord, Category
Category -> Category -> Bounded Category
forall a. a -> a -> Bounded a
maxBound :: Category
$cmaxBound :: Category
minBound :: Category
$cminBound :: Category
Bounded, Int -> Category
Category -> Int
Category -> [Category]
Category -> Category
Category -> Category -> [Category]
Category -> Category -> Category -> [Category]
(Category -> Category)
-> (Category -> Category)
-> (Int -> Category)
-> (Category -> Int)
-> (Category -> [Category])
-> (Category -> Category -> [Category])
-> (Category -> Category -> [Category])
-> (Category -> Category -> Category -> [Category])
-> Enum Category
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Category -> Category -> Category -> [Category]
$cenumFromThenTo :: Category -> Category -> Category -> [Category]
enumFromTo :: Category -> Category -> [Category]
$cenumFromTo :: Category -> Category -> [Category]
enumFromThen :: Category -> Category -> [Category]
$cenumFromThen :: Category -> Category -> [Category]
enumFrom :: Category -> [Category]
$cenumFrom :: Category -> [Category]
fromEnum :: Category -> Int
$cfromEnum :: Category -> Int
toEnum :: Int -> Category
$ctoEnum :: Int -> Category
pred :: Category -> Category
$cpred :: Category -> Category
succ :: Category -> Category
$csucc :: Category -> Category
Enum)

instance Pretty Category where
  pretty :: Category -> Doc
pretty = FilePath -> Doc
Disp.text (FilePath -> Doc) -> (Category -> FilePath) -> Category -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Category -> FilePath
forall a. Show a => a -> FilePath
show

instance Parsec Category where
  parsec :: m Category
parsec = do
    FilePath
name <- (Char -> Bool) -> m FilePath
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m FilePath
P.munch1 Char -> Bool
isAlpha
    case FilePath -> Map FilePath Category -> Maybe Category
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FilePath
name Map FilePath Category
names of
      Just Category
cat -> Category -> m Category
forall (f :: * -> *) a. Applicative f => a -> f a
pure Category
cat
      Maybe Category
_        -> FilePath -> m Category
forall (m :: * -> *) a. Parsing m => FilePath -> m a
P.unexpected (FilePath -> m Category) -> FilePath -> m Category
forall a b. (a -> b) -> a -> b
$ FilePath
"Category: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
name
    where
      names :: Map FilePath Category
names = [(FilePath, Category)] -> Map FilePath Category
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (Category -> FilePath
forall a. Show a => a -> FilePath
show Category
cat, Category
cat) | Category
cat <- [ Category
forall a. Bounded a => a
minBound .. Category
forall a. Bounded a => a
maxBound ] ]