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

import Common.Parsing.ParseStatus

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

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

instance Monoid acc => Monoid (ParseAnd acc) where
  mempty :: ParseAnd acc
mempty = ParseStatus acc -> ParseAnd acc
forall acc. ParseStatus acc -> ParseAnd acc
ParseAnd (acc -> ParseStatus acc
forall acc. acc -> ParseStatus acc
PSuccess acc
forall a. Monoid a => a
mempty)