{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- Module      : CLI.Parsing.Internal
-- License     : BSD3
-- Maintainer  : tbidne@gmail.com
-- Internal module for CLI parsing.
module CLI.Parsing.Internal
  ( Acc (..),
    mapStrToEnv,
    pureParseArgs,
  )
where

import CLI.Types.Env
import Common.Parsing.Core
import Common.RefinedUtils
import Common.Utils
import Control.Applicative ((<|>))
import qualified Control.Applicative as A
import qualified Data.Map as M
import qualified Data.Text as T
import qualified Text.Read as TR

-- | Parses arguments into @'ParseAnd' acc@.
pureParseArgs :: [String] -> ParseAnd Acc
pureParseArgs :: [String] -> ParseAnd Acc
pureParseArgs = [AnyParser Acc] -> [String] -> ParseAnd Acc
forall acc.
Monoid acc =>
[AnyParser acc] -> [String] -> ParseAnd acc
parseAll [AnyParser Acc]
allParsers

-- | Transforms a list of commands and 'String' into 'Right' 'Env'.
-- Each non-empty, non-comment (comments start with #) line in the
-- map string are expected to have the form @key=val@. If any parse
-- errors are encountered then 'Left' 'ParseErr' is returned.
mapStrToEnv :: [T.Text] -> Maybe (RNonNegative Int) -> String -> Either ParseErr Env
mapStrToEnv :: [Text] -> Maybe (RNonNegative Int) -> String -> Either ParseErr Env
mapStrToEnv cmds :: [Text]
cmds t :: Maybe (RNonNegative Int)
t contents :: String
contents =
  let eitherMap :: Either ParseErr (Map Text Text)
eitherMap = [Text] -> Either ParseErr (Map Text Text)
linesToMap (Text -> [Text]
T.lines (String -> Text
T.pack String
contents))
   in (Map Text Text -> Env)
-> Either ParseErr (Map Text Text) -> Either ParseErr Env
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\mp :: Map Text Text
mp -> Map Text Text -> Maybe (RNonNegative Int) -> [Text] -> Env
Env Map Text Text
mp Maybe (RNonNegative Int)
t [Text]
cmds) Either ParseErr (Map Text Text)
eitherMap

linesToMap :: [T.Text] -> Either ParseErr (M.Map T.Text T.Text)
linesToMap :: [Text] -> Either ParseErr (Map Text Text)
linesToMap = (Text
 -> Either ParseErr (Map Text Text)
 -> Either ParseErr (Map Text Text))
-> Either ParseErr (Map Text Text)
-> [Text]
-> Either ParseErr (Map Text Text)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Text
-> Either ParseErr (Map Text Text)
-> Either ParseErr (Map Text Text)
f (Map Text Text -> Either ParseErr (Map Text Text)
forall a b. b -> Either a b
Right Map Text Text
forall k a. Map k a
M.empty)
  where
    f :: Text
-> Either ParseErr (Map Text Text)
-> Either ParseErr (Map Text Text)
f "" mp :: Either ParseErr (Map Text Text)
mp = Either ParseErr (Map Text Text)
mp
    f (Text -> Text -> Maybe Text
T.stripPrefix "#" -> Just _) mp :: Either ParseErr (Map Text Text)
mp = Either ParseErr (Map Text Text)
mp
    f line :: Text
line mp :: Either ParseErr (Map Text Text)
mp = ((Text, Text) -> Map Text Text -> Map Text Text)
-> Either ParseErr (Text, Text)
-> Either ParseErr (Map Text Text)
-> Either ParseErr (Map Text Text)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
A.liftA2 (Text, Text) -> Map Text Text -> Map Text Text
forall k a. Ord k => (k, a) -> Map k a -> Map k a
insertPair (Text -> Either ParseErr (Text, Text)
parseLine Text
line) Either ParseErr (Map Text Text)
mp
    insertPair :: (k, a) -> Map k a -> Map k a
insertPair (key :: k
key, cmd :: a
cmd) = k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
key a
cmd

parseLine :: T.Text -> Either ParseErr (T.Text, T.Text)
parseLine :: Text -> Either ParseErr (Text, Text)
parseLine l :: Text
l =
  case Text -> Text -> [Text]
T.splitOn "=" Text
l of
    ["", _] -> ParseErr -> Either ParseErr (Text, Text)
forall a b. a -> Either a b
Left (ParseErr -> Either ParseErr (Text, Text))
-> ParseErr -> Either ParseErr (Text, Text)
forall a b. (a -> b) -> a -> b
$ String -> ParseErr
Err (String -> ParseErr) -> String -> ParseErr
forall a b. (a -> b) -> a -> b
$ "Could not parse line `" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
l String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "` from legend file"
    [_, ""] -> ParseErr -> Either ParseErr (Text, Text)
forall a b. a -> Either a b
Left (ParseErr -> Either ParseErr (Text, Text))
-> ParseErr -> Either ParseErr (Text, Text)
forall a b. (a -> b) -> a -> b
$ String -> ParseErr
Err (String -> ParseErr) -> String -> ParseErr
forall a b. (a -> b) -> a -> b
$ "Could not parse line `" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
l String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "` from legend file"
    [key :: Text
key, cmd :: Text
cmd] -> (Text, Text) -> Either ParseErr (Text, Text)
forall a b. b -> Either a b
Right (Text
key, Text
cmd)
    _ -> ParseErr -> Either ParseErr (Text, Text)
forall a b. a -> Either a b
Left (ParseErr -> Either ParseErr (Text, Text))
-> ParseErr -> Either ParseErr (Text, Text)
forall a b. (a -> b) -> a -> b
$ String -> ParseErr
Err (String -> ParseErr) -> String -> ParseErr
forall a b. (a -> b) -> a -> b
$ "Could not parse line `" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
l String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "` from legend file"

-- | Monoid accumulator for CLI
data Acc
  = Acc
      { -- | Path to the legend file.
        Acc -> Maybe String
accLegend :: Maybe FilePath,
        -- | Maximum time to run commands
        Acc -> Maybe (RNonNegative Int)
accTimeout :: Maybe (RNonNegative Int),
        -- | List of commands to run.
        Acc -> [Text]
accCommands :: [T.Text]
      }
  deriving (Int -> Acc -> String -> String
[Acc] -> String -> String
Acc -> String
(Int -> Acc -> String -> String)
-> (Acc -> String) -> ([Acc] -> String -> String) -> Show Acc
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Acc] -> String -> String
$cshowList :: [Acc] -> String -> String
show :: Acc -> String
$cshow :: Acc -> String
showsPrec :: Int -> Acc -> String -> String
$cshowsPrec :: Int -> Acc -> String -> String
Show)

instance Semigroup Acc where
  (Acc l :: Maybe String
l t :: Maybe (RNonNegative Int)
t c :: [Text]
c) <> :: Acc -> Acc -> Acc
<> (Acc l' :: Maybe String
l' t' :: Maybe (RNonNegative Int)
t' c' :: [Text]
c') = Maybe String -> Maybe (RNonNegative Int) -> [Text] -> Acc
Acc (Maybe String
l Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe String
l') (Maybe (RNonNegative Int)
t Maybe (RNonNegative Int)
-> Maybe (RNonNegative Int) -> Maybe (RNonNegative Int)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (RNonNegative Int)
t') ([Text]
c [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
c')

instance Monoid Acc where
  mempty :: Acc
mempty = Maybe String -> Maybe (RNonNegative Int) -> [Text] -> Acc
Acc Maybe String
forall a. Maybe a
Nothing Maybe (RNonNegative Int)
forall a. Maybe a
Nothing []

allParsers :: [AnyParser Acc]
allParsers :: [AnyParser Acc]
allParsers =
  [ AnyParser Acc
pathParser,
    AnyParser Acc
timeoutParser,
    AnyParser Acc
cmdParser
  ]

pathParser :: AnyParser Acc
pathParser :: AnyParser Acc
pathParser = Parser (Maybe String) Acc -> AnyParser Acc
forall acc a. Parser a acc -> AnyParser acc
AnyParser (Parser (Maybe String) Acc -> AnyParser Acc)
-> Parser (Maybe String) Acc -> AnyParser Acc
forall a b. (a -> b) -> a -> b
$ (String, String -> Maybe (Maybe String),
 Acc -> Maybe String -> Acc)
-> Parser (Maybe String) Acc
forall a acc.
(String, String -> Maybe a, acc -> a -> acc) -> Parser a acc
PrefixParser ("--legend=", String -> Maybe (Maybe String)
forall a. (Eq a, IsString a) => a -> Maybe (Maybe a)
parser, Acc -> Maybe String -> Acc
updater)
  where
    parser :: a -> Maybe (Maybe a)
parser "" = Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
forall a. Maybe a
Nothing
    parser s :: a
s = Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just (Maybe a -> Maybe (Maybe a)) -> Maybe a -> Maybe (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
s
    updater :: Acc -> Maybe String -> Acc
updater acc :: Acc
acc p :: Maybe String
p = Acc
acc {accLegend :: Maybe String
accLegend = Maybe String
p}

timeoutParser :: AnyParser Acc
timeoutParser :: AnyParser Acc
timeoutParser = Parser (Maybe (RNonNegative Int)) Acc -> AnyParser Acc
forall acc a. Parser a acc -> AnyParser acc
AnyParser (Parser (Maybe (RNonNegative Int)) Acc -> AnyParser Acc)
-> Parser (Maybe (RNonNegative Int)) Acc -> AnyParser Acc
forall a b. (a -> b) -> a -> b
$ (String, String -> Maybe (Maybe (RNonNegative Int)),
 Acc -> Maybe (RNonNegative Int) -> Acc)
-> Parser (Maybe (RNonNegative Int)) Acc
forall a acc.
(String, String -> Maybe a, acc -> a -> acc) -> Parser a acc
PrefixParser ("--timeout=", String -> Maybe (Maybe (RNonNegative Int))
forall x p.
(Read x, Predicate p x) =>
String -> Maybe (Maybe (Refined p x))
parser, Acc -> Maybe (RNonNegative Int) -> Acc
updater)
  where
    parser :: String -> Maybe (Maybe (Refined p x))
parser s :: String
s =
      let readAndRefine :: String -> Maybe (Refined p x)
readAndRefine = (String -> Either String x)
-> (x -> Either RefineException (Refined p x))
-> String
-> Maybe (Refined p x)
forall a b c d e.
(a -> Either b c) -> (c -> Either d e) -> a -> Maybe e
eitherComposeMay String -> Either String x
forall a. Read a => String -> Either String a
TR.readEither x -> Either RefineException (Refined p x)
forall p x.
Predicate p x =>
x -> Either RefineException (Refined p x)
refine
       in Refined p x -> Maybe (Refined p x)
forall a. a -> Maybe a
Just (Refined p x -> Maybe (Refined p x))
-> Maybe (Refined p x) -> Maybe (Maybe (Refined p x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe (Refined p x)
readAndRefine String
s
    updater :: Acc -> Maybe (RNonNegative Int) -> Acc
updater acc :: Acc
acc t :: Maybe (RNonNegative Int)
t = Acc
acc {accTimeout :: Maybe (RNonNegative Int)
accTimeout = Maybe (RNonNegative Int)
t}

-- always succeeds _except_ when it's a --legend or --timeout arg
cmdParser :: AnyParser Acc
cmdParser :: AnyParser Acc
cmdParser = Parser Text Acc -> AnyParser Acc
forall acc a. Parser a acc -> AnyParser acc
AnyParser (Parser Text Acc -> AnyParser Acc)
-> Parser Text Acc -> AnyParser Acc
forall a b. (a -> b) -> a -> b
$ (String -> Maybe Text, Acc -> Text -> Acc) -> Parser Text Acc
forall a acc. (String -> Maybe a, acc -> a -> acc) -> Parser a acc
ExactParser (String -> Maybe Text
parser, Acc -> Text -> Acc
updater)
  where
    parser :: String -> Maybe Text
parser (String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
matchAndStrip "--legend=" -> Just _) = Maybe Text
forall a. Maybe a
Nothing
    parser (String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
matchAndStrip "--timeout=" -> Just _) = Maybe Text
forall a. Maybe a
Nothing
    parser s :: String
s = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
    updater :: Acc -> Text -> Acc
updater acc :: Acc
acc@Acc {[Text]
accCommands :: [Text]
accCommands :: Acc -> [Text]
accCommands} c :: Text
c = Acc
acc {accCommands :: [Text]
accCommands = Text
c Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
accCommands}