never executed always true always false

    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 -----------------------------------------------------------------------------
   16 module Distribution.Client.Init.Types where
   17 
   18 import Distribution.Client.Compat.Prelude
   19 import Prelude ()
   20 
   21 import Distribution.Simple.Setup (Flag(..), toFlag )
   22 
   23 import Distribution.Types.Dependency as P
   24 import Distribution.Version
   25 import Distribution.Verbosity
   26 import qualified Distribution.Package as P
   27 import Distribution.SPDX.License (License)
   28 import Distribution.ModuleName
   29 import Distribution.CabalSpecVersion
   30 import Language.Haskell.Extension ( Language(..), Extension )
   31 
   32 import qualified Text.PrettyPrint as Disp
   33 import qualified Distribution.Compat.CharParsing as P
   34 import 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.
   41 data 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 (Eq, 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 
   88 data BuildType = LibBuild | ExecBuild
   89   deriving Eq
   90 
   91 -- The type of package to initialize.
   92 data PackageType = Library | Executable | LibraryAndExecutable
   93   deriving (Show, Read, Eq)
   94 
   95 displayPackageType :: PackageType -> String
   96 displayPackageType LibraryAndExecutable = "Library and Executable"
   97 displayPackageType pkgtype              = show pkgtype
   98 
   99 instance Monoid InitFlags where
  100   mempty = gmempty
  101   mappend = (<>)
  102 
  103 instance Semigroup InitFlags where
  104   (<>) = gmappend
  105 
  106 defaultInitFlags :: InitFlags
  107 defaultInitFlags  = mempty
  108     { initVerbosity = toFlag normal
  109     }
  110 
  111 -- | Some common package categories (non-exhaustive list).
  112 data 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 
  132 instance Pretty Category where
  133   pretty = Disp.text . show
  134 
  135 instance 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 ] ]