content: 
  module Text.HTML.TagSoup.Development.ParserUtils
      (PState, Parser, Pick, runParser
      ,(&), (|->), cons, nil, pick
      ,nullS, headS, tailS
      ,dropS, spanS, dropWhileS
      ,spanEndS
      ) where
  
  import Data.List
  
  
  infix 2 |->
  infix 3 &
  
  ---------------------------------------------------------------------
  -- DATA TYPES
  
  data PState = PState {text :: String, row :: !Int, col :: !Int}
  
  type Parser a = PState -> a
  
  type Pick a = Parser (Maybe a)
  
  
  runParser :: Parser a -> String -> a
  runParser p s = p (PState s 1 1)
  
  
  ---------------------------------------------------------------------
  -- PARSER COMBINATORS
  
  {-# INLINE (&) #-}
  {-# INLINE (|->) #-}
  {-# INLINE cons #-}
  {-# INLINE nil #-}
  {-# INLINE pick #-}
  
  (&) :: Parser a -> (a -> b) -> Parser b
  (&) p f s = f (p s)
  
  
  (|->) :: String -> Parser a -> Pick a
  (|->) t p s | t `isPrefixOf` text s = Just $ p $ dropS (length t) s
              | otherwise = Nothing
  
  
  cons :: (Char -> PState -> a) -> Pick a
  cons f s | not $ nullS s = Just $ f (headS s) (tailS s)
  cons f _ = Nothing
  
  
  nil :: a -> Pick a
  nil r s | nullS s = Just r
  nil r _ = Nothing
  
  
  pick :: [Pick a] -> Parser a
  pick (x:xs) s = case x s of
                      Nothing -> pick xs s
                      Just y -> y
  pick _ s = error "No pick alternatives matched"
  
  
  ---------------------------------------------------------------------
  -- STATE COMBINATORS
  
  update x xs r c = case x of
      '\n' -> PState xs (r+1) 1
      '\t' -> PState xs r (c + 8 - mod (c-1) 8)
      _    -> PState xs r (c+1)
  
  
  nullS :: PState -> Bool
  nullS = null . text
  
  
  tailS :: PState -> PState
  tailS (PState (x:xs) r c) = update x xs r c
  
  
  headS :: PState -> Char
  headS = head . text
  
  
  dropS :: Int -> PState -> PState
  dropS n (PState (x:xs) r c) | n > 0 = dropS (n-1) (update x xs r c)
  dropS n s = s
  
  
  spanS :: (Char -> Bool) -> PState -> (String, PState)
  spanS f (PState (x:xs) r c) | f x = (x:a, b)
      where (a,b) = spanS f $ update x xs r c
  spanS f s = ("", s)
  
  
  dropWhileS :: (Char -> Bool) -> PState -> PState
  dropWhileS f (PState (x:xs) r c) | f x = dropWhileS f $ update x xs r c
  dropWhileS f s = s
  
  
  -- keep reading until you reach some end text
  -- (x,y,True ) = spanEnd t s  ==> s == x ++ t ++ y
  -- (x,y,False) = spanEnd t s  ==> s == x  &&  y == ""
  spanEndS :: String -> PState -> (String, PState, Bool)
  spanEndS t s@(PState xs r c) | t `isPrefixOf` xs = ("", dropS (length t) s, True)
  spanEndS t s@(PState []     r c) = ("", s, False)
  spanEndS t s@(PState (x:xs) r c) = (x:r1,r2,r3)
      where (r1,r2,r3) = spanEndS t $ update x xs r c
  