-- |
-- Module      : Common.Parsing.ParseOr
-- License     : BSD3
-- Maintainer  : tbidne@gmail.com
-- Provides the 'ParseOr' monoid.
module Common.Parsing.ParseOr
  ( ParseOr (..),
    module Common.Parsing.ParseStatus,
  )
where

import Common.Parsing.ParseStatus

-- | 'ParseOr' Induces an \"Or\" monoidal structure on 'ParseStatus'. That is,
--
-- @
--   ('PFailure' p1) <> ... <> ('PFailure' pn) = 'PFailure' (p1 <> ... <> pn)
--   ('PFailure' p1) <> ... <> ('PFailure' pj) <> ('PSuccess' pk) ... = 'PSuccess' pk
-- @
--
-- The algebra for 'ParseOr' satisfies
--
-- @
--   1. Identity: 'ParseOr' ('PFailure' ('Err' ""))
--   2. 'PSuccess' is an ideal: 'PSuccess' x <> 'PFailure' y == 'PSuccess' x == 'PFailure' y <> 'PSuccess' x
--   3. Left-biased: l <> r == l, when it doesn't violate 1 or 2.
-- @
--
-- Strictly speaking property 2 is stronger than saying 'PSuccess' is an ideal.
-- More precisely, the action by 'PFailure' on 'PSuccess' in 'ParseOr' is trivial.
newtype ParseOr acc = ParseOr (ParseStatus acc)
  deriving (ParseOr acc -> ParseOr acc -> Bool
(ParseOr acc -> ParseOr acc -> Bool)
-> (ParseOr acc -> ParseOr acc -> Bool) -> Eq (ParseOr acc)
forall acc. Eq acc => ParseOr acc -> ParseOr acc -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseOr acc -> ParseOr acc -> Bool
$c/= :: forall acc. Eq acc => ParseOr acc -> ParseOr acc -> Bool
== :: ParseOr acc -> ParseOr acc -> Bool
$c== :: forall acc. Eq acc => ParseOr acc -> ParseOr acc -> Bool
Eq, Int -> ParseOr acc -> ShowS
[ParseOr acc] -> ShowS
ParseOr acc -> String
(Int -> ParseOr acc -> ShowS)
-> (ParseOr acc -> String)
-> ([ParseOr acc] -> ShowS)
-> Show (ParseOr acc)
forall acc. Show acc => Int -> ParseOr acc -> ShowS
forall acc. Show acc => [ParseOr acc] -> ShowS
forall acc. Show acc => ParseOr acc -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseOr acc] -> ShowS
$cshowList :: forall acc. Show acc => [ParseOr acc] -> ShowS
show :: ParseOr acc -> String
$cshow :: forall acc. Show acc => ParseOr acc -> String
showsPrec :: Int -> ParseOr acc -> ShowS
$cshowsPrec :: forall acc. Show acc => Int -> ParseOr acc -> ShowS
Show)

instance Semigroup (ParseOr acc) where
  (ParseOr (PFailure l :: ParseErr
l)) <> :: ParseOr acc -> ParseOr acc -> ParseOr acc
<> (ParseOr (PFailure r :: ParseErr
r)) =
    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
$ ParseErr
l ParseErr -> ParseErr -> ParseErr
forall a. Semigroup a => a -> a -> a
<> ParseErr
r
  (ParseOr (PFailure _)) <> r :: ParseOr acc
r = ParseOr acc
r
  l :: ParseOr acc
l <> _ = ParseOr acc
l

instance Monoid (ParseOr acc) where
  mempty :: ParseOr acc
mempty = 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 ""