1{-# LANGUAGE DeriveGeneric #-}
2
3-----------------------------------------------------------------------------
4-- |
5-- Module      :  Distribution.Client.Init.Types
6-- Copyright   :  (c) Brent Yorgey, Benedikt Huber 2009
7-- License     :  BSD-like
8--
9-- Maintainer  :  cabal-devel@haskell.org
10-- Stability   :  provisional
11-- Portability :  portable
12--
13-- Some types used by the 'cabal init' command.
14--
15-----------------------------------------------------------------------------
16module Distribution.Client.Init.Types where
17
18import Distribution.Client.Compat.Prelude
19import Prelude ()
20
21import Distribution.Simple.Setup (Flag(..), toFlag )
22
23import Distribution.Types.Dependency as P
24import Distribution.Version
25import Distribution.Verbosity
26import qualified Distribution.Package as P
27import Distribution.SPDX.License (License)
28import Distribution.ModuleName
29import Distribution.CabalSpecVersion
30import Language.Haskell.Extension ( Language(..), Extension )
31
32import qualified Text.PrettyPrint as Disp
33import qualified Distribution.Compat.CharParsing as P
34import qualified Data.Map as Map
35
36-- | InitFlags is really just a simple type to represent certain
37--   portions of a .cabal file.  Rather than have a flag for EVERY
38--   possible field, we just have one for each field that the user is
39--   likely to want and/or that we are likely to be able to
40--   intelligently guess.
41data InitFlags =
42    InitFlags { interactive    :: Flag Bool
43              , quiet          :: Flag Bool
44              , packageDir     :: Flag FilePath
45              , noComments     :: Flag Bool
46              , minimal        :: Flag Bool
47              , simpleProject  :: Flag Bool
48
49              , packageName  :: Flag P.PackageName
50              , version      :: Flag Version
51              , cabalVersion :: Flag CabalSpecVersion
52              , license      :: Flag License
53              , author       :: Flag String
54              , email        :: Flag String
55              , homepage     :: Flag String
56
57              , synopsis     :: Flag String
58              , category     :: Flag (Either String Category)
59              , extraSrc     :: Maybe [String]
60
61              , packageType  :: Flag PackageType
62              , mainIs       :: Flag FilePath
63              , language     :: Flag Language
64
65              , exposedModules :: Maybe [ModuleName]
66              , otherModules   :: Maybe [ModuleName]
67              , otherExts      :: Maybe [Extension]
68
69              , dependencies    :: Maybe [P.Dependency]
70              , applicationDirs :: Maybe [String]
71              , sourceDirs      :: Maybe [String]
72              , buildTools      :: Maybe [String]
73
74              , initializeTestSuite :: Flag Bool
75              , testDirs            :: Maybe [String]
76
77              , initHcPath    :: Flag FilePath
78
79              , initVerbosity :: Flag Verbosity
80              , overwrite     :: Flag Bool
81              }
82  deriving (Show, Generic)
83
84  -- the Monoid instance for Flag has later values override earlier
85  -- ones, which is why we want Maybe [foo] for collecting foo values,
86  -- not Flag [foo].
87
88data BuildType = LibBuild | ExecBuild
89  deriving Eq
90
91-- The type of package to initialize.
92data PackageType = Library | Executable | LibraryAndExecutable
93  deriving (Show, Read, Eq)
94
95displayPackageType :: PackageType -> String
96displayPackageType LibraryAndExecutable = "Library and Executable"
97displayPackageType pkgtype              = show pkgtype
98
99instance Monoid InitFlags where
100  mempty = gmempty
101  mappend = (<>)
102
103instance Semigroup InitFlags where
104  (<>) = gmappend
105
106defaultInitFlags :: InitFlags
107defaultInitFlags  = mempty
108    { initVerbosity = toFlag normal
109    }
110
111-- | Some common package categories (non-exhaustive list).
112data Category
113    = Codec
114    | Concurrency
115    | Control
116    | Data
117    | Database
118    | Development
119    | Distribution
120    | Game
121    | Graphics
122    | Language
123    | Math
124    | Network
125    | Sound
126    | System
127    | Testing
128    | Text
129    | Web
130    deriving (Read, Show, Eq, Ord, Bounded, Enum)
131
132instance Pretty Category where
133  pretty = Disp.text . show
134
135instance Parsec Category where
136  parsec = do
137    name <- P.munch1 isAlpha
138    case Map.lookup name names of
139      Just cat -> pure cat
140      _        -> P.unexpected $ "Category: " ++ name
141    where
142      names = Map.fromList [ (show cat, cat) | cat <- [ minBound .. maxBound ] ]
143