{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}


-- | This will eventually be a beautiful interface between NLP and scrappy

module Scrappy.Elem.ITextElemParser where


import Scrappy.Elem.TreeElemParser (treeElemParser, sameTreeH)
import Scrappy.Elem.SimpleElemParser (elemParser)
import Scrappy.Elem.ElemHeadParse (parseOpeningTag, buildElemsOpts, attrsParser
                          , mkElemtagParser)
import Scrappy.Elem.Types (HTMLMatcher(..), Elem'(..), Elem, Attrs, ShowHTML(..)
                  , TreeHTML(..), endTag
                  , selfClosingTextful, noPat, innerText', _innerTree'
                  , attrs, elTag, coerceAttrs
                  )


import Text.Parsec (parse, ParsecT, Stream, string, (<|>), anyChar, char
                   , optional, try, manyTill, many, runParserT, ParseError
                   , parserZero, alphaNum, oneOf
                   , digit
                   , option
                   , letter
                   , space
                   )
import Control.Monad
import Control.Applicative (some)
import Control.Applicative.Combinators (some, eitherP)
import Data.Either (fromRight, isRight)
import Data.List (intercalate, intersperse)

-- testing writersAbstract
import Scrappy.Find 
import Scrappy.Elem.ChainHTML



-- | comment is to crash nix as reminder to move somewhere sensible
-- data OpenStruct a = OpenStruct (Parser a)
-- type CloseStruct a = OpenStruct a -> ClosePiece a
  -- could be even \_ -> f , when the Close struct is independent of Open and I dont think this
  -- would affect speed
-- data ClosePiece a = ClosePiece (Parser a)  

-- | paired with maybeUsefulNewUrls this would allow us to scrape an entire
-- | site for a singular pattern
-- | and just by virtue of basic haskell types, there's zero reason we cant
-- | have some simple type:
-- | data Scrapeable = Case1 A | Case2 B ... 
-- fanExistential :: Url -> (Url -> Bool) -> MaybeT m a -> MaybeT m [a]
-- fanExistential url = do
--   html <- getHtmlST sv url 
--   links <- flip successesM html $ hoistMaybe $ scrape (hrefParser' cond)
--   fanExistential links

  -- but actually this would fail due to circularity ; the site is a graph of links

-- writersAbstractSimple = do
--   abstract
--   (_, g) <- manyTill_ anyChar $ paragElemGroup
  


-- paragElemGroup but instead use treeElemParser and ensure that
-- tree == mempty and that you try to match for a proper paragraph


emptyTree :: (ShowHTML a, Stream s m Char) =>
             Maybe [Elem]
          -> Maybe (ParsecT s u m a)
          -> [(String, Maybe String)]
          -> ParsecT s u m (TreeHTML a)
emptyTree :: forall a s (m :: * -> *) u.
(ShowHTML a, Stream s m Char) =>
Maybe [String]
-> Maybe (ParsecT s u m a)
-> [(String, Maybe String)]
-> ParsecT s u m (TreeHTML a)
emptyTree Maybe [String]
elemOpts Maybe (ParsecT s u m a)
match [(String, Maybe String)]
attrs = do
  TreeHTML a
e <- Maybe [String]
-> Maybe (ParsecT s u m a)
-> [(String, Maybe String)]
-> ParsecT s u m (TreeHTML a)
forall s (m :: * -> *) a u.
(Stream s m Char, ShowHTML a) =>
Maybe [String]
-> Maybe (ParsecT s u m a)
-> [(String, Maybe String)]
-> ParsecT s u m (TreeHTML a)
treeElemParser Maybe [String]
elemOpts Maybe (ParsecT s u m a)
match [(String, Maybe String)]
attrs 
  Bool -> ParsecT s u m () -> ParsecT s u m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Tree ElemHead] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Tree ElemHead] -> Bool) -> [Tree ElemHead] -> Bool
forall a b. (a -> b) -> a -> b
$ TreeHTML a -> [Tree ElemHead]
forall a. TreeHTML a -> [Tree ElemHead]
_innerTree' TreeHTML a
e) (ParsecT s u m () -> ParsecT s u m ())
-> ParsecT s u m () -> ParsecT s u m ()
forall a b. (a -> b) -> a -> b
$ ParsecT s u m ()
forall s u (m :: * -> *) a. ParsecT s u m a
parserZero
  TreeHTML a -> ParsecT s u m (TreeHTML a)
forall a. a -> ParsecT s u m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TreeHTML a
e


preface :: Stream s m Char =>
           ParsecT s u m pre
        -> ParsecT s u m a
        -> ParsecT s u m a
preface :: forall s (m :: * -> *) u pre a.
Stream s m Char =>
ParsecT s u m pre -> ParsecT s u m a -> ParsecT s u m a
preface ParsecT s u m pre
pre ParsecT s u m a
p = ParsecT s u m a
p ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (((String, a) -> a) -> ParsecT s u m (String, a) -> ParsecT s u m a
forall a b. (a -> b) -> ParsecT s u m a -> ParsecT s u m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, a) -> a
forall a b. (a, b) -> b
snd (ParsecT s u m (String, a) -> ParsecT s u m a)
-> ParsecT s u m (String, a) -> ParsecT s u m a
forall a b. (a -> b) -> a -> b
$ ParsecT s u m Char -> ParsecT s u m a -> ParsecT s u m (String, a)
forall s u (m :: * -> *) a end.
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m ([a], end)
manyTill_ ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT s u m a
p)


-- | Returns a minimum of 2 --> almost like `same` should be function ; same :: a -> [a] to be applied to some doc/String
-- | note: not sure if this exists but here's where we could handle iterating names of attributes 
-- | Can generalize to ElementRep e

-- instance Show a => ShowHTML Parag where
--   showH = show


class Zero a where
  consumeZero :: a -> b -> b 
  -- functions which will always work with a null value

class Singleton a where
  consumeSingleton :: a -> b
  -- functions which will always work with a singular value
  -- most functions in haskell would support this

class Multiple a where
  consumeMultiple :: a -> b 
  -- functions which are guranteed to work on 2 or more but not
  -- necessarily less

class (Zero a, Singleton a, Multiple a) => Existential a where
  consumeExists :: a -> b
  -- functions that will always work for any case of existentiality 

-- | Only matches if no innerTrees
-- | This doesn't behave exactly like a "group" function
-- | because it allows matching on one element
-- | but this will also never be empty 
emptyTreeGroup :: (ShowHTML a, Stream s m Char) =>
                  Maybe [Elem]
               -> Maybe (ParsecT s u m a)
               -> [(String, Maybe String)]
               -> ParsecT s u m [TreeHTML a]
emptyTreeGroup :: forall a s (m :: * -> *) u.
(ShowHTML a, Stream s m Char) =>
Maybe [String]
-> Maybe (ParsecT s u m a)
-> [(String, Maybe String)]
-> ParsecT s u m [TreeHTML a]
emptyTreeGroup Maybe [String]
elemOpts Maybe (ParsecT s u m a)
match [(String, Maybe String)]
attrsSubset = do
  TreeHTML a
e <- Maybe [String]
-> Maybe (ParsecT s u m a)
-> [(String, Maybe String)]
-> ParsecT s u m (TreeHTML a)
forall a s (m :: * -> *) u.
(ShowHTML a, Stream s m Char) =>
Maybe [String]
-> Maybe (ParsecT s u m a)
-> [(String, Maybe String)]
-> ParsecT s u m (TreeHTML a)
emptyTree Maybe [String]
elemOpts Maybe (ParsecT s u m a)
match [(String, Maybe String)]
attrsSubset
  let
    same :: ParsecT s u m (TreeHTML a)
same = Maybe [String]
-> Maybe (ParsecT s u m a)
-> [(String, Maybe String)]
-> ParsecT s u m (TreeHTML a)
forall a s (m :: * -> *) u.
(ShowHTML a, Stream s m Char) =>
Maybe [String]
-> Maybe (ParsecT s u m a)
-> [(String, Maybe String)]
-> ParsecT s u m (TreeHTML a)
emptyTree ([String] -> Maybe [String]
forall a. a -> Maybe a
Just [TreeHTML a -> String
forall b. TreeHTML b -> String
forall (a :: * -> *) b. ElementRep a => a b -> String
elTag TreeHTML a
e]) Maybe (ParsecT s u m a)
match (Attrs -> [(String, Maybe String)]
coerceAttrs (Attrs -> [(String, Maybe String)])
-> Attrs -> [(String, Maybe String)]
forall a b. (a -> b) -> a -> b
$ TreeHTML a -> Attrs
forall b. TreeHTML b -> Attrs
forall (a :: * -> *) b. ElementRep a => a b -> Attrs
attrs TreeHTML a
e)
  (:) (TreeHTML a -> [TreeHTML a] -> [TreeHTML a])
-> ParsecT s u m (TreeHTML a)
-> ParsecT s u m ([TreeHTML a] -> [TreeHTML a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TreeHTML a -> ParsecT s u m (TreeHTML a)
forall a. a -> ParsecT s u m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TreeHTML a
e ParsecT s u m ([TreeHTML a] -> [TreeHTML a])
-> ParsecT s u m [TreeHTML a] -> ParsecT s u m [TreeHTML a]
forall a b.
ParsecT s u m (a -> b) -> ParsecT s u m a -> ParsecT s u m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParsecT s u m (TreeHTML a) -> ParsecT s u m [TreeHTML a]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT s u m (TreeHTML a) -> ParsecT s u m [TreeHTML a])
-> ParsecT s u m (TreeHTML a) -> ParsecT s u m [TreeHTML a]
forall a b. (a -> b) -> a -> b
$ ParsecT s u m (TreeHTML a)
same ParsecT s u m (TreeHTML a)
-> ParsecT s u m () -> ParsecT s u m (TreeHTML a)
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT s u m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
nl)
  


-- emptyTreeGroup  :: (Stream s m Char)
--                 => Maybe [Elem]
--                 -> Maybe (ParsecT s u m a)
--                 -> [(String, Maybe String)]
--                 -> ParsecT s u m [a]
-- emptyTreeGroup elemOpts match attrsSubset = do
--   treeH <- treeElemParser elemOpts match attrsSubset
--   when (not $ null $ _innerTree' treeH) $ parserZero
  
--   let
--     sameTreeHMatches tree = do
--       t <- sameTreeH (Just paragraph) tree 
--       when (not $ null $ _innerTree' t) $ parserZero
--       pure $ _matches' t
--   many_treeHMatches <- some $ try $ sameTreeHMatches treeH
--   pure $ mconcat $ (_matches' treeH) : many_treeHMatches
  
-- >>= (\treeH -> fmap (treeH :) (some (try $ sameTreeH matchh treeH))))

-- fmap (_matches) list :: mconcat $ [match] : [[match]] 


-- myEl :: Stream s m Char => ParsecT s u m (TreeHTML Paragraph)
-- myEl = emptyTree Nothing (Just paragraph) [] 


-- abstractPattern >> skipManyTIll $ htmlGroupEmptyTree `eachContain` paragraph 


-- paragElemGroup = do
--   let
--     e1 =  do
--       e <- elemParser Nothing (Just paragraph) []
--       if exists anyEndTag $ innerText' e then parserZero else return e
--     innerTextIfNoEndTags e =
--       if exists anyEndTag $ innerText' e then parserZero else return e 
--     eN = many $ fmap innerTextIfNoEndTags
--          $ elemParser (Just . (:[]) . elem $ e1) (Just paragraph) []
--   (:) <$> (innerText' <$> e1) <*> eN 



-- writersAbstract :: Stream s m Char =>
--                    ParsecT s u m (Maybe [Either String Paragraph]) 
-- writersAbstract = do
--   elemParser Nothing (Just $ abstractWord) [] `contains`
--     findNaive (some $ elemAny paragraphOrAbstractWord)

elemAny :: Stream s m Char => ParsecT s u m (Elem' String) 
elemAny :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m (Elem' String)
elemAny = Maybe [String]
-> Maybe (ParsecT s u m String)
-> [(String, Maybe String)]
-> ParsecT s u m (Elem' String)
forall a s (m :: * -> *) u.
(ShowHTML a, Stream s m Char) =>
Maybe [String]
-> Maybe (ParsecT s u m a)
-> [(String, Maybe String)]
-> ParsecT s u m (Elem' a)
elemParser Maybe [String]
forall a. Maybe a
Nothing Maybe (ParsecT s u m String)
forall s u (m :: * -> *). Maybe (ParsecT s u m String)
noPat [] 

-- Start Pattern
-- pattern
-- notPattern / falsePattern


--     I might have a function in chainHTML that allows this

-- somePrevPat >> dropManyTill startPattern >> findFirst pattern

-- which I think is reasonably safe given our pattern should be:

--       some' $ elAny `contains` paragraph
--       where
--            some' = all tags determined by first tag if 'p' then might
--                    be 6 'p' tags in a row 

--   so we can have multiple but it must be same tag

-- and I could still use contain just not findNaive 
              

              
-- abstractWord :: Stream s m Char => ParsecT s u m String
-- abstractWord = string "Abstract" <|> string "abstract" <|> string "Nonlinear"

-- paragraphOrAbstractWord :: Stream s m Char => ParsecT s u m (Either String Paragraph)
-- paragraphOrAbstractWord = Left <$> abstractWord <|> Right <$> paragraph


-- revalation:
--   scrape x --> [entry1, entry2, entry3 ..]    so every item found is in order meaning we could add patterns that influence the consumption of this

-- for example:
--   lets say we want to scrape an abstract ~~~ so thus we want to scrape a body of text titled abstract
--   design principles make it fairly predictable that such will look like:

-- Abstract
-- blah blahblahblabla

-- so:
--   if p in scrape p html is == (Abstract <$> abstractPattern <|> Paragraph p) -- abstractPattern = string "abstract"

-- then we get something like:

--     [Paragraph txt, Paragraph txt2, Abstract "abstract", Paragraph txt3]

-- then reasonably we can infer that txt3 is a valid writers abstract Paragraph but since the first 2 would be rendered above, these 2 are not

-- further this could be a general pattern

-- scrapeWithSeparatingPattern :: ParsecT s u m a -> ParsecT s u m sep -> Maybe (Seperated sep a)
-- scrapeWithSeparatingPattern = undefined

-- type Seperated e a = [Either e a] 





-- i need to test if this module would work for extracting text out of research papers even though they are pdfs

--- ***** if we read a research paper backwards we can be waaaaaaay more confident about name and author, may even mix the
-- two up a lot at least its there and discernable to the user even maybe a dumb user, because names are very `discrete` in a sense

--       ---> might even make parsing citations easier

-- I need to do some investigation on the feasibility of reading papers with my parsers by determining if PDFs can just be converted from UTF8 char sequences
-- and read by scraping

-- this could also be an interface ; scrape :: Scrapeable t => ScraperT t a -> t -> Maybe [a] 


-- justPlaintext :: Int -> ParsecT s u m [String]
-- justPlaintext atLeast = 
--   fmap (filter (\x -> length x > atLeast)) {--} (find $ many (letter <|> number <|> char ' ' <|> char '.'))

-- just for testing 
type ResearchResult = String 

-- type Paragraph = [[String]]
-- | TODO(galen): these should build off each other
data Paragraph = Paragraph { Paragraph -> [Sentence]
unParagraph :: [Sentence] } 

data Sentence = Sentence { Sentence -> [WrittenWord]
unSentence :: [WrittenWord] }

data WrittenWord = WW { WrittenWord -> String
unWord :: String }

instance Show Paragraph where
  show :: Paragraph -> String
show (Paragraph [Sentence]
sentences) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Sentence -> String
forall a. Show a => a -> String
show (Sentence -> String) -> [Sentence] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Sentence]
sentences

instance Show Sentence where
  show :: Sentence -> String
show (Sentence [WrittenWord]
words) = (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ WrittenWord -> String
forall a. Show a => a -> String
show (WrittenWord -> String) -> [WrittenWord] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [WrittenWord]
words) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"."

instance Show WrittenWord where
  show :: WrittenWord -> String
show (WW String
s) = String
s

  

instance Semigroup WrittenWord where
  (WW String
w1) <> :: WrittenWord -> WrittenWord -> WrittenWord
<> (WW String
w2) = String -> WrittenWord
WW (String -> WrittenWord) -> String -> WrittenWord
forall a b. (a -> b) -> a -> b
$ String
w1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
w2

-- | Technically this shouldnt exist ever 
instance Monoid WrittenWord where
  mempty :: WrittenWord
mempty = String -> WrittenWord
WW String
""

instance Semigroup Sentence where
  (Sentence [WrittenWord]
s1) <> :: Sentence -> Sentence -> Sentence
<> (Sentence [WrittenWord]
s2) = [WrittenWord] -> Sentence
Sentence ([WrittenWord] -> Sentence) -> [WrittenWord] -> Sentence
forall a b. (a -> b) -> a -> b
$ [WrittenWord]
s1 [WrittenWord] -> [WrittenWord] -> [WrittenWord]
forall a. Semigroup a => a -> a -> a
<> [WrittenWord]
s2

instance Monoid Sentence where
  mempty :: Sentence
mempty = [WrittenWord] -> Sentence
Sentence []

instance Semigroup Paragraph where
  (Paragraph [Sentence]
p) <> :: Paragraph -> Paragraph -> Paragraph
<> (Paragraph [Sentence]
p2) = [Sentence] -> Paragraph
Paragraph ([Sentence] -> Paragraph) -> [Sentence] -> Paragraph
forall a b. (a -> b) -> a -> b
$ [Sentence]
p [Sentence] -> [Sentence] -> [Sentence]
forall a. Semigroup a => a -> a -> a
<> [Sentence]
p2

instance Monoid Paragraph where
  mempty :: Paragraph
mempty = [Sentence] -> Paragraph
Paragraph []

instance ShowHTML Paragraph where
  showH :: Paragraph -> String
showH (Paragraph [Sentence]
s) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Sentence -> String) -> [Sentence] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Sentence -> String
forall a. ShowHTML a => a -> String
showH [Sentence]
s 

instance ShowHTML Sentence where
  showH :: Sentence -> String
showH (Sentence [WrittenWord]
words) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"" ((WrittenWord -> String) -> [WrittenWord] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WrittenWord -> String
unWord [WrittenWord]
words) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"."
  --where

punctuation :: Stream s m Char => ParsecT s u m Char
punctuation :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
punctuation = String -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf [Char
';', Char
':', Char
'(', Char
')', Char
'\"', Char
'\'', Char
'-', Char
','] -- dk if last one works

-- | Word also means bits but I mean written specifically
-- | This can definitely be expanded upon to increase its reach
-- | while maintaining validity
writtenWord :: Stream s m Char => ParsecT s u m WrittenWord
writtenWord :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m WrittenWord
writtenWord = String -> WrittenWord
WW (String -> WrittenWord)
-> ParsecT s u m String -> ParsecT s u m WrittenWord
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT s u m Char -> ParsecT s u m String
forall a. ParsecT s u m a -> ParsecT s u m [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (ParsecT s u m Char -> ParsecT s u m String)
-> ParsecT s u m Char -> ParsecT s u m String
forall a b. (a -> b) -> a -> b
$ ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
punctuation) ParsecT s u m WrittenWord
-> ParsecT s u m () -> ParsecT s u m WrittenWord
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT s u m Char -> ParsecT s u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ')







wordSeparator, comma, colon, semiColon ::  Stream s m Char => ParsecT s u m String
wordSeparator :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
wordSeparator = ((Char -> ShowS
forall a. a -> [a] -> [a]
:[]) (Char -> String) -> ParsecT s u m Char -> ParsecT s u m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space) ParsecT s u m String
-> ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
comma ParsecT s u m String
-> ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
colon ParsecT s u m String
-> ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
semiColon 
comma :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
comma = do
  Char
c <- Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
','
  String
s <- String -> ParsecT s u m String -> ParsecT s u m String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" (ParsecT s u m String -> ParsecT s u m String)
-> ParsecT s u m String -> ParsecT s u m String
forall a b. (a -> b) -> a -> b
$ (Char -> ShowS
forall a. a -> [a] -> [a]
:[]) (Char -> String) -> ParsecT s u m Char -> ParsecT s u m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
  String -> ParsecT s u m String
forall a. a -> ParsecT s u m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> ParsecT s u m String) -> String -> ParsecT s u m String
forall a b. (a -> b) -> a -> b
$ Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
s  
colon :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
colon = do 
  Char
c <- Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
  String
s <- String -> ParsecT s u m String -> ParsecT s u m String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" (ParsecT s u m String -> ParsecT s u m String)
-> ParsecT s u m String -> ParsecT s u m String
forall a b. (a -> b) -> a -> b
$ (Char -> ShowS
forall a. a -> [a] -> [a]
:[]) (Char -> String) -> ParsecT s u m Char -> ParsecT s u m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
  String -> ParsecT s u m String
forall a. a -> ParsecT s u m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> ParsecT s u m String) -> String -> ParsecT s u m String
forall a b. (a -> b) -> a -> b
$ Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
s  
semiColon :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
semiColon = do
  Char
c <- Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
';'
  String
s <- String -> ParsecT s u m String -> ParsecT s u m String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" (ParsecT s u m String -> ParsecT s u m String)
-> ParsecT s u m String -> ParsecT s u m String
forall a b. (a -> b) -> a -> b
$ (Char -> ShowS
forall a. a -> [a] -> [a]
:[]) (Char -> String) -> ParsecT s u m Char -> ParsecT s u m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
  String -> ParsecT s u m String
forall a. a -> ParsecT s u m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> ParsecT s u m String) -> String -> ParsecT s u m String
forall a b. (a -> b) -> a -> b
$ Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
s  

word' :: Stream s m Char => ParsecT s u m String
word' :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
word' = ParsecT s u m String
forall {u}. ParsecT s u m String
a_ ParsecT s u m String
-> ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m String
forall {u}. ParsecT s u m String
else'
  where
    a_ :: ParsecT s u m String
a_ = do
      Char
head_ <- Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'a'
      String
tail_ <- ParsecT s u m Char -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT s u m Char -> ParsecT s u m String)
-> ParsecT s u m Char -> ParsecT s u m String
forall a b. (a -> b) -> a -> b
$ ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\'') ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-')
      String -> ParsecT s u m String
forall a. a -> ParsecT s u m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> ParsecT s u m String) -> String -> ParsecT s u m String
forall a b. (a -> b) -> a -> b
$ Char
head_ Char -> ShowS
forall a. a -> [a] -> [a]
: String
tail_
    
    else' :: ParsecT s u m String
else' = ParsecT s u m Char -> ParsecT s u m String
forall a. ParsecT s u m a -> ParsecT s u m [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\'') ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-'))

capitalizedWord :: Stream s m Char => ParsecT s u m String
capitalizedWord :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
capitalizedWord = ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s u m String
forall {u}. ParsecT s u m String
ia ParsecT s u m String
-> ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m String
forall {u}. ParsecT s u m String
else'
  where
    ia :: ParsecT s u m String
ia = do
      Char
head_ <- String -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf [Char
'I', Char
'A']
      String
tail_ <- ParsecT s u m Char -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT s u m Char -> ParsecT s u m String)
-> ParsecT s u m Char -> ParsecT s u m String
forall a b. (a -> b) -> a -> b
$ ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\'') ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-')
      String -> ParsecT s u m String
forall a. a -> ParsecT s u m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> ParsecT s u m String) -> String -> ParsecT s u m String
forall a b. (a -> b) -> a -> b
$ Char
head_ Char -> ShowS
forall a. a -> [a] -> [a]
: String
tail_
    else' :: ParsecT s u m String
else' = do
      Char
head_ <- String -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf (String -> ParsecT s u m Char) -> String -> ParsecT s u m Char
forall a b. (a -> b) -> a -> b
$ [Char
'B'..Char
'H'] String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char
'J'..Char
'Z']
      String
tail_ <- ParsecT s u m Char -> ParsecT s u m String
forall a. ParsecT s u m a -> ParsecT s u m [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\'') ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-'))
      String -> ParsecT s u m String
forall a. a -> ParsecT s u m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> ParsecT s u m String) -> String -> ParsecT s u m String
forall a b. (a -> b) -> a -> b
$ Char
head_ Char -> ShowS
forall a. a -> [a] -> [a]
: String
tail_ 

number :: Stream s m Char => ParsecT s u m String
number :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
number = do
  String
whole <- ParsecT s u m Char -> ParsecT s u m String
forall a. ParsecT s u m a -> ParsecT s u m [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
  String
dec <- String -> ParsecT s u m String -> ParsecT s u m String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" (ParsecT s u m String -> ParsecT s u m String)
-> ParsecT s u m String -> ParsecT s u m String
forall a b. (a -> b) -> a -> b
$ do
    (:) (Char -> ShowS) -> ParsecT s u m Char -> ParsecT s u m ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.' ParsecT s u m ShowS -> ParsecT s u m String -> ParsecT s u m String
forall a b.
ParsecT s u m (a -> b) -> ParsecT s u m a -> ParsecT s u m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT s u m Char -> ParsecT s u m String
forall a. ParsecT s u m a -> ParsecT s u m [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
  String -> ParsecT s u m String
forall a. a -> ParsecT s u m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> ParsecT s u m String) -> String -> ParsecT s u m String
forall a b. (a -> b) -> a -> b
$ String
whole String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
dec

sentence :: Stream s m Char => ParsecT s u m Sentence
sentence :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Sentence
sentence = ([WrittenWord] -> Bool) -> ParsecT s u m Sentence
forall s (m :: * -> *) u.
Stream s m Char =>
([WrittenWord] -> Bool) -> ParsecT s u m Sentence
sentenceWhere (Bool -> [WrittenWord] -> Bool
forall a b. a -> b -> a
const Bool
True)
  
sentenceWhere :: Stream s m Char => ([WrittenWord] -> Bool) ->  ParsecT s u m Sentence
sentenceWhere :: forall s (m :: * -> *) u.
Stream s m Char =>
([WrittenWord] -> Bool) -> ParsecT s u m Sentence
sentenceWhere [WrittenWord] -> Bool
test = do
  [WrittenWord]
tokens <- ParsecT s u m String
-> ParsecT s u m String -> ParsecT s u m (Either String String)
forall (m :: * -> *) a b.
Alternative m =>
m a -> m b -> m (Either a b)
eitherP ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
capitalizedWord ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
number ParsecT s u m (Either String String)
-> (Either String String -> ParsecT s u m [WrittenWord])
-> ParsecT s u m [WrittenWord]
forall a b.
ParsecT s u m a -> (a -> ParsecT s u m b) -> ParsecT s u m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left String
word -> do
      ParsecT s u m String
-> ParsecT s u m Char -> ParsecT s u m (Either String Char)
forall (m :: * -> *) a b.
Alternative m =>
m a -> m b -> m (Either a b)
eitherP ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
wordSeparator (Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.') ParsecT s u m (Either String Char)
-> (Either String Char -> ParsecT s u m [WrittenWord])
-> ParsecT s u m [WrittenWord]
forall a b.
ParsecT s u m a -> (a -> ParsecT s u m b) -> ParsecT s u m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right Char
period -> [WrittenWord] -> ParsecT s u m [WrittenWord]
forall a. a -> ParsecT s u m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String -> WrittenWord
WW String
word]
        Left String
separator -> (String -> WrittenWord
WW (String
word String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
separator) WrittenWord -> [WrittenWord] -> [WrittenWord]
forall a. a -> [a] -> [a]
:) ([WrittenWord] -> [WrittenWord])
-> ParsecT s u m [WrittenWord] -> ParsecT s u m [WrittenWord]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> ParsecT s u m [WrittenWord]
forall s (m :: * -> *) u.
Stream s m Char =>
Bool -> ParsecT s u m [WrittenWord]
sentenceTail Bool
False
    Right String
number -> do
      ParsecT s u m String
-> ParsecT s u m Char -> ParsecT s u m (Either String Char)
forall (m :: * -> *) a b.
Alternative m =>
m a -> m b -> m (Either a b)
eitherP ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
wordSeparator (Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.') ParsecT s u m (Either String Char)
-> (Either String Char -> ParsecT s u m [WrittenWord])
-> ParsecT s u m [WrittenWord]
forall a b.
ParsecT s u m a -> (a -> ParsecT s u m b) -> ParsecT s u m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right Char
period -> [WrittenWord] -> ParsecT s u m [WrittenWord]
forall a. a -> ParsecT s u m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String -> WrittenWord
WW String
number]
        Left String
separator -> (String -> WrittenWord
WW (String
number String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
separator) WrittenWord -> [WrittenWord] -> [WrittenWord]
forall a. a -> [a] -> [a]
:) ([WrittenWord] -> [WrittenWord])
-> ParsecT s u m [WrittenWord] -> ParsecT s u m [WrittenWord]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> ParsecT s u m [WrittenWord]
forall s (m :: * -> *) u.
Stream s m Char =>
Bool -> ParsecT s u m [WrittenWord]
sentenceTail Bool
True

  ([WrittenWord] -> Bool) -> [WrittenWord] -> ParsecT s u m Sentence
forall s (m :: * -> *) u.
Stream s m Char =>
([WrittenWord] -> Bool) -> [WrittenWord] -> ParsecT s u m Sentence
toSentence [WrittenWord] -> Bool
test [WrittenWord]
tokens
  where
    toSentence :: Stream s m Char => ([WrittenWord] -> Bool) -> [WrittenWord] -> ParsecT s u m Sentence
    toSentence :: forall s (m :: * -> *) u.
Stream s m Char =>
([WrittenWord] -> Bool) -> [WrittenWord] -> ParsecT s u m Sentence
toSentence [WrittenWord] -> Bool
test [WrittenWord]
words = case [WrittenWord] -> Bool
test [WrittenWord]
words of
      Bool
False -> ParsecT s u m Sentence
forall s u (m :: * -> *) a. ParsecT s u m a
parserZero
      Bool
True -> Sentence -> ParsecT s u m Sentence
forall a. a -> ParsecT s u m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure  (Sentence -> ParsecT s u m Sentence)
-> Sentence -> ParsecT s u m Sentence
forall a b. (a -> b) -> a -> b
$ [WrittenWord] -> Sentence
Sentence [WrittenWord]
words --  Sentence $ intercalate "" (fmap unWord words) <> "."
    unWord :: WrittenWord -> String
unWord (WW String
s) = String
s

sentenceTail :: Stream s m Char => Bool -> ParsecT s u m [WrittenWord]
sentenceTail :: forall s (m :: * -> *) u.
Stream s m Char =>
Bool -> ParsecT s u m [WrittenWord]
sentenceTail Bool
previousWasNumber = do
  Either String String
token <- case Bool
previousWasNumber of
    Bool
True -> String -> Either String String
forall a b. a -> Either a b
Left (String -> Either String String)
-> ParsecT s u m String -> ParsecT s u m (Either String String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
word'
    Bool
False -> ParsecT s u m String
-> ParsecT s u m String -> ParsecT s u m (Either String String)
forall (m :: * -> *) a b.
Alternative m =>
m a -> m b -> m (Either a b)
eitherP ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
word' ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
number 
  ParsecT s u m String
-> ParsecT s u m Char -> ParsecT s u m (Either String Char)
forall (m :: * -> *) a b.
Alternative m =>
m a -> m b -> m (Either a b)
eitherP ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
wordSeparator (Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.') ParsecT s u m (Either String Char)
-> (Either String Char -> ParsecT s u m [WrittenWord])
-> ParsecT s u m [WrittenWord]
forall a b.
ParsecT s u m a -> (a -> ParsecT s u m b) -> ParsecT s u m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case    
    Left String
separator -> do
      [WrittenWord]
tokens <- Bool -> ParsecT s u m [WrittenWord]
forall s (m :: * -> *) u.
Stream s m Char =>
Bool -> ParsecT s u m [WrittenWord]
sentenceTail (Bool -> ParsecT s u m [WrittenWord])
-> Bool -> ParsecT s u m [WrittenWord]
forall a b. (a -> b) -> a -> b
$ Either String String -> Bool
forall a b. Either a b -> Bool
isRight Either String String
token
      [WrittenWord] -> ParsecT s u m [WrittenWord]
forall a. a -> ParsecT s u m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([WrittenWord] -> ParsecT s u m [WrittenWord])
-> [WrittenWord] -> ParsecT s u m [WrittenWord]
forall a b. (a -> b) -> a -> b
$ String -> WrittenWord
WW (ShowS -> ShowS -> Either String String -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ShowS
forall a. a -> a
id ShowS
forall a. a -> a
id Either String String
token String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
separator) WrittenWord -> [WrittenWord] -> [WrittenWord]
forall a. a -> [a] -> [a]
: [WrittenWord]
tokens 
    Right Char
period -> [WrittenWord] -> ParsecT s u m [WrittenWord]
forall a. a -> ParsecT s u m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([WrittenWord] -> ParsecT s u m [WrittenWord])
-> [WrittenWord] -> ParsecT s u m [WrittenWord]
forall a b. (a -> b) -> a -> b
$ [String -> WrittenWord
WW (String -> WrittenWord) -> String -> WrittenWord
forall a b. (a -> b) -> a -> b
$ ShowS -> ShowS -> Either String String -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ShowS
forall a. a -> a
id ShowS
forall a. a -> a
id Either String String
token]


-- sentenceTail = \case
--   True -> do
--     -- was number
--     some (word'  >> 
  

  
--   a <|> b
--   where
--     a = parseMaybe (number <* optional space) >> some word' >> (number <* optional space) >> (endSentence <|> recSentence)  
      


             

-- | For the sake of chaining these parsers, this optionally consumes
-- | a space at the end. This is the key char diff between one and many
-- | sentences
-- sentence :: Stream s m Char => ParsecT s u m Sentence
-- sentence = do
--   words <- some writtenWord
--   if length words < 4 then parserZero else return () 
--   period <- char '.'
--   optional (char ' ')
--   pure . mkSentence $ words 
 -- pure words

-- *** for research: new concept: reliable generalizations of thinking
-- --> perhaps a point on intelligence eg. math dude vs a dummy

-- | To my understanding this should not affect how we parse; it is
-- | only for sure a given that the result of our low level read is really
-- | just words and so the parsers should focus on setting up the next
-- | parser 
  
-- paragraph :: Stream s m Char => ParsecT s u m Paragraph
-- paragraph = fmap mkParagraph $ some $ try sentence

-- | This is built in a way that allows the idea of a sentence
-- | to be as internally valid as possible; the sentence controls
-- | the period 
-- mkParagraph :: [Sentence] -> Paragraph
-- mkParagraph ss = Paragraph . mkParagraph' $ ss
--   where
--     mkParagraph' :: [Sentence] -> String
--     mkParagraph' ((Sentence s):[]) = s <> ('\n':[])
--     mkParagraph' ((Sentence s):ss) = s <> " " <> (mkParagraph' ss)

-- mkSentence :: [WrittenWord] -> Sentence
-- mkSentence words = Sentence . mkSentence' $ words
--   where 
--     mkSentence' :: [WrittenWord] -> String 
--     mkSentence' ((WW lastWord):[]) = lastWord <> "." 
--     mkSentence' ((WW word):words) = word <> " " <> (mkSentence' words)

-- paragraph' :: Stream s m Char => ParsecT s u m String
-- paragraph' = fmap ((intercalate " ") . mconcat) $ some $ try sentence

-- | Note: will need more complex accumulator for case where an elem has two distinct text segements broken up
-- | by an element, (rare case)


-- at a low level I would need to create a new elemHeadParser that succeeds for
-- whenever the case is not in the input set of tag and maybe attributes, ie
-- doesnt share any commonalities with the description

-- for now ill forget about attributes

-- -- | Is parseOpeningTag except elem tags are a fail if they match
-- -- | "blacklisted" so to speak
-- notElemHeadParser :: [Elem] -> ParsecT s u m ElemHead
-- notElemHeadParser = do
--   _ <- char '<'
--   elem <- mkNegElemtagParser 

styleTags :: [String]
styleTags :: [String]
styleTags =  [String
"b", String
"strong", String
"i", String
"em", String
"mark", String
"small", String
"ins", String
"sub", String
"sup"]  

-- | Will only match elements not specified 
negParseOpeningTag :: Stream s m Char => [Elem] -> ParsecT s u m (Elem, Attrs)
negParseOpeningTag :: forall s (m :: * -> *) u.
Stream s m Char =>
[String] -> ParsecT s u m ElemHead
negParseOpeningTag [String]
elemOpts = do
  -- _ <- MParsec.manyTill anyToken (char '<' >> elemOpts >> attrsParser attrsSubset) -- the buildElemsOpts [Elem]
  Char
_ <- Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'<'
  String
tag <- ParsecT s u m Char -> ParsecT s u m String
forall a. ParsecT s u m a -> ParsecT s u m [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum -- mkElemtagParser $ Just elemOpts
  Bool -> ParsecT s u m () -> ParsecT s u m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
tag [String]
elemOpts) ParsecT s u m ()
forall s u (m :: * -> *) a. ParsecT s u m a
parserZero
  Either AttrsError Attrs
attrs <- [(String, Maybe String)] -> ParsecT s u m (Either AttrsError Attrs)
forall s (m :: * -> *) u.
Stream s m Char =>
[(String, Maybe String)] -> ParsecT s u m (Either AttrsError Attrs)
attrsParser []
  ElemHead -> ParsecT s u m ElemHead
forall a. a -> ParsecT s u m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ElemHead -> ParsecT s u m ElemHead)
-> ElemHead -> ParsecT s u m ElemHead
forall a b. (a -> b) -> a -> b
$ (String
tag, Attrs -> Either AttrsError Attrs -> Attrs
forall b a. b -> Either a b -> b
fromRight Attrs
forall a. Monoid a => a
mempty Either AttrsError Attrs
attrs) 

textChunk :: Stream s m Char => ParsecT s u m String 
textChunk :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
textChunk = ([String] -> String)
-> ParsecT s u m [String] -> ParsecT s u m String
forall a b. (a -> b) -> ParsecT s u m a -> ParsecT s u m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> String
forall a. Monoid a => [a] -> a
mconcat (ParsecT s u m [String] -> ParsecT s u m String)
-> ParsecT s u m [String] -> ParsecT s u m String
forall a b. (a -> b) -> a -> b
$ ParsecT s u m String -> ParsecT s u m () -> ParsecT s u m [String]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
plainText (ParsecT s u m () -> ParsecT s u m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s u m () -> ParsecT s u m ())
-> ParsecT s u m () -> ParsecT s u m ()
forall a b. (a -> b) -> a -> b
$ ParsecT s u m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
openOrCloseTag)
 -- also need to trim out whitespace, \n's, and script

-- | This will match any element open or closing tag that is not a style tag
openOrCloseTag :: Stream s m Char => ParsecT s u m ()
openOrCloseTag :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
openOrCloseTag = 
  ParsecT s u m Char -> ParsecT s u m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT s u m Char -> ParsecT s u m ())
-> ParsecT s u m Char -> ParsecT s u m ()
forall a b. (a -> b) -> a -> b
$ (ParsecT s u m Char -> ParsecT s u m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s u m Char -> ParsecT s u m Char)
-> ParsecT s u m Char -> ParsecT s u m Char
forall a b. (a -> b) -> a -> b
$ [String] -> ParsecT s u m ElemHead
forall s (m :: * -> *) u.
Stream s m Char =>
[String] -> ParsecT s u m ElemHead
negParseOpeningTag [String]
styleTags ParsecT s u m ElemHead -> ParsecT s u m Char -> ParsecT s u m Char
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'>') ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyEndTag
  -- could also fit in script bit here 

anyEndTag :: Stream s m Char => ParsecT s u m Char 
anyEndTag :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyEndTag = do
  String -> ParsecT s u m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"</" ParsecT s u m String
-> ParsecT s u m String -> ParsecT s u m String
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [String] -> ParsecT s u m String
forall s (m :: * -> *) u.
Stream s m Char =>
[String] -> ParsecT s u m String
anyThingbut [String]
styleTags ParsecT s u m String -> ParsecT s u m Char -> ParsecT s u m Char
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'>'

-- | Despite the fun name, this is just for textChunk use
anyThingbut :: Stream s m Char => [String] -> ParsecT s u m String
anyThingbut :: forall s (m :: * -> *) u.
Stream s m Char =>
[String] -> ParsecT s u m String
anyThingbut [String]
es = do
  String
txt <- ParsecT s u m Char -> ParsecT s u m String
forall a. ParsecT s u m a -> ParsecT s u m [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum
  Bool -> ParsecT s u m () -> ParsecT s u m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
txt [String]
es) (ParsecT s u m () -> ParsecT s u m ())
-> ParsecT s u m () -> ParsecT s u m ()
forall a b. (a -> b) -> a -> b
$ ParsecT s u m ()
forall s u (m :: * -> *) a. ParsecT s u m a
parserZero
  String -> ParsecT s u m String
forall a. a -> ParsecT s u m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
txt
    
textChunkIf :: Stream s m Char => (String -> Bool) -> ParsecT s u m String
textChunkIf :: forall s (m :: * -> *) u.
Stream s m Char =>
(String -> Bool) -> ParsecT s u m String
textChunkIf String -> Bool
f = do
  String
x <- ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
textChunk
  Bool -> ParsecT s u m () -> ParsecT s u m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Bool
f String
x) (ParsecT s u m () -> ParsecT s u m ())
-> ParsecT s u m () -> ParsecT s u m ()
forall a b. (a -> b) -> a -> b
$ ParsecT s u m ()
forall s u (m :: * -> *) a. ParsecT s u m a
parserZero
  String -> ParsecT s u m String
forall a. a -> ParsecT s u m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
x 

-- parse () "" "eeee<i>hey</i><a></a>"

plainText :: Stream s m Char => ParsecT s u m String
plainText :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
plainText = do
  String
unit <- Elem' String -> String
forall b. Elem' b -> String
forall (a :: * -> *) b. ElementRep a => a b -> String
innerText' (Elem' String -> String)
-> ParsecT s u m (Elem' String) -> ParsecT s u m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m (Elem' String)
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m (Elem' String)
styleElem ParsecT s u m String
-> ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((Char -> String) -> ParsecT s u m Char -> ParsecT s u m String
forall a b. (a -> b) -> ParsecT s u m a -> ParsecT s u m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char -> ShowS
forall a. a -> [a] -> [a]
:[]) ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar)
  String -> ParsecT s u m String
forall a. a -> ParsecT s u m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
unit 


-- plainText' = do
--   styleElemOpenOrClose
--   anyChar 

--   a style elem should be skiped while a normal elem should end

-- fmap elemAny 

styleElem :: Stream s m Char => ParsecT s u m (Elem' String)
styleElem :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m (Elem' String)
styleElem = Maybe [String]
-> Maybe (ParsecT s u m String)
-> [(String, Maybe String)]
-> ParsecT s u m (Elem' String)
forall a s (m :: * -> *) u.
(ShowHTML a, Stream s m Char) =>
Maybe [String]
-> Maybe (ParsecT s u m a)
-> [(String, Maybe String)]
-> ParsecT s u m (Elem' a)
elemParser ([String] -> Maybe [String]
forall a. a -> Maybe a
Just ([String] -> Maybe [String]) -> [String] -> Maybe [String]
forall a b. (a -> b) -> a -> b
$ [String]
styleTags) Maybe (ParsecT s u m String)
forall s u (m :: * -> *). Maybe (ParsecT s u m String)
noPat []
-- closeOrOpenTag = try $ negParseOpeningTag ["i"]

-- manyTill anyChar (el "i" [] >> parserZero) <|> (elemParser Nothing Nothing []) 

-- prsr = openingTag >> manyTill (styleTagElem <|> anyChar) closeOrOpenTag

-- scrape prsr html 


-- check if styleTag --> Wrap InnerText (show styleTag) ;; safely unwraps into plain                                                         text 
--   <|> (elemParser null >> pure Fail)
--   <|> anyChar

--   }-> inside of manyTill_ :: (end, [a]) 


type Html = String
-- getPlainText :: Html -> Either ParseError [String]
-- getPlainText html = do
  -- let
    -- expr = (fmap show $ parseOpeningTag (Just styleTags) [])
            -- <|> (string "</" >> buildElemsOpts styleTags >> string ">")
    -- styleTags = ["b", "strong", "i", "em", "mark", "small", "ins", "sub", "sup"]   --"del" omitted
     
  -- divied <- parse (divideUp expr) "" html    
  -- parse onlyPlainText "" $ (mconcat . catEithers) divied

removeStyleTags :: Html -> Html
removeStyleTags :: ShowS
removeStyleTags String
html = ([String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String)
-> ([Either String String] -> [String])
-> [Either String String]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either String String] -> [String]
forall e a. [Either e a] -> [a]
catEithers) ([Either String String] -> String)
-> [Either String String] -> String
forall a b. (a -> b) -> a -> b
$ [Either String String]
-> Either ParseError [Either String String]
-> [Either String String]
forall b a. b -> Either a b -> b
fromRight [] (Either ParseError [Either String String]
 -> [Either String String])
-> Either ParseError [Either String String]
-> [Either String String]
forall a b. (a -> b) -> a -> b
$ Parsec String () [Either String String]
-> String -> String -> Either ParseError [Either String String]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (ParsecT String () Identity String
-> Parsec String () [Either String String]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m String -> ParsecT s u m [Either String String]
divideUp ParsecT String () Identity String
forall {u}. ParsecT String u Identity String
expr) String
"" String
html
  where expr :: ParsecT String u Identity String
expr = ((ElemHead -> String)
-> ParsecT String u Identity ElemHead
-> ParsecT String u Identity String
forall a b.
(a -> b)
-> ParsecT String u Identity a -> ParsecT String u Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ElemHead -> String
forall a. Show a => a -> String
show (ParsecT String u Identity ElemHead
 -> ParsecT String u Identity String)
-> ParsecT String u Identity ElemHead
-> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ Maybe [String]
-> [(String, Maybe String)] -> ParsecT String u Identity ElemHead
forall s (m :: * -> *) u.
Stream s m Char =>
Maybe [String]
-> [(String, Maybe String)] -> ParsecT s u m ElemHead
parseOpeningTag ([String] -> Maybe [String]
forall a. a -> Maybe a
Just [String]
styleTags) [])
               ParsecT String u Identity String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"</" ParsecT String u Identity String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [String] -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
[String] -> ParsecT s u m String
buildElemsOpts [String]
styleTags ParsecT String u Identity String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
">")
        



-- getPlainText' :: ParsecT s u m [String]
-- getPlainText' = do
  

  -- join $ fmap (  (parse onlyPlainText "")  . mconcat . catEithers) $ 
  -- where
    -- expr = (fmap show $ parseOpeningTag (Just styleTags) [])
            -- <|> (string "</" >> buildElemsOpts styleTags >> string ">")
    -- styleTags = ["b", "strong", "i", "em", "mark", "small", "ins", "sub", "sup"]   --"del" omitted 

-- Just applies onlyPlainText to html tag
-- getDocText :: Html -> [String]
-- getDocText html = 


catEithers :: [Either e a] -> [a]
catEithers :: forall e a. [Either e a] -> [a]
catEithers (Either e a
x:[Either e a]
xs) = case Either e a
x of
  Right a
a -> a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [Either e a] -> [a]
forall e a. [Either e a] -> [a]
catEithers [Either e a]
xs
  Left e
_ -> [Either e a] -> [a]
forall e a. [Either e a] -> [a]
catEithers [Either e a]
xs
  -- in this case, our Right case are the ones we want to eliminate

divideUp :: Stream s m Char => ParsecT s u m String -> ParsecT s u m [Either String String]
divideUp :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m String -> ParsecT s u m [Either String String]
divideUp ParsecT s u m String
parser = ParsecT s u m (Either String String)
-> ParsecT s u m [Either String String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ((String -> Either String String
forall a b. b -> Either a b
Right (String -> Either String String)
-> ParsecT s u m String -> ParsecT s u m (Either String String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m String
parser) ParsecT s u m (Either String String)
-> ParsecT s u m (Either String String)
-> ParsecT s u m (Either String String)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ( (String -> Either String String
forall a b. a -> Either a b
Left (String -> Either String String)
-> (Char -> String) -> Char -> Either String String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> ShowS
forall a. a -> [a] -> [a]
:[]) ) (Char -> Either String String)
-> ParsecT s u m Char -> ParsecT s u m (Either String String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar)) 

onlyPlainText :: Stream s m Char => ParsecT s u m String
onlyPlainText :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
onlyPlainText = (AccumITextElem String -> String)
-> ParsecT s u m (AccumITextElem String) -> ParsecT s u m String
forall a b. (a -> b) -> ParsecT s u m a -> ParsecT s u m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(ACT [String]
strings) -> [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. [a] -> [a]
reverse [String]
strings) ParsecT s u m (AccumITextElem String)
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m (AccumITextElem String)
specialElemParser 
  where
    specialElemParser :: Stream s m Char => ParsecT s u m (AccumITextElem String)
    specialElemParser :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m (AccumITextElem String)
specialElemParser = do
      (String
elem', Attrs
attrs') <- Maybe [String]
-> [(String, Maybe String)] -> ParsecT s u m ElemHead
forall s (m :: * -> *) u.
Stream s m Char =>
Maybe [String]
-> [(String, Maybe String)] -> ParsecT s u m ElemHead
parseOpeningTag ([String] -> Maybe [String]
forall a. a -> Maybe a
Just [String
"html"]) []  
      (String
localText, [String]
inTex) <- ([HTMLMatcher AccumITextElem String] -> (String, [String]))
-> ParsecT s u m [HTMLMatcher AccumITextElem String]
-> ParsecT s u m (String, [String])
forall a b. (a -> b) -> ParsecT s u m a -> ParsecT s u m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((HTMLMatcher AccumITextElem String
 -> (String, [String]) -> (String, [String]))
-> (String, [String])
-> [HTMLMatcher AccumITextElem String]
-> (String, [String])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr HTMLMatcher AccumITextElem String
-> (String, [String]) -> (String, [String])
textOnlyFoldr (String, [String])
forall a. Monoid a => a
mempty)
                                (ParsecT s u m [HTMLMatcher AccumITextElem String]
 -> ParsecT s u m (String, [String]))
-> ParsecT s u m [HTMLMatcher AccumITextElem String]
-> ParsecT s u m (String, [String])
forall a b. (a -> b) -> a -> b
$ (ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT s u m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"/>") ParsecT s u m String
-> ParsecT s u m [HTMLMatcher AccumITextElem String]
-> ParsecT s u m [HTMLMatcher AccumITextElem String]
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [HTMLMatcher AccumITextElem String]
-> ParsecT s u m [HTMLMatcher AccumITextElem String]
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return [])
                                ParsecT s u m [HTMLMatcher AccumITextElem String]
-> ParsecT s u m [HTMLMatcher AccumITextElem String]
-> ParsecT s u m [HTMLMatcher AccumITextElem String]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT s u m [HTMLMatcher AccumITextElem String]
-> ParsecT s u m [HTMLMatcher AccumITextElem String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s u m [HTMLMatcher AccumITextElem String]
 -> ParsecT s u m [HTMLMatcher AccumITextElem String])
-> ParsecT s u m [HTMLMatcher AccumITextElem String]
-> ParsecT s u m [HTMLMatcher AccumITextElem String]
forall a b. (a -> b) -> a -> b
$ String -> ParsecT s u m [HTMLMatcher AccumITextElem String]
forall {s} {m :: * -> *} {u}.
Stream s m Char =>
String -> ParsecT s u m [HTMLMatcher AccumITextElem String]
innerElemParser' String
elem')
                                ParsecT s u m [HTMLMatcher AccumITextElem String]
-> ParsecT s u m [HTMLMatcher AccumITextElem String]
-> ParsecT s u m [HTMLMatcher AccumITextElem String]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Maybe (ParsecT s u m String)
-> ParsecT s u m [HTMLMatcher AccumITextElem String]
forall a s (m :: * -> *) u (e :: * -> *).
(ShowHTML a, Stream s m Char) =>
Maybe (ParsecT s u m a) -> ParsecT s u m [HTMLMatcher e a]
selfClosingTextful Maybe (ParsecT s u m String)
forall a. Maybe a
Nothing) -- did not have an easily associated end tag
      AccumITextElem String -> ParsecT s u m (AccumITextElem String)
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (AccumITextElem String -> ParsecT s u m (AccumITextElem String))
-> AccumITextElem String -> ParsecT s u m (AccumITextElem String)
forall a b. (a -> b) -> a -> b
$ [String] -> AccumITextElem String
forall a. [String] -> AccumITextElem a
ACT (String
localText String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
inTex) 
      
      where innerElemParser' :: String -> ParsecT s u m [HTMLMatcher AccumITextElem String]
innerElemParser' String
eTag = --htmlGenParser with specialElemParser 
              Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'>'
              ParsecT s u m Char
-> ParsecT s u m [HTMLMatcher AccumITextElem String]
-> ParsecT s u m [HTMLMatcher AccumITextElem String]
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s u m (HTMLMatcher AccumITextElem String)
-> ParsecT s u m String
-> ParsecT s u m [HTMLMatcher AccumITextElem String]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill (AccumITextElem String -> HTMLMatcher AccumITextElem String
forall (a :: * -> *) b. a b -> HTMLMatcher a b
Element (AccumITextElem String -> HTMLMatcher AccumITextElem String)
-> ParsecT s u m (AccumITextElem String)
-> ParsecT s u m (HTMLMatcher AccumITextElem String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT s u m (AccumITextElem String)
-> ParsecT s u m (AccumITextElem String)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s u m (AccumITextElem String)
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m (AccumITextElem String)
specialElemParser) 
                           ParsecT s u m (HTMLMatcher AccumITextElem String)
-> ParsecT s u m (HTMLMatcher AccumITextElem String)
-> ParsecT s u m (HTMLMatcher AccumITextElem String)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((String -> HTMLMatcher AccumITextElem String
forall (a :: * -> *) b. String -> HTMLMatcher a b
IText (String -> HTMLMatcher AccumITextElem String)
-> (Char -> String) -> Char -> HTMLMatcher AccumITextElem String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> ShowS
forall a. a -> [a] -> [a]
:[])) (Char -> HTMLMatcher AccumITextElem String)
-> ParsecT s u m Char
-> ParsecT s u m (HTMLMatcher AccumITextElem String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar)  ) (String -> ParsecT s u m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
endTag String
eTag)

            -- selfClosingTextful = manyTill (IText . (:[]) <$> anyChar) endTagg
            -- endTagg = (try (char '<'
                            -- >> (optional (char '/'))
                            -- >> MParsec.some anyChar
                            -- >> (string " " <|> string ">")))

-- Not for getting matches 
data AccumITextElem a = ACT [String]

textOnlyFoldr :: HTMLMatcher AccumITextElem String -> (String, [String]) -> (String, [String]) 
textOnlyFoldr :: HTMLMatcher AccumITextElem String
-> (String, [String]) -> (String, [String])
textOnlyFoldr HTMLMatcher AccumITextElem String
htmlM (String
itextAccum, [String]
fromElemAccum) = case HTMLMatcher AccumITextElem String
htmlM of 
  IText String
str -> 
    (String
itextAccum String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
str, [String]
fromElemAccum) 
  Element (ACT [String]
strList) ->
    (String
itextAccum, [String]
fromElemAccum [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
strList)
  -- should never fire
  Match String
mat ->
    (String
itextAccum String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
mat, [String]
fromElemAccum)

-- Should consider using the following data structure




-- textOnlyFoldr :: [HTMLMatcher e a] -> [String] 
-- textOnlyFoldr htmlMs = fmap f htmlMs -- . filter (\x -> case x of { IText x -> True; _ -> False }) htmlMs
--       where
--         f htmlM = case htmlM of 
--                     Match str -> str
--                     IText str -> str
--                     Element e  -> innerText' e