module System.Console.Argument
  (
    Type (Type,parser,name,defaultValue)
  
  -- * Argument types
  , optional
  , string
  , boolean
  , directory
  , file
  , device
  , natural
  , integer
  
  -- * Option descriptions
  , option
  ) where


import           Data.Char      (toLower)
import           Data.List.HT   (viewR)
import qualified Data.Map              as Map
import qualified System.Console.GetOpt as GetOpt
import qualified Text.Parsec.Extra     as P


-- | A @Type a@ represents the type of an option or argument.
-- 
-- Further below you can find some common types of option arguments.
data Type a
  = Type
  {
    parser       :: String -> Either String a
    -- ^ Parse the option argument into a value (@Right@) or signal a parsing
    -- error (@Left@).
  , name         :: String
    -- ^ A name for this type of option argument (for usage info).
  , defaultValue :: Maybe a
    -- ^ The default value, when the option occurs without option argument.
    -- @Nothing@ means that an argument is required for this type of option.
    -- 
    -- Note that this may be different from the corresponding value in the default
    -- configuration (the first argument of 'System.Console.Command.execute');
    -- the latter is what you get when this option does not occur at all in the
    -- configuration file or command line.
  }

instance Functor Type where
  fmap f t = t { parser = fmap f . parser t, defaultValue = fmap f (defaultValue t) }

-- | Create an option description. You need this to describe the options your
-- command uses; see 'System.Console.Command.Command'.
option
  :: (a -> s) -- ^ Function that creates a setting (of type @s@) from the option argument.
  -> [Char]   -- ^ List of short option characters.
  -> [String] -- ^ List of long option strings.
  -> Type a   -- ^ Type of option argument.
  -> String   -- ^ Description.
  -> GetOpt.OptDescr (Either String s) -- ^ The resulting option description.
option inj short long t description = case defaultValue t of
  Nothing -> GetOpt.Option short long (GetOpt.ReqArg (                        fmap inj . parser t) (name t)) description
  Just a  -> GetOpt.Option short long (GetOpt.OptArg (maybe (Right $ inj a) $ fmap inj . parser t) (name t)) description

-- Argument types.

optional
  :: a      -- ^ Default value.
  -> Type a
  -> Type a
optional x t = t { defaultValue = Just x }

-- | A plain string.
string :: Type String
string = Type Right "STRING" Nothing

-- | A boolean. Argument can be \"1\",\"0\",\"true\",\"false\",\"on\",\"off\".
boolean :: Type Bool
boolean = Type
  {
    name    = "BOOL"
  , parser  = \ y -> maybe (e y) Right . flip Map.lookup m . map toLower $ y
  , defaultValue = Just True
  }
 where
  m = Map.fromList [("1",True),("0",False),("true",True),("false",False),("on",True),("off",False)]
  e y = Left $ "Argument " ++ show y ++ " could not be recognised as a boolean."

-- | A natural number (in decimal).
natural :: Type Integer
natural = Type { name = "INT (natural)", parser = P.parseM P.natural "", defaultValue = Nothing }

-- | An integer number (in decimal).
integer :: Type Integer
integer = Type { name = "INT", parser = P.parseM P.integer "", defaultValue = Nothing }

-- | A directory path. A trailing slash is stripped, if present.
directory :: Type FilePath
directory = Type { name = "DIR", parser = Right . stripTrailingSlash, defaultValue = Nothing }
 where
  stripTrailingSlash x = case viewR x of
    Nothing       -> ""
    Just (i,l)
      | l == '/'  -> i
      | otherwise -> x

-- | A file path.
file :: Type FilePath
file = string { name = "FILE" }

-- | A device path.
device :: Type FilePath
device = string { name = "DEVICE" }