module Text.HTML.Tagchup.Parser.Combinator (
   Parser.T, Full, Emitting, Fallible, Plain,
   char, voidChar, dropSpaces, getPos,
   many, many1, manyS, many1S, manyNull, many1Null, many0toN, many1toN,
   many1Satisfy, manySatisfy, readUntil,
   satisfy, string, voidString,
   emit, modifyEmission,
   eval, run, write, gets,
   withDefault, allowFail, allowEmit,
   Identity, runIdentity, )
  where


import qualified Text.XML.Basic.Position as Position
import qualified Text.HTML.Tagchup.Parser.Status as Status
import qualified Text.HTML.Tagchup.Parser.Stream as Stream

import qualified Text.HTML.Tagchup.Parser.Core as Parser
import Text.HTML.Tagchup.Parser.Core hiding (run, )

import Control.Monad.Trans.State (StateT(..), evalStateT, )
import Control.Monad (liftM, liftM2, guard, )

import Data.Monoid (Monoid)

import Data.Char (isSpace)



type Full     input w = Parser.T input [w] Maybe
type Fallible input   = Parser.T input ()  Maybe
type Emitting input w = Parser.T input [w] Identity
type Plain    input   = Parser.T input ()  Identity


write :: Monad fail =>
   FilePath -> Parser.T input output fail () -> input -> fail output
write :: forall (fail :: * -> *) input output.
Monad fail =>
FilePath -> T input output fail () -> input -> fail output
write FilePath
fileName T input output fail ()
p =
   forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\ ~(()
_,T input
_,output
ws) -> output
ws) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall (fail :: * -> *) input output a.
Monad fail =>
T input output fail a -> T input -> fail (a, T input, output)
Parser.run T input output fail ()
p forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall stream. T -> stream -> T stream
Status.Cons (FilePath -> T
Position.initialize FilePath
fileName)

run :: Monad fail =>
   FilePath -> Parser.T input output fail a -> input -> fail (a, output)
run :: forall (fail :: * -> *) input output a.
Monad fail =>
FilePath -> T input output fail a -> input -> fail (a, output)
run FilePath
fileName T input output fail a
p =
   forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\ ~(a
a,T input
_,output
ws) -> (a
a,output
ws)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall (fail :: * -> *) input output a.
Monad fail =>
T input output fail a -> T input -> fail (a, T input, output)
Parser.run T input output fail a
p forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall stream. T -> stream -> T stream
Status.Cons (FilePath -> T
Position.initialize FilePath
fileName)

eval ::  Monad fail =>
   FilePath -> StateT (Status.T input) fail a -> input -> fail a
eval :: forall (fail :: * -> *) input a.
Monad fail =>
FilePath -> StateT (T input) fail a -> input -> fail a
eval FilePath
fileName StateT (T input) fail a
p =
   forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT (T input) fail a
p forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall stream. T -> stream -> T stream
Status.Cons (FilePath -> T
Position.initialize FilePath
fileName)



getPos ::
   (Monoid output, Monad fail) =>
   Parser.T input output fail Position.T
getPos :: forall output (fail :: * -> *) input.
(Monoid output, Monad fail) =>
T input output fail T
getPos = forall output (fail :: * -> *) input a.
(Monoid output, Monad fail) =>
(T input -> a) -> T input output fail a
gets forall stream. T stream -> T
Status.sourcePos

satisfy ::
   (Monoid output, Stream.C input) =>
   (Char -> Bool) -> Parser.T input output Maybe Char
satisfy :: forall output input.
(Monoid output, C input) =>
(Char -> Bool) -> T input output Maybe Char
satisfy Char -> Bool
p =
   do Char
c <- forall output input.
(Monoid output, C input) =>
T input output Maybe Char
nextChar
      if Char -> Bool
p Char
c
        then forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
        else forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"character not matched"

-- | does never fail
many :: Monoid output =>
   Parser.T input output Maybe a -> Parser.T input output Identity [a]
many :: forall output input a.
Monoid output =>
T input output Maybe a -> T input output Identity [a]
many T input output Maybe a
x =
   {- It is better to have 'force' at the place it is,
      instead of writing it to the recursive call,
      because 'x' can cause an infinite loop. -}
   forall input output a.
T input output Maybe a
-> T input output Identity a -> T input output Identity a
withDefault (forall output input a.
Monoid output =>
T input output Maybe a -> T input output Maybe [a]
many1 T input output Maybe a
x) (forall (m :: * -> *) a. Monad m => a -> m a
return [])

-- | fails when trying the sub-parser the first time or never
many1 :: Monoid output =>
   Parser.T input output Maybe a -> Parser.T input output Maybe [a]
many1 :: forall output input a.
Monoid output =>
T input output Maybe a -> T input output Maybe [a]
many1 T input output Maybe a
x = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) T input output Maybe a
x (forall input output a.
T input output Identity a -> T input output Maybe a
allowFail forall a b. (a -> b) -> a -> b
$ forall output input a.
Monoid output =>
T input output Maybe a -> T input output Identity [a]
many T input output Maybe a
x)


-- | does never fail
manyS ::
   StateT s Maybe a -> StateT s Identity [a]
manyS :: forall s a. StateT s Maybe a -> StateT s Identity [a]
manyS StateT s Maybe a
x =
   forall s a.
StateT s Maybe a -> StateT s Identity a -> StateT s Identity a
withDefault' (forall s a. StateT s Maybe a -> StateT s Maybe [a]
many1S StateT s Maybe a
x) (forall (m :: * -> *) a. Monad m => a -> m a
return [])

-- | fails when trying the sub-parser the first time or never
many1S ::
   StateT s Maybe a -> StateT s Maybe [a]
many1S :: forall s a. StateT s Maybe a -> StateT s Maybe [a]
many1S StateT s Maybe a
x = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) StateT s Maybe a
x (forall s a. StateT s Identity a -> StateT s Maybe a
allowFail' forall a b. (a -> b) -> a -> b
$ forall s a. StateT s Maybe a -> StateT s Identity [a]
manyS StateT s Maybe a
x)


manyNull :: Monoid output =>
   Parser.T input output Maybe () -> Parser.T input output Identity ()
manyNull :: forall output input.
Monoid output =>
T input output Maybe () -> T input output Identity ()
manyNull T input output Maybe ()
x =
   forall input output a.
T input output Maybe a
-> T input output Identity a -> T input output Identity a
withDefault (forall output input.
Monoid output =>
T input output Maybe () -> T input output Maybe ()
many1Null T input output Maybe ()
x) (forall (m :: * -> *) a. Monad m => a -> m a
return ())

many1Null :: Monoid output =>
   Parser.T input output Maybe () -> Parser.T input output Maybe ()
many1Null :: forall output input.
Monoid output =>
T input output Maybe () -> T input output Maybe ()
many1Null T input output Maybe ()
x = T input output Maybe ()
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (forall input output a.
T input output Identity a -> T input output Maybe a
allowFail forall a b. (a -> b) -> a -> b
$ forall output input.
Monoid output =>
T input output Maybe () -> T input output Identity ()
manyNull T input output Maybe ()
x)


many0toN :: Monoid output =>
   Int -> Parser.T input output Maybe a -> Parser.T input output Identity [a]
many0toN :: forall output input a.
Monoid output =>
Int -> T input output Maybe a -> T input output Identity [a]
many0toN Int
n T input output Maybe a
x =
   forall input output a.
T input output Maybe a
-> T input output Identity a -> T input output Identity a
withDefault (forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
nforall a. Ord a => a -> a -> Bool
>Int
0) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall output input a.
Monoid output =>
Int -> T input output Maybe a -> T input output Maybe [a]
many1toN Int
n T input output Maybe a
x) (forall (m :: * -> *) a. Monad m => a -> m a
return [])

-- | condition: n>0, this will not be checked
many1toN :: Monoid output =>
   Int -> Parser.T input output Maybe a -> Parser.T input output Maybe [a]
many1toN :: forall output input a.
Monoid output =>
Int -> T input output Maybe a -> T input output Maybe [a]
many1toN Int
n T input output Maybe a
x = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) T input output Maybe a
x (forall input output a.
T input output Identity a -> T input output Maybe a
allowFail forall a b. (a -> b) -> a -> b
$ forall output input a.
Monoid output =>
Int -> T input output Maybe a -> T input output Identity [a]
many0toN (forall a. Enum a => a -> a
pred Int
n) T input output Maybe a
x)


manySatisfy ::
   (Monoid output, Stream.C input) =>
   (Char -> Bool) -> Parser.T input output Identity String
manySatisfy :: forall output input.
(Monoid output, C input) =>
(Char -> Bool) -> T input output Identity FilePath
manySatisfy =
   forall (fail :: * -> *) output input a.
(Monad fail, Monoid output) =>
T input () fail a -> T input output fail a
allowEmit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall output input a.
Monoid output =>
T input output Maybe a -> T input output Identity [a]
many forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall output input.
(Monoid output, C input) =>
(Char -> Bool) -> T input output Maybe Char
satisfy

many1Satisfy ::
   (Monoid output, Stream.C input) =>
   (Char -> Bool) -> Parser.T input output Maybe String
many1Satisfy :: forall output input.
(Monoid output, C input) =>
(Char -> Bool) -> T input output Maybe FilePath
many1Satisfy =
   forall (fail :: * -> *) output input a.
(Monad fail, Monoid output) =>
T input () fail a -> T input output fail a
allowEmit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall output input a.
Monoid output =>
T input output Maybe a -> T input output Maybe [a]
many1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall output input.
(Monoid output, C input) =>
(Char -> Bool) -> T input output Maybe Char
satisfy

dropSpaces ::
   (Monoid output, Stream.C input) =>
   Parser.T input output Identity ()
dropSpaces :: forall output input.
(Monoid output, C input) =>
T input output Identity ()
dropSpaces =
   forall output input.
(Monoid output, C input) =>
(Char -> Bool) -> T input output Identity FilePath
manySatisfy Char -> Bool
isSpace forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()


char ::
   (Monoid output, Stream.C input) =>
   Char -> Parser.T input output Maybe Char
char :: forall output input.
(Monoid output, C input) =>
Char -> T input output Maybe Char
char Char
c = forall output input.
(Monoid output, C input) =>
(Char -> Bool) -> T input output Maybe Char
satisfy (Char
cforall a. Eq a => a -> a -> Bool
==)

string ::
   (Monoid output, Stream.C input) =>
   String -> Parser.T input output Maybe String
string :: forall output input.
(Monoid output, C input) =>
FilePath -> T input output Maybe FilePath
string = forall (fail :: * -> *) output input a.
(Monad fail, Monoid output) =>
T input () fail a -> T input output fail a
allowEmit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall output input.
(Monoid output, C input) =>
Char -> T input output Maybe Char
char


voidChar ::
   (Monoid output, Stream.C input) =>
   Char -> Parser.T input output Maybe ()
voidChar :: forall output input.
(Monoid output, C input) =>
Char -> T input output Maybe ()
voidChar Char
c = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const ()) forall a b. (a -> b) -> a -> b
$ forall output input.
(Monoid output, C input) =>
Char -> T input output Maybe Char
char Char
c

voidString ::
   (Monoid output, Stream.C input) =>
   String -> Parser.T input output Maybe ()
voidString :: forall output input.
(Monoid output, C input) =>
FilePath -> T input output Maybe ()
voidString = forall (fail :: * -> *) output input a.
(Monad fail, Monoid output) =>
T input () fail a -> T input output fail a
allowEmit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall output input.
(Monoid output, C input) =>
Char -> T input output Maybe ()
voidChar


readUntil ::
   (Monoid output, Stream.C input) =>
   String -> Parser.T input output Identity (Bool,String)
readUntil :: forall output input.
(Monoid output, C input) =>
FilePath -> T input output Identity (Bool, FilePath)
readUntil FilePath
pattern =
   let recourse :: T input () Identity (Bool, FilePath)
recourse =
          forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall input output a.
T input output Maybe a
-> T input output Identity a -> T input output Identity a
withDefault (forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False,[])) forall a b. (a -> b) -> a -> b
$
          forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a b. a -> b -> a
const (Bool
True,[])) (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall output input.
(Monoid output, C input) =>
Char -> T input output Maybe Char
char FilePath
pattern) forall a. a -> [a] -> [a]
:
          (do Char
c <- forall output input.
(Monoid output, C input) =>
T input output Maybe Char
nextChar
              ~(Bool
found,FilePath
str) <- forall input output a.
T input output Identity a -> T input output Maybe a
allowFail T input () Identity (Bool, FilePath)
recourse
              forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
found,Char
cforall a. a -> [a] -> [a]
:FilePath
str)) forall a. a -> [a] -> [a]
:
          []
   in  forall (fail :: * -> *) output input a.
(Monad fail, Monoid output) =>
T input () fail a -> T input output fail a
allowEmit T input () Identity (Bool, FilePath)
recourse
{-
runStateT (readUntil "-->") (Position.initialize "input", "<!-- comment --> other stuff")
-}



emit :: Monad fail =>
   w -> Parser.T input [w] fail ()
emit :: forall (fail :: * -> *) w input.
Monad fail =>
w -> T input [w] fail ()
emit w
w = forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell [w
w]

modifyEmission ::
   (Monad fail, Monoid output) =>
   (output -> output) -> Parser.T input output fail a -> Parser.T input output fail a
modifyEmission :: forall (fail :: * -> *) output input a.
(Monad fail, Monoid output) =>
(output -> output)
-> T input output fail a -> T input output fail a
modifyEmission output -> output
f = forall (m :: * -> *) w a.
Monad m =>
(w -> w) -> WriterT w m a -> WriterT w m a
censor output -> output
f