{-# LANGUAGE ExistentialQuantification #-}

-- |
-- Module      : Common.Parsing.Core
-- License     : BSD3
-- Maintainer  : tbidne@gmail.com
-- Provides functions for parsing `String` arguments.
module Common.Parsing.Core
  ( AnyParser (..),
    Parser (..),
    parseAll,
    module Common.Parsing.ParseAnd,
    module Common.Parsing.ParseOr,
  )
where

import Common.Parsing.ParseAnd
import Common.Parsing.ParseOr
import Common.Utils

-- | Wraps functions that:
--
--   1. Attempts to parse a String into an @a@.
--   2. Updates @acc@ with @a@.
--
--   That is,
--
-- @
--   parseFn :: 'String' -> 'Maybe' a
--   updateFn :: acc -> a -> acc
-- @
data Parser a acc
  = -- | Parses an exact argument e.g. "-flag".
    ExactParser (String -> Maybe a, acc -> a -> acc)
  | -- | Includes a prefix for parsing e.g. "--arg=val".
    PrefixParser (String, String -> Maybe a, acc -> a -> acc)

-- | Existentially quantifies the @a@ in 'Parser' @a@ @acc@. This way we
-- can accept a heterogenous ['AnyParser' @acc@] so we can try different
-- parsers at once.
data AnyParser acc = forall a. AnyParser (Parser a acc)

-- | Entrypoint for parsing arguments ['String'] into @acc@. We impose a
-- monoid requirement on the accumulator to take advantage of laziness.
-- Returns
--
-- @
--    - 'Left' ('Err' 'String'): /some/ 'String' could not be parsed by /any/ parser.
--    - 'Left' 'Help': "--help" was found
--    - 'Right' @acc@: /every/ 'String' was parsed successfully by /some/ parser.
-- @
--
-- In symbols, let /P/ = ['AnyParser' @acc@], /S/ = ['String'] and define
--   \[
--     p(s) = \begin{cases}
--       1, &p\text{ parsed } s \text{ successfully.} \\
--       0, &\mathrm{otherwise}
--     \end{cases}
--   \]
-- Then,
--   \[
--      \mathrm{parseAll}(P, S) = \text{Right acc} \iff \forall s \in S, \exists p \in P \text{ such that } p(s) = 1
--   \]
parseAll :: Monoid acc => [AnyParser acc] -> [String] -> ParseAnd acc
parseAll :: [AnyParser acc] -> [String] -> ParseAnd acc
parseAll parsers :: [AnyParser acc]
parsers = (String -> ParseAnd acc) -> [String] -> ParseAnd acc
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap String -> ParseAnd acc
f
  where
    f :: String -> ParseAnd acc
f arg :: String
arg = ParseOr acc -> ParseAnd acc
forall acc. ParseOr acc -> ParseAnd acc
parseOrToAnd (ParseOr acc -> ParseAnd acc) -> ParseOr acc -> ParseAnd acc
forall a b. (a -> b) -> a -> b
$ [AnyParser acc] -> String -> ParseOr acc
forall acc. Monoid acc => [AnyParser acc] -> String -> ParseOr acc
tryParsers [AnyParser acc]
parsers String
arg

tryParsers :: Monoid acc => [AnyParser acc] -> String -> ParseOr acc
tryParsers :: [AnyParser acc] -> String -> ParseOr acc
tryParsers _ "-h" = ParseStatus acc -> ParseOr acc
forall acc. ParseStatus acc -> ParseOr acc
ParseOr (ParseStatus acc -> ParseOr acc) -> ParseStatus acc -> ParseOr acc
forall a b. (a -> b) -> a -> b
$ ParseErr -> ParseStatus acc
forall acc. ParseErr -> ParseStatus acc
PFailure (ParseErr -> ParseStatus acc) -> ParseErr -> ParseStatus acc
forall a b. (a -> b) -> a -> b
$ String -> ParseErr
Help ""
tryParsers _ "--help" = ParseStatus acc -> ParseOr acc
forall acc. ParseStatus acc -> ParseOr acc
ParseOr (ParseStatus acc -> ParseOr acc) -> ParseStatus acc -> ParseOr acc
forall a b. (a -> b) -> a -> b
$ ParseErr -> ParseStatus acc
forall acc. ParseErr -> ParseStatus acc
PFailure (ParseErr -> ParseStatus acc) -> ParseErr -> ParseStatus acc
forall a b. (a -> b) -> a -> b
$ String -> ParseErr
Help ""
tryParsers parsers :: [AnyParser acc]
parsers arg :: String
arg = (AnyParser acc -> ParseOr acc) -> [AnyParser acc] -> ParseOr acc
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap AnyParser acc -> ParseOr acc
forall acc. Monoid acc => AnyParser acc -> ParseOr acc
f [AnyParser acc]
parsers
  where
    f :: AnyParser acc -> ParseOr acc
f (AnyParser p :: Parser a acc
p) = Parser a acc -> String -> ParseOr acc
forall acc a. Monoid acc => Parser a acc -> String -> ParseOr acc
tryParser Parser a acc
p String
arg

tryParser :: Monoid acc => Parser a acc -> String -> ParseOr acc
tryParser :: Parser a acc -> String -> ParseOr acc
tryParser (ExactParser (parseFn :: String -> Maybe a
parseFn, updateFn :: acc -> a -> acc
updateFn)) arg :: String
arg =
  (String -> Maybe a) -> (acc -> a -> acc) -> String -> ParseOr acc
forall acc a.
Monoid acc =>
(String -> Maybe a) -> (acc -> a -> acc) -> String -> ParseOr acc
parseAndUpdate String -> Maybe a
parseFn acc -> a -> acc
updateFn String
arg
tryParser (PrefixParser (prefix :: String
prefix, parseFn :: String -> Maybe a
parseFn, updateFn :: acc -> a -> acc
updateFn)) arg :: String
arg =
  case String
arg String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
`startsWith` String
prefix of
    Just rest :: String
rest -> (String -> Maybe a) -> (acc -> a -> acc) -> String -> ParseOr acc
forall acc a.
Monoid acc =>
(String -> Maybe a) -> (acc -> a -> acc) -> String -> ParseOr acc
parseAndUpdate String -> Maybe a
parseFn acc -> a -> acc
updateFn String
rest
    Nothing -> ParseStatus acc -> ParseOr acc
forall acc. ParseStatus acc -> ParseOr acc
ParseOr (ParseStatus acc -> ParseOr acc) -> ParseStatus acc -> ParseOr acc
forall a b. (a -> b) -> a -> b
$ ParseErr -> ParseStatus acc
forall acc. ParseErr -> ParseStatus acc
PFailure (ParseErr -> ParseStatus acc) -> ParseErr -> ParseStatus acc
forall a b. (a -> b) -> a -> b
$ String -> ParseErr
Err String
arg

parseAndUpdate ::
  Monoid acc =>
  (String -> Maybe a) ->
  (acc -> a -> acc) ->
  String ->
  ParseOr acc
parseAndUpdate :: (String -> Maybe a) -> (acc -> a -> acc) -> String -> ParseOr acc
parseAndUpdate parseFn :: String -> Maybe a
parseFn updateFn :: acc -> a -> acc
updateFn arg :: String
arg =
  case String -> Maybe a
parseFn String
arg of
    Just parsed :: a
parsed -> ParseStatus acc -> ParseOr acc
forall acc. ParseStatus acc -> ParseOr acc
ParseOr (ParseStatus acc -> ParseOr acc) -> ParseStatus acc -> ParseOr acc
forall a b. (a -> b) -> a -> b
$ acc -> ParseStatus acc
forall acc. acc -> ParseStatus acc
PSuccess (acc -> ParseStatus acc) -> acc -> ParseStatus acc
forall a b. (a -> b) -> a -> b
$ acc -> a -> acc
updateFn acc
forall a. Monoid a => a
mempty a
parsed
    Nothing -> ParseStatus acc -> ParseOr acc
forall acc. ParseStatus acc -> ParseOr acc
ParseOr (ParseStatus acc -> ParseOr acc) -> ParseStatus acc -> ParseOr acc
forall a b. (a -> b) -> a -> b
$ ParseErr -> ParseStatus acc
forall acc. ParseErr -> ParseStatus acc
PFailure (ParseErr -> ParseStatus acc) -> ParseErr -> ParseStatus acc
forall a b. (a -> b) -> a -> b
$ String -> ParseErr
Err String
arg

parseOrToAnd :: ParseOr acc -> ParseAnd acc
parseOrToAnd :: ParseOr acc -> ParseAnd acc
parseOrToAnd (ParseOr x :: ParseStatus acc
x) = ParseStatus acc -> ParseAnd acc
forall acc. ParseStatus acc -> ParseAnd acc
ParseAnd ParseStatus acc
x