module Console.Options.Monad
( ProgramDesc(..)
, ProgramMeta(..)
, OptionDesc
, gatherDesc
, getNextID
, getNextIndex
) where
import Control.Applicative
import Console.Options.Nid
import Console.Options.Types
import Console.Options.Utils
import Control.Monad.State
import Control.Monad.Identity
import System.Exit
data ProgramDesc r = ProgramDesc
{ stMeta :: ProgramMeta
, stCT :: Command r
, stNextID :: !NidGenerator
, stNextIndex :: !UnnamedIndex
}
data ProgramMeta = ProgramMeta
{ programMetaName :: Maybe String
, programMetaDescription :: Maybe String
, programMetaVersion :: Maybe String
, programMetaHelp :: [String]
}
programMetaDefault :: ProgramMeta
programMetaDefault = ProgramMeta Nothing Nothing Nothing ["-h", "--help"]
newtype OptionDesc r a = OptionDesc { runOptionDesc :: StateT (ProgramDesc r) Identity a }
deriving (Functor,Applicative,Monad,MonadState (ProgramDesc r))
gatherDesc :: OptionDesc r a -> ProgramDesc r
gatherDesc dsl = runIdentity $ execStateT (runOptionDesc dsl) initialProgramDesc
initialProgramDesc :: ProgramDesc r
initialProgramDesc = ProgramDesc { stMeta = programMetaDefault
, stCT = iniCommand
, stNextID = nidGenerator
, stNextIndex = 0
}
where
iniCommand :: Command r
iniCommand = Command (CommandLeaf []) "..." [] NoActionWrapped
getNextID :: OptionDesc r Nid
getNextID = do
(nid, nidGen) <- nidNext . stNextID <$> get
modify $ \st -> st { stNextID = nidGen }
return nid
getNextIndex :: OptionDesc r UnnamedIndex
getNextIndex = do
idx <- stNextIndex <$> get
modify $ \st -> st { stNextIndex = idx + 1 }
return idx