1{-# LANGUAGE DeriveDataTypeable #-}
2
3-- | The underlying CmdArgs type.
4module System.Console.CmdArgs.Implicit.Type(
5    -- cmdArgs_privateArgsSeen is exported, otherwise Haddock
6    -- gets confused when using RecordWildCards
7    CmdArgs(..), cmdArgsHasValue, embed, reembed,
8    CmdArgsPrivate, incArgsSeen, getArgsSeen
9    ) where
10
11import System.Console.CmdArgs.Verbosity
12
13import Data.Data
14import Data.Maybe
15
16
17-- | A structure to store the additional data relating to @--help@,
18--   @--version@, @--quiet@ and @--verbose@.
19data CmdArgs a = CmdArgs
20    {cmdArgsValue :: a -- ^ The underlying value being wrapped.
21    ,cmdArgsHelp :: Maybe String -- ^ @Just@ if @--help@ is given, then gives the help message for display, including a trailing newline.
22    ,cmdArgsVersion :: Maybe String -- ^ @Just@ if @--version@ is given, then gives the version message for display, including a trailing newline.
23    ,cmdArgsVerbosity :: Maybe Verbosity -- ^ @Just@ if @--quiet@ or @--verbose@ is given, then gives the verbosity to use.
24    ,cmdArgsPrivate :: CmdArgsPrivate -- ^ Private: Only exported due to Haddock limitations.
25    }
26    deriving (Show,Eq,Ord,Data,Typeable)
27
28cmdArgsHasValue :: CmdArgs a -> Bool
29cmdArgsHasValue x = isNothing (cmdArgsHelp x) && isNothing (cmdArgsVersion x)
30
31instance Functor CmdArgs where
32    fmap f x = x{cmdArgsValue = f $ cmdArgsValue x}
33
34
35embed :: a -> CmdArgs a
36embed x = CmdArgs x Nothing Nothing Nothing (CmdArgsPrivate 0)
37
38reembed :: CmdArgs a -> (a, a -> CmdArgs a)
39reembed x = (cmdArgsValue x, \y -> x{cmdArgsValue=y})
40
41
42data CmdArgsPrivate = CmdArgsPrivate
43    Int -- ^ The number of arguments that have been seen
44    deriving (Eq,Ord,Data,Typeable)
45
46incArgsSeen x@CmdArgs{cmdArgsPrivate = CmdArgsPrivate i} = x{cmdArgsPrivate = CmdArgsPrivate (i+1)}
47getArgsSeen CmdArgs{cmdArgsPrivate = CmdArgsPrivate i} = i
48
49instance Show CmdArgsPrivate where show _ = "CmdArgsPrivate"
50