{-# LANGUAGE ExistentialQuantification,
             FlexibleInstances #-}

-- | This module contains the additional data types, instance definitions and functions to run parsers in an interleaved way.
--   If all the interleaved parsers recognise a single connected piece of the input text this incorporates the permutation parsers.
--   For some examples see the module "Text.ParserCombinators.UU.Demo.MergeAndPermute".

module Text.ParserCombinators.UU.Interleaved where
import Control.Applicative.Interleaved hiding (mkP)
import Text.ParserCombinators.UU.Core

mkP :: Gram (P st) a -> P st a
mkP :: Gram (P st) a -> P st a
mkP (Gram [Alt (P st) a]
ls Maybe a
le) = (P st a -> P st a -> P st a) -> P st a -> [P st a] -> P st a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ P st a
p P st a
pp -> P st a -> P st a
forall st a. P st a -> P st a
doNotInterpret P st a
p P st a -> P st a -> P st a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P st a
pp) (P st a -> (a -> P st a) -> Maybe a -> P st a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe P st a
forall (f :: * -> *) a. Alternative f => f a
empty a -> P st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
le) ((Alt (P st) a -> P st a) -> [Alt (P st) a] -> [P st a]
forall a b. (a -> b) -> [a] -> [b]
map Alt (P st) a -> P st a
forall st a. Alt (P st) a -> P st a
mkParserAlt [Alt (P st) a]
ls)
   where mkParserAlt :: Alt (P st) a -> P st a
mkParserAlt (P st (b -> a)
p   `Seq`  Gram (P st) b
pp  ) = P st (b -> a)
p P st (b -> a) -> P st b -> P st a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gram (P st) b -> P st b
forall st a. Gram (P st) a -> P st a
mkP Gram (P st) b
pp
         mkParserAlt (P st b
fc  `Bind` b -> Gram (P st) a
c2fa) = P st b
fc P st b -> (b -> P st a) -> P st a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=  (Gram (P st) a -> P st a
forall st a. Gram (P st) a -> P st a
mkP (Gram (P st) a -> P st a) -> (b -> Gram (P st) a) -> b -> P st a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Gram (P st) a
c2fa)

instance Splittable (P st) where
  getPure :: P st a -> Maybe a
getPure    = P st a -> Maybe a
forall st a. P st a -> Maybe a
getZeroP
  getNonPure :: P st a -> Maybe (P st a)
getNonPure = P st a -> Maybe (P st a)
forall st a. P st a -> Maybe (P st a)
getOneP

instance Functor f => ExtAlternative (Gram f) where
  Gram f a
p <<|> :: Gram f a -> Gram f a -> Gram f a
<<|> Gram f a
q                    = Gram f a
p Gram f a -> Gram f a -> Gram f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Gram f a
q
  Gram f a
p <?> :: Gram f a -> String -> Gram f a
<?> String
s                     = String -> Gram f a
forall a. HasCallStack => String -> a
error String
"No <?> defined for Grammars yet. If you need ask for it"
  must_be_non_empty :: String -> Gram f a -> c -> c
must_be_non_empty String
msg (Gram [Alt f a]
_ (Just a
_)) c
_
    = String -> c
forall a. HasCallStack => String -> a
error (String
"The combinator " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++  String
" requires that it's argument cannot recognise the empty string\n")
  must_be_non_empty String
_ Gram f a
_  c
q  = c
q
  must_be_non_empties :: String -> Gram f a -> Gram f b -> c -> c
must_be_non_empties  String
msg (Gram [Alt f a]
_ (Just a
_)) (Gram [Alt f b]
_ (Just b
_)) c
_ 
    = String -> c
forall a. HasCallStack => String -> a
error (String
"The combinator " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++  String
" requires that not both arguments can recognise the empty string\n")
  must_be_non_empties  String
msg Gram f a
_  Gram f b
_ c
q = c
q

-- | `doNotInterpret` forgets the computed minimal number of tokens recognised by this parser
--    which  makes a parser opaque for abstract interpretation; used when interleaving parsers
--    where we do not want to compare lengths.

doNotInterpret :: P st a -> P st a
doNotInterpret :: P st a -> P st a
doNotInterpret (P T st a
t Maybe (T st a)
nep Maybe a
e Nat
_) = T st a -> Maybe (T st a) -> Maybe a -> Nat -> P st a
forall st a. T st a -> Maybe (T st a) -> Maybe a -> Nat -> P st a
P T st a
t Maybe (T st a)
nep Maybe a
e Nat
Unspecified

instance  IsParser (Gram (P st))