{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverlappingInstances  #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}

{-# OPTIONS_GHC -fno-warn-deprecated-flags #-}

module WithCli.Argument where

import           Data.Orphans ()
import           Prelude ()
import           Prelude.Compat

import           Data.List
import           Data.Proxy
import           Text.Read

-- | 'Argument' is a typeclass for things that can be parsed as atomic values from
--   single command line arguments, e.g. strings (and filenames) and numbers.
--
--   Occasionally you might want to declare your own instance for additional
--   type safety and for providing a more informative command argument type.
--   Here's an example:

-- ### Start "docs/CustomOption.hs" "module CustomOption where\n\n" Haddock ###

-- |
-- >  {-# LANGUAGE DeriveDataTypeable #-}
-- >
-- >  import WithCli
-- >
-- >  data File = File FilePath
-- >    deriving (Show, Typeable)
-- >
-- >  instance Argument File where
-- >    argumentType Proxy = "custom-file-type"
-- >    parseArgument f = Just (File f)
-- >
-- >  instance HasArguments File where
-- >    argumentsParser = atomicArgumentsParser
-- >
-- >  main :: IO ()
-- >  main = withCli run
-- >
-- >  run :: File -> IO ()
-- >  run = print

-- ### End ###

-- | And this is how the above program behaves:

-- ### Start "docs/CustomOption.shell-protocol" "" Haddock ###

-- |
-- >  $ program --help
-- >  program [OPTIONS] custom-file-type
-- >    -h  --help  show help and exit
-- >  $ program some/file
-- >  File "some/file"

-- ### End ###

class Argument a where
  argumentType :: Proxy a -> String
  parseArgument :: String -> Maybe a

instance Argument String where
  argumentType Proxy = "STRING"
  parseArgument = Just

instance Argument Int where
  argumentType _ = "INTEGER"
  parseArgument = readMaybe

instance Argument Integer where
  argumentType _ = "INTEGER"
  parseArgument = readMaybe

instance Argument Float where
  argumentType _ = "NUMBER"
  parseArgument = readFloat

instance Argument Double where
  argumentType _ = "NUMBER"
  parseArgument = readFloat

readFloat :: (RealFloat n, Read n) => String -> Maybe n
readFloat s = case readMaybe s of
  Just n -> Just n
  Nothing
    | "." `isPrefixOf` s -> readMaybe ("0" ++ s)
    | otherwise -> Nothing