{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-}
module Text.Parsec.Indentation.Char where

import Text.Parsec.Prim (ParsecT, mkPT, runParsecT,
                         Stream(..),
                         Consumed(..), Reply(..),
                         State(..))
import Text.Parsec.Pos (sourceColumn)
import Text.Parser.Indentation.Implementation (Indentation)

----------------
-- Unicode char
-- newtype UnicodeIndentStream

----------------
-- Based on Char
{-# INLINE mkCharIndentStream #-}
mkCharIndentStream :: s -> CharIndentStream s
mkCharIndentStream :: s -> CharIndentStream s
mkCharIndentStream s
s = Indentation -> s -> CharIndentStream s
forall s. Indentation -> s -> CharIndentStream s
CharIndentStream Indentation
1 s
s
data CharIndentStream s = CharIndentStream { CharIndentStream s -> Indentation
charIndentStreamColumn :: {-# UNPACK #-} !Indentation,
                                             CharIndentStream s -> s
charIndentStreamStream :: !s } deriving (Indentation -> CharIndentStream s -> ShowS
[CharIndentStream s] -> ShowS
CharIndentStream s -> String
(Indentation -> CharIndentStream s -> ShowS)
-> (CharIndentStream s -> String)
-> ([CharIndentStream s] -> ShowS)
-> Show (CharIndentStream s)
forall s. Show s => Indentation -> CharIndentStream s -> ShowS
forall s. Show s => [CharIndentStream s] -> ShowS
forall s. Show s => CharIndentStream s -> String
forall a.
(Indentation -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CharIndentStream s] -> ShowS
$cshowList :: forall s. Show s => [CharIndentStream s] -> ShowS
show :: CharIndentStream s -> String
$cshow :: forall s. Show s => CharIndentStream s -> String
showsPrec :: Indentation -> CharIndentStream s -> ShowS
$cshowsPrec :: forall s. Show s => Indentation -> CharIndentStream s -> ShowS
Show)

instance (Stream s m Char) => Stream (CharIndentStream s) m (Char, Indentation) where
  uncons :: CharIndentStream s
-> m (Maybe ((Char, Indentation), CharIndentStream s))
uncons (CharIndentStream Indentation
i s
s) = do
    Maybe (Char, s)
x <- s -> m (Maybe (Char, s))
forall s (m :: * -> *) t. Stream s m t => s -> m (Maybe (t, s))
uncons s
s
    case Maybe (Char, s)
x of
      Maybe (Char, s)
Nothing -> Maybe ((Char, Indentation), CharIndentStream s)
-> m (Maybe ((Char, Indentation), CharIndentStream s))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ((Char, Indentation), CharIndentStream s)
forall a. Maybe a
Nothing
      Just (Char
c, s
cs) -> Maybe ((Char, Indentation), CharIndentStream s)
-> m (Maybe ((Char, Indentation), CharIndentStream s))
forall (m :: * -> *) a. Monad m => a -> m a
return (((Char, Indentation), CharIndentStream s)
-> Maybe ((Char, Indentation), CharIndentStream s)
forall a. a -> Maybe a
Just ((Char
c, Indentation
i), Indentation -> s -> CharIndentStream s
forall s. Indentation -> s -> CharIndentStream s
CharIndentStream (Indentation -> Char -> Indentation
forall a. Integral a => a -> Char -> a
updateColumn Indentation
i Char
c) s
cs))

{-# INLINE updateColumn #-}
updateColumn :: Integral a => a -> Char -> a
updateColumn :: a -> Char -> a
updateColumn a
_ Char
'\n' = a
1
updateColumn a
i Char
'\t' = a
i a -> a -> a
forall a. Num a => a -> a -> a
+ a
8 a -> a -> a
forall a. Num a => a -> a -> a
- ((a
ia -> a -> a
forall a. Num a => a -> a -> a
-a
1) a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
8)
updateColumn a
i Char
_    = a
i a -> a -> a
forall a. Num a => a -> a -> a
+ a
1

{-# INLINE charIndentStreamParser #-}
charIndentStreamParser :: (Monad m) => ParsecT s u m t -> ParsecT (CharIndentStream s) u m (t, Indentation)
charIndentStreamParser :: ParsecT s u m t
-> ParsecT (CharIndentStream s) u m (t, Indentation)
charIndentStreamParser ParsecT s u m t
p = (State (CharIndentStream s) u
 -> m (Consumed
         (m (Reply (CharIndentStream s) u (t, Indentation)))))
-> ParsecT (CharIndentStream s) u m (t, Indentation)
forall (m :: * -> *) s u a.
Monad m =>
(State s u -> m (Consumed (m (Reply s u a)))) -> ParsecT s u m a
mkPT ((State (CharIndentStream s) u
  -> m (Consumed
          (m (Reply (CharIndentStream s) u (t, Indentation)))))
 -> ParsecT (CharIndentStream s) u m (t, Indentation))
-> (State (CharIndentStream s) u
    -> m (Consumed
            (m (Reply (CharIndentStream s) u (t, Indentation)))))
-> ParsecT (CharIndentStream s) u m (t, Indentation)
forall a b. (a -> b) -> a -> b
$ \State (CharIndentStream s) u
state ->
  let go :: Reply s u a -> m (Reply (CharIndentStream s) u (a, Indentation))
go (Ok a
a State s u
state' ParseError
e) = Reply (CharIndentStream s) u (a, Indentation)
-> m (Reply (CharIndentStream s) u (a, Indentation))
forall (m :: * -> *) a. Monad m => a -> m a
return ((a, Indentation)
-> State (CharIndentStream s) u
-> ParseError
-> Reply (CharIndentStream s) u (a, Indentation)
forall s u a. a -> State s u -> ParseError -> Reply s u a
Ok (a
a, SourcePos -> Indentation
sourceColumn (SourcePos -> Indentation) -> SourcePos -> Indentation
forall a b. (a -> b) -> a -> b
$ State (CharIndentStream s) u -> SourcePos
forall s u. State s u -> SourcePos
statePos State (CharIndentStream s) u
state) (State s u
state' { stateInput :: CharIndentStream s
stateInput = Indentation -> s -> CharIndentStream s
forall s. Indentation -> s -> CharIndentStream s
CharIndentStream (SourcePos -> Indentation
sourceColumn (SourcePos -> Indentation) -> SourcePos -> Indentation
forall a b. (a -> b) -> a -> b
$ State s u -> SourcePos
forall s u. State s u -> SourcePos
statePos State s u
state') (State s u -> s
forall s u. State s u -> s
stateInput State s u
state') }) ParseError
e)
      go (Error ParseError
e) = Reply (CharIndentStream s) u (a, Indentation)
-> m (Reply (CharIndentStream s) u (a, Indentation))
forall (m :: * -> *) a. Monad m => a -> m a
return (ParseError -> Reply (CharIndentStream s) u (a, Indentation)
forall s u a. ParseError -> Reply s u a
Error ParseError
e)
  in ParsecT s u m t -> State s u -> m (Consumed (m (Reply s u t)))
forall (m :: * -> *) s u a.
Monad m =>
ParsecT s u m a -> State s u -> m (Consumed (m (Reply s u a)))
runParsecT ParsecT s u m t
p (State (CharIndentStream s) u
state { stateInput :: s
stateInput = CharIndentStream s -> s
forall s. CharIndentStream s -> s
charIndentStreamStream (State (CharIndentStream s) u -> CharIndentStream s
forall s u. State s u -> s
stateInput State (CharIndentStream s) u
state) })
         m (Consumed (m (Reply s u t)))
-> (Consumed (m (Reply s u t))
    -> m (Consumed
            (m (Reply (CharIndentStream s) u (t, Indentation)))))
-> m (Consumed (m (Reply (CharIndentStream s) u (t, Indentation))))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Reply s u t
 -> m (Consumed
         (m (Reply (CharIndentStream s) u (t, Indentation)))))
-> (Reply s u t
    -> m (Consumed
            (m (Reply (CharIndentStream s) u (t, Indentation)))))
-> Consumed (m (Reply s u t))
-> m (Consumed (m (Reply (CharIndentStream s) u (t, Indentation))))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> (a -> m b) -> Consumed (m a) -> m b
consumed (Consumed (m (Reply (CharIndentStream s) u (t, Indentation)))
-> m (Consumed (m (Reply (CharIndentStream s) u (t, Indentation))))
forall (m :: * -> *) a. Monad m => a -> m a
return (Consumed (m (Reply (CharIndentStream s) u (t, Indentation)))
 -> m (Consumed
         (m (Reply (CharIndentStream s) u (t, Indentation)))))
-> (Reply s u t
    -> Consumed (m (Reply (CharIndentStream s) u (t, Indentation))))
-> Reply s u t
-> m (Consumed (m (Reply (CharIndentStream s) u (t, Indentation))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Reply (CharIndentStream s) u (t, Indentation))
-> Consumed (m (Reply (CharIndentStream s) u (t, Indentation)))
forall a. a -> Consumed a
Consumed (m (Reply (CharIndentStream s) u (t, Indentation))
 -> Consumed (m (Reply (CharIndentStream s) u (t, Indentation))))
-> (Reply s u t
    -> m (Reply (CharIndentStream s) u (t, Indentation)))
-> Reply s u t
-> Consumed (m (Reply (CharIndentStream s) u (t, Indentation)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reply s u t -> m (Reply (CharIndentStream s) u (t, Indentation))
forall (m :: * -> *) s u a.
Monad m =>
Reply s u a -> m (Reply (CharIndentStream s) u (a, Indentation))
go) (Consumed (m (Reply (CharIndentStream s) u (t, Indentation)))
-> m (Consumed (m (Reply (CharIndentStream s) u (t, Indentation))))
forall (m :: * -> *) a. Monad m => a -> m a
return (Consumed (m (Reply (CharIndentStream s) u (t, Indentation)))
 -> m (Consumed
         (m (Reply (CharIndentStream s) u (t, Indentation)))))
-> (Reply s u t
    -> Consumed (m (Reply (CharIndentStream s) u (t, Indentation))))
-> Reply s u t
-> m (Consumed (m (Reply (CharIndentStream s) u (t, Indentation))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Reply (CharIndentStream s) u (t, Indentation))
-> Consumed (m (Reply (CharIndentStream s) u (t, Indentation)))
forall a. a -> Consumed a
Empty (m (Reply (CharIndentStream s) u (t, Indentation))
 -> Consumed (m (Reply (CharIndentStream s) u (t, Indentation))))
-> (Reply s u t
    -> m (Reply (CharIndentStream s) u (t, Indentation)))
-> Reply s u t
-> Consumed (m (Reply (CharIndentStream s) u (t, Indentation)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reply s u t -> m (Reply (CharIndentStream s) u (t, Indentation))
forall (m :: * -> *) s u a.
Monad m =>
Reply s u a -> m (Reply (CharIndentStream s) u (a, Indentation))
go)

{-# INLINE consumed #-}
consumed :: (Monad m) => (a -> m b) -> (a -> m b) -> Consumed (m a) -> m b
consumed :: (a -> m b) -> (a -> m b) -> Consumed (m a) -> m b
consumed a -> m b
c a -> m b
_ (Consumed m a
m) = m a
m m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m b
c
consumed a -> m b
_ a -> m b
e (Empty m a
m)    = m a
m m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m b
e