-- |
-- Copyright: (c) 2019 Lucas David Traverso
-- License: MPL-2.0
-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>
-- Stability: stable
-- Portability: portable
--
-- Command line arguments based source
module Conferer.Source.CLIArgs where

import Data.Text (Text)
import qualified Data.Text as Text
import Data.Maybe (mapMaybe)
import System.Environment (getArgs)

import Conferer.Source
import qualified Conferer.Source.InMemory as InMemory


-- | This source provides keys from the command line arguments passed into
-- the program. It only accepts arguments with @--@ and an equals, for
-- example: @./awesomeapp --warp.port=5000@
data CLIArgsSource =
  CLIArgsSource
  { CLIArgsSource -> RawCLIArgs
originalCliArgs :: RawCLIArgs
  , CLIArgsSource -> Source
innerSource :: Source
  } deriving (Int -> CLIArgsSource -> ShowS
[CLIArgsSource] -> ShowS
CLIArgsSource -> String
(Int -> CLIArgsSource -> ShowS)
-> (CLIArgsSource -> String)
-> ([CLIArgsSource] -> ShowS)
-> Show CLIArgsSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CLIArgsSource] -> ShowS
$cshowList :: [CLIArgsSource] -> ShowS
show :: CLIArgsSource -> String
$cshow :: CLIArgsSource -> String
showsPrec :: Int -> CLIArgsSource -> ShowS
$cshowsPrec :: Int -> CLIArgsSource -> ShowS
Show)

-- | Type alias for cli args
type RawCLIArgs = [String]

instance IsSource CLIArgsSource where
  getKeyInSource :: CLIArgsSource -> Key -> IO (Maybe Text)
getKeyInSource CLIArgsSource{RawCLIArgs
Source
innerSource :: Source
originalCliArgs :: RawCLIArgs
innerSource :: CLIArgsSource -> Source
originalCliArgs :: CLIArgsSource -> RawCLIArgs
..} Key
key = do
    Source -> Key -> IO (Maybe Text)
forall s. IsSource s => s -> Key -> IO (Maybe Text)
getKeyInSource Source
innerSource Key
key
  getSubkeysInSource :: CLIArgsSource -> Key -> IO [Key]
getSubkeysInSource CLIArgsSource{RawCLIArgs
Source
innerSource :: Source
originalCliArgs :: RawCLIArgs
innerSource :: CLIArgsSource -> Source
originalCliArgs :: CLIArgsSource -> RawCLIArgs
..} Key
key = do
    Source -> Key -> IO [Key]
forall s. IsSource s => s -> Key -> IO [Key]
getSubkeysInSource Source
innerSource Key
key


-- | Create a 'SourceCreator' using 'fromEnv'
fromConfig :: SourceCreator
fromConfig :: SourceCreator
fromConfig = \Config
_config ->
  IO Source
fromEnv

-- | Create a 'Source' using 'fromArgs' but using real cli args
fromEnv :: IO Source
fromEnv :: IO Source
fromEnv = do
  RawCLIArgs
args <- IO RawCLIArgs
getArgs
  Source -> IO Source
forall (m :: * -> *) a. Monad m => a -> m a
return (Source -> IO Source) -> Source -> IO Source
forall a b. (a -> b) -> a -> b
$ RawCLIArgs -> Source
fromArgs RawCLIArgs
args

-- | Create a 'Source' using cli args passed as parameter
fromArgs :: RawCLIArgs -> Source
fromArgs :: RawCLIArgs -> Source
fromArgs RawCLIArgs
originalCliArgs =
  let configMap :: [(Key, Text)]
configMap = RawCLIArgs -> [(Key, Text)]
parseArgsIntoKeyValue RawCLIArgs
originalCliArgs
      innerSource :: Source
innerSource = [(Key, Text)] -> Source
InMemory.fromAssociations [(Key, Text)]
configMap
  in CLIArgsSource -> Source
forall s. (IsSource s, Show s) => s -> Source
Source (CLIArgsSource -> Source) -> CLIArgsSource -> Source
forall a b. (a -> b) -> a -> b
$ CLIArgsSource :: RawCLIArgs -> Source -> CLIArgsSource
CLIArgsSource {RawCLIArgs
Source
innerSource :: Source
originalCliArgs :: RawCLIArgs
innerSource :: Source
originalCliArgs :: RawCLIArgs
..}

-- | Parse an argument list into a dictionary suitable for a 'Source'
parseArgsIntoKeyValue :: [String] -> [(Key, Text)]
parseArgsIntoKeyValue :: RawCLIArgs -> [(Key, Text)]
parseArgsIntoKeyValue =
  (Text -> (Key, Text)) -> [Text] -> [(Key, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
s ->
    let (Text
k, Text
rawValue) = Text -> Text -> (Text, Text)
Text.breakOn Text
"=" Text
s
    in case Text -> Maybe (Char, Text)
Text.uncons Text
rawValue of
         Maybe (Char, Text)
Nothing -> (Text -> Key
fromText Text
k, Text
"true")
         (Just (Char
'=', Text
v)) -> (Text -> Key
fromText Text
k, Text
v)
         -- Since rawValue comes from breaking on "=" the first character
         -- should always be '=' or none at all
         (Just (Char
_, Text
_)) ->
            String -> (Key, Text)
forall a. HasCallStack => String -> a
error (String -> (Key, Text)) -> String -> (Key, Text)
forall a b. (a -> b) -> a -> b
$ RawCLIArgs -> String
unlines
              [ String
"'"
              , Text -> String
Text.unpack Text
rawValue
              , String
"' should always start with '='"
              ]
    ) ([Text] -> [(Key, Text)])
-> (RawCLIArgs -> [Text]) -> RawCLIArgs -> [(Key, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (Text -> Maybe Text) -> [Text] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> Text -> Maybe Text
Text.stripPrefix Text
"--") ([Text] -> [Text])
-> (RawCLIArgs -> [Text]) -> RawCLIArgs -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"--") ([Text] -> [Text])
-> (RawCLIArgs -> [Text]) -> RawCLIArgs -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (String -> Text) -> RawCLIArgs -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
Text.pack