{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

module Navi.Data.CommandResultParser
  ( CommandResultParserToml (..),
    CommandResultParser (..),
    commandResultParserDecoder,
    defaultParser,
  )
where

import Data.Text qualified as T
import Navi.Data.CommandResult
  ( CommandResult
      ( MkCommandResult,
        output,
        pollInterval,
        result
      ),
  )
import Navi.Data.PollInterval (parsePollInterval)
import Navi.Data.Result (Result (Err, Ok), ResultDefault)
import Navi.Event.Types.EventError (EventError (MkEventError, long, name, short))
import Navi.Prelude

-- | Parses a text command result
newtype CommandResultParser = MkCommandResultParser
  { CommandResultParser -> Text -> Either EventError CommandResult
unCommandResultParser :: Text -> Either EventError CommandResult
  }

makeFieldLabelsNoPrefix ''CommandResultParser

instance Show CommandResultParser where
  show :: CommandResultParser -> [Char]
show CommandResultParser
_ = [Char]
"<parser>"

instance Eq CommandResultParser where
  CommandResultParser
_ == :: CommandResultParser -> CommandResultParser -> Bool
== CommandResultParser
_ = Bool
True

-- | Toml
data CommandResultElem
  = CommandResultElemPollInterval
  | CommandResultElemTrigger
  | CommandResultElemOutput
  deriving stock (CommandResultElem -> CommandResultElem -> Bool
(CommandResultElem -> CommandResultElem -> Bool)
-> (CommandResultElem -> CommandResultElem -> Bool)
-> Eq CommandResultElem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommandResultElem -> CommandResultElem -> Bool
== :: CommandResultElem -> CommandResultElem -> Bool
$c/= :: CommandResultElem -> CommandResultElem -> Bool
/= :: CommandResultElem -> CommandResultElem -> Bool
Eq, Int -> CommandResultElem -> ShowS
[CommandResultElem] -> ShowS
CommandResultElem -> [Char]
(Int -> CommandResultElem -> ShowS)
-> (CommandResultElem -> [Char])
-> ([CommandResultElem] -> ShowS)
-> Show CommandResultElem
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommandResultElem -> ShowS
showsPrec :: Int -> CommandResultElem -> ShowS
$cshow :: CommandResultElem -> [Char]
show :: CommandResultElem -> [Char]
$cshowList :: [CommandResultElem] -> ShowS
showList :: [CommandResultElem] -> ShowS
Show)

displayElem :: CommandResultElem -> String
displayElem :: CommandResultElem -> [Char]
displayElem CommandResultElem
CommandResultElemPollInterval = [Char]
"poll-interval"
displayElem CommandResultElem
CommandResultElemTrigger = [Char]
"trigger"
displayElem CommandResultElem
CommandResultElemOutput = [Char]
"output"

displayElems2 :: (CommandResultElem, CommandResultElem) -> String
displayElems2 :: (CommandResultElem, CommandResultElem) -> [Char]
displayElems2 (CommandResultElem
x1, CommandResultElem
x2) = [Char]
"(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ CommandResultElem -> [Char]
displayElem CommandResultElem
x1 [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
", " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ CommandResultElem -> [Char]
displayElem CommandResultElem
x2 [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"

displayElems3 :: (CommandResultElem, CommandResultElem, CommandResultElem) -> String
displayElems3 :: (CommandResultElem, CommandResultElem, CommandResultElem) -> [Char]
displayElems3 (CommandResultElem
x1, CommandResultElem
x2, CommandResultElem
x3) =
  [Char]
"("
    [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ CommandResultElem -> [Char]
displayElem CommandResultElem
x1
    [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
", "
    [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ CommandResultElem -> [Char]
displayElem CommandResultElem
x2
    [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
", "
    [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ CommandResultElem -> [Char]
displayElem CommandResultElem
x3
    [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"

parseResultType :: (MonadFail m) => Text -> m CommandResultElem
parseResultType :: forall (m :: Type -> Type).
MonadFail m =>
Text -> m CommandResultElem
parseResultType Text
"poll-interval" = CommandResultElem -> m CommandResultElem
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure CommandResultElem
CommandResultElemPollInterval
parseResultType Text
"trigger" = CommandResultElem -> m CommandResultElem
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure CommandResultElem
CommandResultElemTrigger
parseResultType Text
"output" = CommandResultElem -> m CommandResultElem
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure CommandResultElem
CommandResultElemOutput
parseResultType Text
other =
  [Char] -> m CommandResultElem
forall a. [Char] -> m a
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail
    ([Char] -> m CommandResultElem) -> [Char] -> m CommandResultElem
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall a. Monoid a => [a] -> a
mconcat
      [ [Char]
"Unrecognized command-result: '",
        Text -> [Char]
unpackText Text
other,
        [Char]
"'"
      ]

-- | Exists so that we can attach the DecodeTOML instance. The text argument
-- is the service's name, which we later use when throwing parse errors.
newtype CommandResultParserToml = MkCommandResultParserToml
  { CommandResultParserToml -> Text -> CommandResultParser
unCommandResultParserToml :: Text -> CommandResultParser
  }

makeFieldLabelsNoPrefix ''CommandResultParserToml

instance Show CommandResultParserToml where
  show :: CommandResultParserToml -> [Char]
show CommandResultParserToml
_ = [Char]
"<parser>"

instance Eq CommandResultParserToml where
  CommandResultParserToml
_ == :: CommandResultParserToml -> CommandResultParserToml -> Bool
== CommandResultParserToml
_ = Bool
True

instance DecodeTOML CommandResultParserToml where
  tomlDecoder :: Decoder CommandResultParserToml
tomlDecoder = do
    Text
txt <- Decoder Text
forall a. DecodeTOML a => Decoder a
tomlDecoder

    let isParens :: Bool
isParens = Text -> Bool
checkParens Text
txt
        numCommas :: Int
numCommas = Text -> Int
countCommas Text
txt

    -- Manually pick parsers rather than just combining with asum so we can
    -- get better error messages.
    Text -> CommandResultParser
r <-
      if
        | Bool
isParens Bool -> Bool -> Bool
&& Int
numCommas Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Text -> Decoder (Text -> CommandResultParser)
forall (m :: Type -> Type).
MonadFail m =>
Text -> m (Text -> CommandResultParser)
parseCommand1Tuple Text
txt
        | Bool
isParens Bool -> Bool -> Bool
&& Int
numCommas Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> Text -> Decoder (Text -> CommandResultParser)
forall (m :: Type -> Type).
MonadFail m =>
Text -> m (Text -> CommandResultParser)
parseCommand2 Text
txt
        | Bool
isParens Bool -> Bool -> Bool
&& Int
numCommas Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 -> Text -> Decoder (Text -> CommandResultParser)
forall (m :: Type -> Type).
MonadFail m =>
Text -> m (Text -> CommandResultParser)
parseCommand3 Text
txt
        | Bool
otherwise -> Text -> Decoder (Text -> CommandResultParser)
forall (m :: Type -> Type).
MonadFail m =>
Text -> m (Text -> CommandResultParser)
parseCommand1Literal Text
txt

    pure $ (Text -> CommandResultParser) -> CommandResultParserToml
MkCommandResultParserToml Text -> CommandResultParser
r
    where
      checkParens :: Text -> Bool
checkParens Text
txt =
        Text
"("
          Text -> Text -> Bool
`T.isPrefixOf` Text
txt
          Bool -> Bool -> Bool
&& Text
")"
          Text -> Text -> Bool
`T.isSuffixOf` Text
txt

      countCommas :: Text -> Int
countCommas = HasCallStack => Text -> Text -> Int
Text -> Text -> Int
T.count Text
","

commandResultParserDecoder :: Decoder (Maybe CommandResultParserToml)
commandResultParserDecoder :: Decoder (Maybe CommandResultParserToml)
commandResultParserDecoder = Decoder CommandResultParserToml
-> Text -> Decoder (Maybe CommandResultParserToml)
forall a. Decoder a -> Text -> Decoder (Maybe a)
getFieldOptWith Decoder CommandResultParserToml
forall a. DecodeTOML a => Decoder a
tomlDecoder Text
"command-result"

defaultParser :: CommandResultParser
defaultParser :: CommandResultParser
defaultParser = (Text -> Either EventError CommandResult) -> CommandResultParser
MkCommandResultParser ((Text -> Either EventError CommandResult) -> CommandResultParser)
-> (Text -> Either EventError CommandResult) -> CommandResultParser
forall a b. (a -> b) -> a -> b
$ \Text
result ->
  CommandResult -> Either EventError CommandResult
forall a b. b -> Either a b
Right
    (CommandResult -> Either EventError CommandResult)
-> CommandResult -> Either EventError CommandResult
forall a b. (a -> b) -> a -> b
$ MkCommandResult
      { Text
result :: Text
result :: Text
result,
        output :: Maybe Text
output = Maybe Text
forall a. Maybe a
Nothing,
        pollInterval :: Maybe PollInterval
pollInterval = Maybe PollInterval
forall a. Maybe a
Nothing
      }

parseCommand1Literal :: (MonadFail m) => Text -> m (Text -> CommandResultParser)
parseCommand1Literal :: forall (m :: Type -> Type).
MonadFail m =>
Text -> m (Text -> CommandResultParser)
parseCommand1Literal Text
txt = do
  Text -> m CommandResultElem
forall (m :: Type -> Type).
MonadFail m =>
Text -> m CommandResultElem
parseResultType Text
txt m CommandResultElem
-> (CommandResultElem -> m (Text -> CommandResultParser))
-> m (Text -> CommandResultParser)
forall a b. m a -> (a -> m b) -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    CommandResultElem
CommandResultElemTrigger -> (Text -> CommandResultParser) -> m (Text -> CommandResultParser)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((Text -> CommandResultParser) -> m (Text -> CommandResultParser))
-> (Text -> CommandResultParser) -> m (Text -> CommandResultParser)
forall a b. (a -> b) -> a -> b
$ CommandResultParser -> Text -> CommandResultParser
forall a b. a -> b -> a
const CommandResultParser
defaultParser
    CommandResultElem
_ ->
      [Char] -> m (Text -> CommandResultParser)
forall a. [Char] -> m a
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail
        ([Char] -> m (Text -> CommandResultParser))
-> [Char] -> m (Text -> CommandResultParser)
forall a b. (a -> b) -> a -> b
$ [Char]
"A single command result can only be 'trigger', found: "
        [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
unpackText Text
txt

parseCommand1Tuple :: (MonadFail m) => Text -> m (Text -> CommandResultParser)
parseCommand1Tuple :: forall (m :: Type -> Type).
MonadFail m =>
Text -> m (Text -> CommandResultParser)
parseCommand1Tuple Text
txt = do
  Text
inner <- Text -> m Text
forall (m :: Type -> Type). MonadFail m => Text -> m Text
parseTuple Text
txt
  Text -> m (Text -> CommandResultParser)
forall (m :: Type -> Type).
MonadFail m =>
Text -> m (Text -> CommandResultParser)
parseCommand1Literal Text
inner

-- On the Custom/Single DecodeTOML instance, but passed to MonadSystemInfo
-- as part of the Service Type.
--
-- So the service type has this parser on it. We are going to want the
-- name.
parseCommand2 :: (MonadFail m) => Text -> m (Text -> CommandResultParser)
parseCommand2 :: forall (m :: Type -> Type).
MonadFail m =>
Text -> m (Text -> CommandResultParser)
parseCommand2 Text
txt = do
  (Text
x1, Text
x2) <- Text -> m (Text, Text)
forall (m :: Type -> Type). MonadFail m => Text -> m (Text, Text)
parseTuple2 Text
txt

  CommandResultElem
o1 <- Text -> m CommandResultElem
forall (m :: Type -> Type).
MonadFail m =>
Text -> m CommandResultElem
parseResultType Text
x1
  CommandResultElem
o2 <- Text -> m CommandResultElem
forall (m :: Type -> Type).
MonadFail m =>
Text -> m CommandResultElem
parseResultType Text
x2

  case (CommandResultElem
o1, CommandResultElem
o2) of
    (CommandResultElem
CommandResultElemTrigger, CommandResultElem
CommandResultElemOutput) ->
      (Text -> CommandResultParser) -> m (Text -> CommandResultParser)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((Text -> CommandResultParser) -> m (Text -> CommandResultParser))
-> (Text -> CommandResultParser) -> m (Text -> CommandResultParser)
forall a b. (a -> b) -> a -> b
$ \Text
name -> (Text -> Either EventError CommandResult) -> CommandResultParser
MkCommandResultParser ((Text -> Either EventError CommandResult) -> CommandResultParser)
-> (Text -> Either EventError CommandResult) -> CommandResultParser
forall a b. (a -> b) -> a -> b
$ \Text
r -> do
        (Text
result, Text
output) <-
          Text
-> Text
-> ResultDefault (Text, Text)
-> Either EventError (Text, Text)
forall a. Text -> Text -> ResultDefault a -> Either EventError a
liftParse Text
name Text
"Failed to parse (trigger, output)" (ResultDefault (Text, Text) -> Either EventError (Text, Text))
-> ResultDefault (Text, Text) -> Either EventError (Text, Text)
forall a b. (a -> b) -> a -> b
$ Text -> ResultDefault (Text, Text)
forall (m :: Type -> Type). MonadFail m => Text -> m (Text, Text)
parseTuple2 Text
r
        CommandResult -> Either EventError CommandResult
forall a. a -> Either EventError a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
          (CommandResult -> Either EventError CommandResult)
-> CommandResult -> Either EventError CommandResult
forall a b. (a -> b) -> a -> b
$ MkCommandResult
            { Text
result :: Text
result :: Text
result,
              output :: Maybe Text
output = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
output,
              pollInterval :: Maybe PollInterval
pollInterval = Maybe PollInterval
forall a. Maybe a
Nothing
            }
    (CommandResultElem
CommandResultElemTrigger, CommandResultElem
CommandResultElemPollInterval) ->
      (Text -> CommandResultParser) -> m (Text -> CommandResultParser)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((Text -> CommandResultParser) -> m (Text -> CommandResultParser))
-> (Text -> CommandResultParser) -> m (Text -> CommandResultParser)
forall a b. (a -> b) -> a -> b
$ \Text
name -> (Text -> Either EventError CommandResult) -> CommandResultParser
MkCommandResultParser ((Text -> Either EventError CommandResult) -> CommandResultParser)
-> (Text -> Either EventError CommandResult) -> CommandResultParser
forall a b. (a -> b) -> a -> b
$ \Text
r -> do
        let desc :: Text
desc = Text
"Failed to parse (trigger, poll-interval)"
        (Text
result, Text
pollIntervalTxt) <- Text
-> Text
-> ResultDefault (Text, Text)
-> Either EventError (Text, Text)
forall a. Text -> Text -> ResultDefault a -> Either EventError a
liftParse Text
name Text
desc (ResultDefault (Text, Text) -> Either EventError (Text, Text))
-> ResultDefault (Text, Text) -> Either EventError (Text, Text)
forall a b. (a -> b) -> a -> b
$ Text -> ResultDefault (Text, Text)
forall (m :: Type -> Type). MonadFail m => Text -> m (Text, Text)
parseTuple2 Text
r
        PollInterval
pollInterval <- Text
-> Text
-> ResultDefault PollInterval
-> Either EventError PollInterval
forall a. Text -> Text -> ResultDefault a -> Either EventError a
liftParse Text
name Text
desc (ResultDefault PollInterval -> Either EventError PollInterval)
-> ResultDefault PollInterval -> Either EventError PollInterval
forall a b. (a -> b) -> a -> b
$ Text -> ResultDefault PollInterval
forall (m :: Type -> Type). MonadFail m => Text -> m PollInterval
parsePollInterval Text
pollIntervalTxt
        pure
          $ MkCommandResult
            { Text
result :: Text
result :: Text
result,
              output :: Maybe Text
output = Maybe Text
forall a. Maybe a
Nothing,
              pollInterval :: Maybe PollInterval
pollInterval = PollInterval -> Maybe PollInterval
forall a. a -> Maybe a
Just PollInterval
pollInterval
            }
    (CommandResultElem
CommandResultElemOutput, CommandResultElem
CommandResultElemTrigger) ->
      (Text -> CommandResultParser) -> m (Text -> CommandResultParser)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((Text -> CommandResultParser) -> m (Text -> CommandResultParser))
-> (Text -> CommandResultParser) -> m (Text -> CommandResultParser)
forall a b. (a -> b) -> a -> b
$ \Text
name -> (Text -> Either EventError CommandResult) -> CommandResultParser
MkCommandResultParser ((Text -> Either EventError CommandResult) -> CommandResultParser)
-> (Text -> Either EventError CommandResult) -> CommandResultParser
forall a b. (a -> b) -> a -> b
$ \Text
r -> do
        (Text
output, Text
result) <-
          Text
-> Text
-> ResultDefault (Text, Text)
-> Either EventError (Text, Text)
forall a. Text -> Text -> ResultDefault a -> Either EventError a
liftParse Text
name Text
"Failed to parse (output, trigger)" (ResultDefault (Text, Text) -> Either EventError (Text, Text))
-> ResultDefault (Text, Text) -> Either EventError (Text, Text)
forall a b. (a -> b) -> a -> b
$ Text -> ResultDefault (Text, Text)
forall (m :: Type -> Type). MonadFail m => Text -> m (Text, Text)
parseTuple2 Text
r
        CommandResult -> Either EventError CommandResult
forall a. a -> Either EventError a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
          (CommandResult -> Either EventError CommandResult)
-> CommandResult -> Either EventError CommandResult
forall a b. (a -> b) -> a -> b
$ MkCommandResult
            { Text
result :: Text
result :: Text
result,
              output :: Maybe Text
output = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
output,
              pollInterval :: Maybe PollInterval
pollInterval = Maybe PollInterval
forall a. Maybe a
Nothing
            }
    (CommandResultElem
CommandResultElemPollInterval, CommandResultElem
CommandResultElemTrigger) ->
      (Text -> CommandResultParser) -> m (Text -> CommandResultParser)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((Text -> CommandResultParser) -> m (Text -> CommandResultParser))
-> (Text -> CommandResultParser) -> m (Text -> CommandResultParser)
forall a b. (a -> b) -> a -> b
$ \Text
name -> (Text -> Either EventError CommandResult) -> CommandResultParser
MkCommandResultParser ((Text -> Either EventError CommandResult) -> CommandResultParser)
-> (Text -> Either EventError CommandResult) -> CommandResultParser
forall a b. (a -> b) -> a -> b
$ \Text
r -> do
        let desc :: Text
desc = Text
"Failed to parse (poll-interval, trigger)"
        (Text
pollIntervalTxt, Text
result) <- Text
-> Text
-> ResultDefault (Text, Text)
-> Either EventError (Text, Text)
forall a. Text -> Text -> ResultDefault a -> Either EventError a
liftParse Text
name Text
desc (ResultDefault (Text, Text) -> Either EventError (Text, Text))
-> ResultDefault (Text, Text) -> Either EventError (Text, Text)
forall a b. (a -> b) -> a -> b
$ Text -> ResultDefault (Text, Text)
forall (m :: Type -> Type). MonadFail m => Text -> m (Text, Text)
parseTuple2 Text
r
        PollInterval
pollInterval <- Text
-> Text
-> ResultDefault PollInterval
-> Either EventError PollInterval
forall a. Text -> Text -> ResultDefault a -> Either EventError a
liftParse Text
name Text
desc (ResultDefault PollInterval -> Either EventError PollInterval)
-> ResultDefault PollInterval -> Either EventError PollInterval
forall a b. (a -> b) -> a -> b
$ Text -> ResultDefault PollInterval
forall (m :: Type -> Type). MonadFail m => Text -> m PollInterval
parsePollInterval Text
pollIntervalTxt
        pure
          $ MkCommandResult
            { Text
result :: Text
result :: Text
result,
              output :: Maybe Text
output = Maybe Text
forall a. Maybe a
Nothing,
              pollInterval :: Maybe PollInterval
pollInterval = PollInterval -> Maybe PollInterval
forall a. a -> Maybe a
Just PollInterval
pollInterval
            }
    (CommandResultElem, CommandResultElem)
_ ->
      [Char] -> m (Text -> CommandResultParser)
forall a. [Char] -> m a
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail ([Char] -> m (Text -> CommandResultParser))
-> [Char] -> m (Text -> CommandResultParser)
forall a b. (a -> b) -> a -> b
$ [Char]
"Expected one 'trigger' and one more element, found: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (CommandResultElem, CommandResultElem) -> [Char]
displayElems2 (CommandResultElem
o1, CommandResultElem
o2)

parseCommand3 :: (MonadFail m) => Text -> m (Text -> CommandResultParser)
parseCommand3 :: forall (m :: Type -> Type).
MonadFail m =>
Text -> m (Text -> CommandResultParser)
parseCommand3 Text
txt = do
  (Text
x1, Text
x2, Text
x3) <- Text -> m (Text, Text, Text)
forall (m :: Type -> Type).
MonadFail m =>
Text -> m (Text, Text, Text)
parseTuple3 Text
txt

  CommandResultElem
o1 <- Text -> m CommandResultElem
forall (m :: Type -> Type).
MonadFail m =>
Text -> m CommandResultElem
parseResultType Text
x1
  CommandResultElem
o2 <- Text -> m CommandResultElem
forall (m :: Type -> Type).
MonadFail m =>
Text -> m CommandResultElem
parseResultType Text
x2
  CommandResultElem
o3 <- Text -> m CommandResultElem
forall (m :: Type -> Type).
MonadFail m =>
Text -> m CommandResultElem
parseResultType Text
x3

  case (CommandResultElem
o1, CommandResultElem
o2, CommandResultElem
o3) of
    -- T O P
    (CommandResultElem
CommandResultElemTrigger, CommandResultElem
CommandResultElemOutput, CommandResultElem
CommandResultElemPollInterval) ->
      (Text -> CommandResultParser) -> m (Text -> CommandResultParser)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((Text -> CommandResultParser) -> m (Text -> CommandResultParser))
-> (Text -> CommandResultParser) -> m (Text -> CommandResultParser)
forall a b. (a -> b) -> a -> b
$ \Text
name -> (Text -> Either EventError CommandResult) -> CommandResultParser
MkCommandResultParser ((Text -> Either EventError CommandResult) -> CommandResultParser)
-> (Text -> Either EventError CommandResult) -> CommandResultParser
forall a b. (a -> b) -> a -> b
$ \Text
r -> do
        let desc :: Text
desc = Text
"Failed to parse (trigger, output, poll-interval)"
        (Text
result, Text
output, Text
pollIntervalTxt) <- Text
-> Text
-> ResultDefault (Text, Text, Text)
-> Either EventError (Text, Text, Text)
forall a. Text -> Text -> ResultDefault a -> Either EventError a
liftParse Text
name Text
desc (ResultDefault (Text, Text, Text)
 -> Either EventError (Text, Text, Text))
-> ResultDefault (Text, Text, Text)
-> Either EventError (Text, Text, Text)
forall a b. (a -> b) -> a -> b
$ Text -> ResultDefault (Text, Text, Text)
forall (m :: Type -> Type).
MonadFail m =>
Text -> m (Text, Text, Text)
parseTuple3 Text
r
        PollInterval
pollInterval <- Text
-> Text
-> ResultDefault PollInterval
-> Either EventError PollInterval
forall a. Text -> Text -> ResultDefault a -> Either EventError a
liftParse Text
name Text
desc (ResultDefault PollInterval -> Either EventError PollInterval)
-> ResultDefault PollInterval -> Either EventError PollInterval
forall a b. (a -> b) -> a -> b
$ Text -> ResultDefault PollInterval
forall (m :: Type -> Type). MonadFail m => Text -> m PollInterval
parsePollInterval Text
pollIntervalTxt
        pure
          $ MkCommandResult
            { Text
result :: Text
result :: Text
result,
              output :: Maybe Text
output = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
output,
              pollInterval :: Maybe PollInterval
pollInterval = PollInterval -> Maybe PollInterval
forall a. a -> Maybe a
Just PollInterval
pollInterval
            }
    -- T P O
    (CommandResultElem
CommandResultElemTrigger, CommandResultElem
CommandResultElemPollInterval, CommandResultElem
CommandResultElemOutput) ->
      (Text -> CommandResultParser) -> m (Text -> CommandResultParser)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((Text -> CommandResultParser) -> m (Text -> CommandResultParser))
-> (Text -> CommandResultParser) -> m (Text -> CommandResultParser)
forall a b. (a -> b) -> a -> b
$ \Text
name -> (Text -> Either EventError CommandResult) -> CommandResultParser
MkCommandResultParser ((Text -> Either EventError CommandResult) -> CommandResultParser)
-> (Text -> Either EventError CommandResult) -> CommandResultParser
forall a b. (a -> b) -> a -> b
$ \Text
r -> do
        let desc :: Text
desc = Text
"Failed to parse (trigger, poll-interval, output)"
        (Text
result, Text
pollIntervalTxt, Text
output) <- Text
-> Text
-> ResultDefault (Text, Text, Text)
-> Either EventError (Text, Text, Text)
forall a. Text -> Text -> ResultDefault a -> Either EventError a
liftParse Text
name Text
desc (ResultDefault (Text, Text, Text)
 -> Either EventError (Text, Text, Text))
-> ResultDefault (Text, Text, Text)
-> Either EventError (Text, Text, Text)
forall a b. (a -> b) -> a -> b
$ Text -> ResultDefault (Text, Text, Text)
forall (m :: Type -> Type).
MonadFail m =>
Text -> m (Text, Text, Text)
parseTuple3 Text
r
        PollInterval
pollInterval <- Text
-> Text
-> ResultDefault PollInterval
-> Either EventError PollInterval
forall a. Text -> Text -> ResultDefault a -> Either EventError a
liftParse Text
name Text
desc (ResultDefault PollInterval -> Either EventError PollInterval)
-> ResultDefault PollInterval -> Either EventError PollInterval
forall a b. (a -> b) -> a -> b
$ Text -> ResultDefault PollInterval
forall (m :: Type -> Type). MonadFail m => Text -> m PollInterval
parsePollInterval Text
pollIntervalTxt
        pure
          $ MkCommandResult
            { Text
result :: Text
result :: Text
result,
              output :: Maybe Text
output = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
output,
              pollInterval :: Maybe PollInterval
pollInterval = PollInterval -> Maybe PollInterval
forall a. a -> Maybe a
Just PollInterval
pollInterval
            }
    -- O T P
    (CommandResultElem
CommandResultElemOutput, CommandResultElem
CommandResultElemTrigger, CommandResultElem
CommandResultElemPollInterval) ->
      (Text -> CommandResultParser) -> m (Text -> CommandResultParser)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((Text -> CommandResultParser) -> m (Text -> CommandResultParser))
-> (Text -> CommandResultParser) -> m (Text -> CommandResultParser)
forall a b. (a -> b) -> a -> b
$ \Text
name -> (Text -> Either EventError CommandResult) -> CommandResultParser
MkCommandResultParser ((Text -> Either EventError CommandResult) -> CommandResultParser)
-> (Text -> Either EventError CommandResult) -> CommandResultParser
forall a b. (a -> b) -> a -> b
$ \Text
r -> do
        let desc :: Text
desc = Text
"Failed to parse (output, trigger, poll-interval)"
        (Text
output, Text
result, Text
pollIntervalTxt) <- Text
-> Text
-> ResultDefault (Text, Text, Text)
-> Either EventError (Text, Text, Text)
forall a. Text -> Text -> ResultDefault a -> Either EventError a
liftParse Text
name Text
desc (ResultDefault (Text, Text, Text)
 -> Either EventError (Text, Text, Text))
-> ResultDefault (Text, Text, Text)
-> Either EventError (Text, Text, Text)
forall a b. (a -> b) -> a -> b
$ Text -> ResultDefault (Text, Text, Text)
forall (m :: Type -> Type).
MonadFail m =>
Text -> m (Text, Text, Text)
parseTuple3 Text
r
        PollInterval
pollInterval <- Text
-> Text
-> ResultDefault PollInterval
-> Either EventError PollInterval
forall a. Text -> Text -> ResultDefault a -> Either EventError a
liftParse Text
name Text
desc (ResultDefault PollInterval -> Either EventError PollInterval)
-> ResultDefault PollInterval -> Either EventError PollInterval
forall a b. (a -> b) -> a -> b
$ Text -> ResultDefault PollInterval
forall (m :: Type -> Type). MonadFail m => Text -> m PollInterval
parsePollInterval Text
pollIntervalTxt
        pure
          $ MkCommandResult
            { Text
result :: Text
result :: Text
result,
              output :: Maybe Text
output = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
output,
              pollInterval :: Maybe PollInterval
pollInterval = PollInterval -> Maybe PollInterval
forall a. a -> Maybe a
Just PollInterval
pollInterval
            }
    -- O P T
    (CommandResultElem
CommandResultElemOutput, CommandResultElem
CommandResultElemPollInterval, CommandResultElem
CommandResultElemTrigger) ->
      (Text -> CommandResultParser) -> m (Text -> CommandResultParser)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((Text -> CommandResultParser) -> m (Text -> CommandResultParser))
-> (Text -> CommandResultParser) -> m (Text -> CommandResultParser)
forall a b. (a -> b) -> a -> b
$ \Text
name -> (Text -> Either EventError CommandResult) -> CommandResultParser
MkCommandResultParser ((Text -> Either EventError CommandResult) -> CommandResultParser)
-> (Text -> Either EventError CommandResult) -> CommandResultParser
forall a b. (a -> b) -> a -> b
$ \Text
r -> do
        let desc :: Text
desc = Text
"Failed to parse (output, poll-interval, trigger)"
        (Text
output, Text
pollIntervalTxt, Text
result) <- Text
-> Text
-> ResultDefault (Text, Text, Text)
-> Either EventError (Text, Text, Text)
forall a. Text -> Text -> ResultDefault a -> Either EventError a
liftParse Text
name Text
desc (ResultDefault (Text, Text, Text)
 -> Either EventError (Text, Text, Text))
-> ResultDefault (Text, Text, Text)
-> Either EventError (Text, Text, Text)
forall a b. (a -> b) -> a -> b
$ Text -> ResultDefault (Text, Text, Text)
forall (m :: Type -> Type).
MonadFail m =>
Text -> m (Text, Text, Text)
parseTuple3 Text
r
        PollInterval
pollInterval <- Text
-> Text
-> ResultDefault PollInterval
-> Either EventError PollInterval
forall a. Text -> Text -> ResultDefault a -> Either EventError a
liftParse Text
name Text
desc (ResultDefault PollInterval -> Either EventError PollInterval)
-> ResultDefault PollInterval -> Either EventError PollInterval
forall a b. (a -> b) -> a -> b
$ Text -> ResultDefault PollInterval
forall (m :: Type -> Type). MonadFail m => Text -> m PollInterval
parsePollInterval Text
pollIntervalTxt
        pure
          $ MkCommandResult
            { Text
result :: Text
result :: Text
result,
              output :: Maybe Text
output = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
output,
              pollInterval :: Maybe PollInterval
pollInterval = PollInterval -> Maybe PollInterval
forall a. a -> Maybe a
Just PollInterval
pollInterval
            }
    -- P T O
    (CommandResultElem
CommandResultElemPollInterval, CommandResultElem
CommandResultElemTrigger, CommandResultElem
CommandResultElemOutput) ->
      (Text -> CommandResultParser) -> m (Text -> CommandResultParser)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((Text -> CommandResultParser) -> m (Text -> CommandResultParser))
-> (Text -> CommandResultParser) -> m (Text -> CommandResultParser)
forall a b. (a -> b) -> a -> b
$ \Text
name -> (Text -> Either EventError CommandResult) -> CommandResultParser
MkCommandResultParser ((Text -> Either EventError CommandResult) -> CommandResultParser)
-> (Text -> Either EventError CommandResult) -> CommandResultParser
forall a b. (a -> b) -> a -> b
$ \Text
r -> do
        let desc :: Text
desc = Text
"Failed to parse (poll-interval, trigger, output)"
        (Text
pollIntervalTxt, Text
result, Text
output) <- Text
-> Text
-> ResultDefault (Text, Text, Text)
-> Either EventError (Text, Text, Text)
forall a. Text -> Text -> ResultDefault a -> Either EventError a
liftParse Text
name Text
desc (ResultDefault (Text, Text, Text)
 -> Either EventError (Text, Text, Text))
-> ResultDefault (Text, Text, Text)
-> Either EventError (Text, Text, Text)
forall a b. (a -> b) -> a -> b
$ Text -> ResultDefault (Text, Text, Text)
forall (m :: Type -> Type).
MonadFail m =>
Text -> m (Text, Text, Text)
parseTuple3 Text
r
        PollInterval
pollInterval <- Text
-> Text
-> ResultDefault PollInterval
-> Either EventError PollInterval
forall a. Text -> Text -> ResultDefault a -> Either EventError a
liftParse Text
name Text
desc (ResultDefault PollInterval -> Either EventError PollInterval)
-> ResultDefault PollInterval -> Either EventError PollInterval
forall a b. (a -> b) -> a -> b
$ Text -> ResultDefault PollInterval
forall (m :: Type -> Type). MonadFail m => Text -> m PollInterval
parsePollInterval Text
pollIntervalTxt
        pure
          $ MkCommandResult
            { Text
result :: Text
result :: Text
result,
              output :: Maybe Text
output = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
output,
              pollInterval :: Maybe PollInterval
pollInterval = PollInterval -> Maybe PollInterval
forall a. a -> Maybe a
Just PollInterval
pollInterval
            }
    -- P O T
    (CommandResultElem
CommandResultElemPollInterval, CommandResultElem
CommandResultElemOutput, CommandResultElem
CommandResultElemTrigger) ->
      (Text -> CommandResultParser) -> m (Text -> CommandResultParser)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((Text -> CommandResultParser) -> m (Text -> CommandResultParser))
-> (Text -> CommandResultParser) -> m (Text -> CommandResultParser)
forall a b. (a -> b) -> a -> b
$ \Text
name -> (Text -> Either EventError CommandResult) -> CommandResultParser
MkCommandResultParser ((Text -> Either EventError CommandResult) -> CommandResultParser)
-> (Text -> Either EventError CommandResult) -> CommandResultParser
forall a b. (a -> b) -> a -> b
$ \Text
r -> do
        let desc :: Text
desc = Text
"Failed to parse (poll-interval, output, trigger)"
        (Text
pollIntervalTxt, Text
output, Text
result) <- Text
-> Text
-> ResultDefault (Text, Text, Text)
-> Either EventError (Text, Text, Text)
forall a. Text -> Text -> ResultDefault a -> Either EventError a
liftParse Text
name Text
desc (ResultDefault (Text, Text, Text)
 -> Either EventError (Text, Text, Text))
-> ResultDefault (Text, Text, Text)
-> Either EventError (Text, Text, Text)
forall a b. (a -> b) -> a -> b
$ Text -> ResultDefault (Text, Text, Text)
forall (m :: Type -> Type).
MonadFail m =>
Text -> m (Text, Text, Text)
parseTuple3 Text
r
        PollInterval
pollInterval <- Text
-> Text
-> ResultDefault PollInterval
-> Either EventError PollInterval
forall a. Text -> Text -> ResultDefault a -> Either EventError a
liftParse Text
name Text
desc (ResultDefault PollInterval -> Either EventError PollInterval)
-> ResultDefault PollInterval -> Either EventError PollInterval
forall a b. (a -> b) -> a -> b
$ Text -> ResultDefault PollInterval
forall (m :: Type -> Type). MonadFail m => Text -> m PollInterval
parsePollInterval Text
pollIntervalTxt
        pure
          $ MkCommandResult
            { Text
result :: Text
result :: Text
result,
              output :: Maybe Text
output = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
output,
              pollInterval :: Maybe PollInterval
pollInterval = PollInterval -> Maybe PollInterval
forall a. a -> Maybe a
Just PollInterval
pollInterval
            }
    (CommandResultElem, CommandResultElem, CommandResultElem)
_ ->
      [Char] -> m (Text -> CommandResultParser)
forall a. [Char] -> m a
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail ([Char] -> m (Text -> CommandResultParser))
-> [Char] -> m (Text -> CommandResultParser)
forall a b. (a -> b) -> a -> b
$ [Char]
"Expected 3 different elements, found: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (CommandResultElem, CommandResultElem, CommandResultElem) -> [Char]
displayElems3 (CommandResultElem
o1, CommandResultElem
o2, CommandResultElem
o3)

parseTuple :: (MonadFail m) => Text -> m Text
parseTuple :: forall (m :: Type -> Type). MonadFail m => Text -> m Text
parseTuple Text
txt = do
  Text
r1 <- [Char] -> Maybe Text -> m Text
forall (m :: Type -> Type) a.
MonadFail m =>
[Char] -> Maybe a -> m a
liftMonadFail ([Char]
"Expected '(', received: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
unpackText Text
txt) (Maybe Text -> m Text) -> Maybe Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
T.stripPrefix Text
"(" Text
txt
  let (Text
inner, Text
rest) = (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')') Text
r1
      rest' :: Text
rest' = Text -> Text
T.strip Text
rest
      msg :: Text
msg =
        [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"Expected closing ')', received: '",
            Text
rest',
            Text
"'"
          ]
  Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless (Text
rest' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
")") ([Char] -> m ()
forall a. [Char] -> m a
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
unpackText Text
msg)
  pure Text
inner

parseTuple2 :: (MonadFail m) => Text -> m (Text, Text)
parseTuple2 :: forall (m :: Type -> Type). MonadFail m => Text -> m (Text, Text)
parseTuple2 Text
txt = do
  Text
r1 <- Text -> m Text
forall (m :: Type -> Type). MonadFail m => Text -> m Text
parseTuple Text
txt
  case (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',') Text
r1 of
    [] -> [Char] -> m (Text, Text)
forall a. [Char] -> m a
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail [Char]
"Expected 2-tuple, found 0 elements"
    [Text
_] -> [Char] -> m (Text, Text)
forall a. [Char] -> m a
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail ([Char] -> m (Text, Text)) -> [Char] -> m (Text, Text)
forall a b. (a -> b) -> a -> b
$ [Char]
"Expected 2-tuple, found 1 element: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
unpackText Text
txt
    [Text
l, Text
r] -> (Text, Text) -> m (Text, Text)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Text -> Text
T.strip Text
l, Text -> Text
T.strip Text
r)
    [Text]
_ -> [Char] -> m (Text, Text)
forall a. [Char] -> m a
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail ([Char] -> m (Text, Text)) -> [Char] -> m (Text, Text)
forall a b. (a -> b) -> a -> b
$ [Char]
"Expected 2-tuple, found > 2 elements: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
unpackText Text
txt

parseTuple3 :: (MonadFail m) => Text -> m (Text, Text, Text)
parseTuple3 :: forall (m :: Type -> Type).
MonadFail m =>
Text -> m (Text, Text, Text)
parseTuple3 Text
txt = do
  Text
r1 <- Text -> m Text
forall (m :: Type -> Type). MonadFail m => Text -> m Text
parseTuple Text
txt
  case (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',') Text
r1 of
    [] -> [Char] -> m (Text, Text, Text)
forall a. [Char] -> m a
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail [Char]
"Expected 3-tuple, found 0 elements"
    [Text
_] -> [Char] -> m (Text, Text, Text)
forall a. [Char] -> m a
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail ([Char] -> m (Text, Text, Text)) -> [Char] -> m (Text, Text, Text)
forall a b. (a -> b) -> a -> b
$ [Char]
"Expected 3-tuple, found 1 element: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
unpackText Text
txt
    [Text
_, Text
_] -> [Char] -> m (Text, Text, Text)
forall a. [Char] -> m a
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail ([Char] -> m (Text, Text, Text)) -> [Char] -> m (Text, Text, Text)
forall a b. (a -> b) -> a -> b
$ [Char]
"Expected 3-tuple, found 2 elements: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
unpackText Text
txt
    [Text
x1, Text
x2, Text
x3] -> (Text, Text, Text) -> m (Text, Text, Text)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Text -> Text
T.strip Text
x1, Text -> Text
T.strip Text
x2, Text -> Text
T.strip Text
x3)
    [Text]
_ -> [Char] -> m (Text, Text, Text)
forall a. [Char] -> m a
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail ([Char] -> m (Text, Text, Text)) -> [Char] -> m (Text, Text, Text)
forall a b. (a -> b) -> a -> b
$ [Char]
"Expected 3-tuple, found > 3 elements: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
unpackText Text
txt

liftMonadFail :: (MonadFail m) => String -> Maybe a -> m a
liftMonadFail :: forall (m :: Type -> Type) a.
MonadFail m =>
[Char] -> Maybe a -> m a
liftMonadFail [Char]
_ (Just a
x) = a -> m a
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
x
liftMonadFail [Char]
msg Maybe a
Nothing = [Char] -> m a
forall a. [Char] -> m a
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail [Char]
msg

liftParse :: Text -> Text -> ResultDefault a -> Either EventError a
liftParse :: forall a. Text -> Text -> ResultDefault a -> Either EventError a
liftParse Text
name Text
msg (Err [Char]
err) =
  EventError -> Either EventError a
forall a b. a -> Either a b
Left
    (EventError -> Either EventError a)
-> EventError -> Either EventError a
forall a b. (a -> b) -> a -> b
$ MkEventError
      { Text
name :: Text
name :: Text
name,
        short :: Text
short = Text
msg,
        long :: Text
long = [Char] -> Text
packText [Char]
err
      }
liftParse Text
_ Text
_ (Ok a
x) = a -> Either EventError a
forall a b. b -> Either a b
Right a
x