{-# LANGUAGE  RankNTypes, 
              GADTs,
              MultiParamTypeClasses,
              FunctionalDependencies, 
              FlexibleInstances, 
              FlexibleContexts, 
              UndecidableInstances,
              NoMonomorphismRestriction,
              TypeSynonymInstances,
              ScopedTypeVariables,
              BangPatterns,
              TypeOperators #-}

-- | This module contains basic instances for the class interface described in the "Text.ParserCombinators.UU.Core" module.
--   It demonstates how to construct and maintain a state during parsing. In the state we store error messages, 
--   positional information and the actual input that is being parsed.
--   Unless you have very specific wishes the module can be used as such. 
--   Since we make use of the "Data.ListLike" interface a wide variety of input structures can be handled.

module Text.ParserCombinators.UU.BasicInstances(
-- * Data Types
   Error      (..),
   Str        (..),
   Insertion  (..),
   LineCol    (..),
   LineColPos (..),
-- * Types
   Parser,
   ParserTrafo,
-- * Classes
   IsLocationUpdatedBy,
-- * Functions
   createStr,
   show_expecting,
   pSatisfy,
   pRangeInsert,
   pRange,
   pSymInsert,
   pSym,
   pToken,
   pTokenCost,
   pMunch,
   pMunchL
) where
import Text.ParserCombinators.UU.Core
import Data.Maybe
import Data.Word
-- import Debug.Trace
import qualified Data.ListLike as LL
import Data.List (foldl')

-- *  `Error`
-- |The data type `Error` describes the various kinds of errors which can be generated by the instances in this module
data Error  pos =    Inserted String pos        Strings  
                     -- ^  @String@ was inserted at @pos@-ition, where we expected  @Strings@
                   | Deleted  String pos        Strings
                     -- ^  @String@ was deleted at @pos@-ition, where we expected  @Strings@
                   | Replaced String String pos Strings
                     -- ^ for future use
                   | DeletedAtEnd String
                     -- ^ the unconsumed part of the input was deleted

instance (Show pos) => Show (Error  pos) where 
 show :: Error pos -> String
show (Inserted String
s pos
pos Strings
expecting)       = String
"--    Inserted  " String -> ShowS
forall a. [a] -> [a] -> [a]
++  String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++  pos -> Strings -> String
forall pos. Show pos => pos -> Strings -> String
show_expecting  pos
pos Strings
expecting 
 show (Deleted  String
t pos
pos Strings
expecting)       = String
"--    Deleted   " String -> ShowS
forall a. [a] -> [a] -> [a]
++  String
t String -> ShowS
forall a. [a] -> [a] -> [a]
++  pos -> Strings -> String
forall pos. Show pos => pos -> Strings -> String
show_expecting  pos
pos Strings
expecting
 show (Replaced String
old String
new pos
pos Strings
expecting) = String
"--    Replaced  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
old String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" by "String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
new String -> ShowS
forall a. [a] -> [a] -> [a]
++  pos -> Strings -> String
forall pos. Show pos => pos -> Strings -> String
show_expecting  pos
pos Strings
expecting
 show (DeletedAtEnd String
t)                 = String
"--    The token " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" was not consumed by the parsing process."



show_expecting :: Show pos => pos -> [String] -> String
show_expecting :: pos -> Strings -> String
show_expecting pos
pos [String
a]    = String
" at position " String -> ShowS
forall a. [a] -> [a] -> [a]
++ pos -> String
forall a. Show a => a -> String
show pos
pos String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" expecting " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
a
show_expecting pos
pos (String
a:Strings
as) = String
" at position " String -> ShowS
forall a. [a] -> [a] -> [a]
++ pos -> String
forall a. Show a => a -> String
show pos
pos String -> ShowS
forall a. [a] -> [a] -> [a]
++ 
                            String
" expecting one of [" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ Strings -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (ShowS -> Strings -> Strings
forall a b. (a -> b) -> [a] -> [b]
map (String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++) Strings
as) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
show_expecting pos
pos []     = String
" expecting nothing"

-- * The Stream data type
-- | The data type `Str` holds the input data to be parsed, the current location, the error messages generated 
--   and whether it is ok to delete elements from the input. Since an insert/delete action is 
--   the same as a delete/insert action we try to avoid the first one. 
--   So: no deletes after an insert.

data Str a s loc = Str { -- | the unconsumed part of the input
                         Str a s loc -> s
input    :: s,             
                         -- | the accumulated error messages
                         Str a s loc -> [Error loc]
msgs     :: [Error loc],
                         -- | the current input position  
                         Str a s loc -> loc
pos      :: !loc,
                         -- | we want to avoid deletions after insertions
                         Str a s loc -> Bool
deleteOk :: !Bool         
                       }

-- | A `Parser` is a parser that is prepared to accept "Data.Listlike" input; hence we can deal with @String@'s, @ByteString@'s, etc.
type Parser      a    = forall loc state . (IsLocationUpdatedBy loc Char, LL.ListLike state Char) => P (Str Char state loc) a

-- | A @`ParserTrafo` a b@ maps a @`Parser` a@ onto a @`Parser` b@.
type ParserTrafo a  b = forall loc state . (IsLocationUpdatedBy loc Char, LL.ListLike state Char) => P (Str Char state loc) a ->  P (Str Char state loc) b

-- |  `createStr` initialises the input stream with the input data and the initial position. There are no error messages yet.
createStr :: LL.ListLike s a => loc -> s -> Str a s loc
createStr :: loc -> s -> Str a s loc
createStr loc
beginpos s
ls = s -> [Error loc] -> loc -> Bool -> Str a s loc
forall a s loc. s -> [Error loc] -> loc -> Bool -> Str a s loc
Str s
ls [] loc
beginpos Bool
True


-- The first parameter is the current position, and the second parameter the part which has been removed from the input.
instance IsLocationUpdatedBy Int Char where
   advance :: Int -> Char -> Int
advance !Int
pos Char
_ = Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
   
instance IsLocationUpdatedBy Int Word8 where
   advance :: Int -> Word8 -> Int
advance !Int
pos Word8
_ = Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
   
data LineCol = LineCol !Int !Int deriving Int -> LineCol -> ShowS
[LineCol] -> ShowS
LineCol -> String
(Int -> LineCol -> ShowS)
-> (LineCol -> String) -> ([LineCol] -> ShowS) -> Show LineCol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineCol] -> ShowS
$cshowList :: [LineCol] -> ShowS
show :: LineCol -> String
$cshow :: LineCol -> String
showsPrec :: Int -> LineCol -> ShowS
$cshowsPrec :: Int -> LineCol -> ShowS
Show
instance IsLocationUpdatedBy LineCol Char where
   advance :: LineCol -> Char -> LineCol
advance (LineCol Int
line Int
pos) Char
c = case Char
c of
                                 Char
'\n' ->  Int -> Int -> LineCol
LineCol (Int
lineInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
0
                                 Char
'\t' ->  Int -> Int -> LineCol
LineCol Int
line    ( Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
8)
                                 Char
_    ->  Int -> Int -> LineCol
LineCol Int
line    (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

data LineColPos = LineColPos !Int !Int !Int  deriving Int -> LineColPos -> ShowS
[LineColPos] -> ShowS
LineColPos -> String
(Int -> LineColPos -> ShowS)
-> (LineColPos -> String)
-> ([LineColPos] -> ShowS)
-> Show LineColPos
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineColPos] -> ShowS
$cshowList :: [LineColPos] -> ShowS
show :: LineColPos -> String
$cshow :: LineColPos -> String
showsPrec :: Int -> LineColPos -> ShowS
$cshowsPrec :: Int -> LineColPos -> ShowS
Show
instance IsLocationUpdatedBy LineColPos Char where
   advance :: LineColPos -> Char -> LineColPos
advance (LineColPos Int
line Int
pos Int
abs) Char
c = case Char
c of
                               Char
'\n' ->  Int -> Int -> Int -> LineColPos
LineColPos (Int
lineInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
0                           (Int
abs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) 
                               Char
'\t' ->  Int -> Int -> Int -> LineColPos
LineColPos Int
line     (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
8) (Int
abs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                               Char
_    ->  Int -> Int -> Int -> LineColPos
LineColPos Int
line     (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)                   (Int
abs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

instance IsLocationUpdatedBy loc a => IsLocationUpdatedBy loc [a] where
   advance :: loc -> [a] -> loc
advance  = (loc -> a -> loc) -> loc -> [a] -> loc
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' loc -> a -> loc
forall loc str. IsLocationUpdatedBy loc str => loc -> str -> loc
advance

instance (Show a, LL.ListLike s a) => Eof (Str a s loc) where
       eof :: Str a s loc -> Bool
eof (Str  s
i        [Error loc]
_    loc
_    Bool
_    )              = s -> Bool
forall full item. ListLike full item => full -> Bool
LL.null s
i
       deleteAtEnd :: Str a s loc -> Maybe (Int, Str a s loc)
deleteAtEnd (Str s
s [Error loc]
msgs loc
pos Bool
ok )     | s -> Bool
forall full item. ListLike full item => full -> Bool
LL.null s
s = Maybe (Int, Str a s loc)
forall a. Maybe a
Nothing
                                            | Bool
otherwise = (Int, Str a s loc) -> Maybe (Int, Str a s loc)
forall a. a -> Maybe a
Just (Int
5, s -> [Error loc] -> loc -> Bool -> Str a s loc
forall a s loc. s -> [Error loc] -> loc -> Bool -> Str a s loc
Str (s -> s
forall full item. ListLike full item => full -> full
LL.tail s
s) ([Error loc]
msgs [Error loc] -> [Error loc] -> [Error loc]
forall a. [a] -> [a] -> [a]
++ [String -> Error loc
forall pos. String -> Error pos
DeletedAtEnd (a -> String
forall a. Show a => a -> String
show (s -> a
forall full item. ListLike full item => full -> item
LL.head s
s))]) loc
pos Bool
ok)


instance  StoresErrors (Str a s loc) (Error loc) where
       getErrors :: Str a s loc -> ([Error loc], Str a s loc)
getErrors   (Str  s
inp      [Error loc]
msgs loc
pos Bool
ok    )     = ([Error loc]
msgs, s -> [Error loc] -> loc -> Bool -> Str a s loc
forall a s loc. s -> [Error loc] -> loc -> Bool -> Str a s loc
Str s
inp [] loc
pos Bool
ok)

instance  HasPosition (Str a s loc) loc where
       getPos :: Str a s loc -> loc
getPos   (Str  s
inp      [Error loc]
msgs loc
pos Bool
ok    )        = loc
pos

-- | the @String@ describes what is being inserted, the @a@ parameter the value which is to be inserted and the @cost@ the prices to be paid.
data Insertion a = Insertion  String a Cost

-- | `pSatisfy`  describes and elementary parsing step. Its first parameter check whether the head element of the input can be recognised, 
--    and the second parameter how to proceed in case an element recognised by this parser is absent, 
--    and parsing may proceed by pretending such an element was present in the input anayway.
pSatisfy :: forall loc state a .((Show a,  loc `IsLocationUpdatedBy` a, LL.ListLike state a) => (a -> Bool) -> (Insertion a) -> P (Str  a state loc) a)
pSatisfy :: (a -> Bool) -> Insertion a -> P (Str a state loc) a
pSatisfy a -> Bool
p  (Insertion String
msg  a
a Int
cost) = (forall a.
 (a -> Str a state loc -> Steps a) -> Str a state loc -> Steps a)
-> Nat -> Maybe a -> P (Str a state loc) a
forall token state.
(forall a. (token -> state -> Steps a) -> state -> Steps a)
-> Nat -> Maybe token -> P state token
pSymExt forall a.
(a -> Str a state loc -> Steps a) -> Str a state loc -> Steps a
splitState (Nat -> Nat
Succ (Nat
Zero)) Maybe a
forall a. Maybe a
Nothing
  where  splitState :: forall r. ((a ->  (Str  a state loc)  -> Steps r) ->  (Str  a state loc) -> Steps r)
         splitState :: (a -> Str a state loc -> Steps r) -> Str a state loc -> Steps r
splitState  a -> Str a state loc -> Steps r
k (Str  state
tts   [Error loc]
msgs loc
pos  Bool
del_ok) 
          = String -> Steps r -> Steps r
forall p p. p -> p -> p
show_attempt (String
"Try Predicate: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" at position " String -> ShowS
forall a. [a] -> [a] -> [a]
++ loc -> String
forall a. Show a => a -> String
show loc
pos String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n") (
             let ins :: Strings -> (Int, Steps r)
ins Strings
exp = (Int
cost, a -> Str a state loc -> Steps r
k a
a (state -> [Error loc] -> loc -> Bool -> Str a state loc
forall a s loc. s -> [Error loc] -> loc -> Bool -> Str a s loc
Str state
tts ([Error loc]
msgs [Error loc] -> [Error loc] -> [Error loc]
forall a. [a] -> [a] -> [a]
++ [String -> loc -> Strings -> Error loc
forall pos. String -> pos -> Strings -> Error pos
Inserted (a -> String
forall a. Show a => a -> String
show a
a)  loc
pos  Strings
exp]) loc
pos  Bool
False))
             in if   state -> Bool
forall full item. ListLike full item => full -> Bool
LL.null state
tts 
                then Strings -> [Strings -> (Int, Steps r)] -> Steps r
forall a. Strings -> [Strings -> (Int, Steps a)] -> Steps a
Fail [String
msg] [Strings -> (Int, Steps r)
ins]
                else let t :: a
t       = state -> a
forall full item. ListLike full item => full -> item
LL.head state
tts
                         ts :: state
ts      = state -> state
forall full item. ListLike full item => full -> full
LL.tail state
tts
                         del :: Strings -> (Int, Steps r)
del Strings
exp = (Int
4, (a -> Str a state loc -> Steps r) -> Str a state loc -> Steps r
forall a.
(a -> Str a state loc -> Steps a) -> Str a state loc -> Steps a
splitState a -> Str a state loc -> Steps r
k (state -> [Error loc] -> loc -> Bool -> Str a state loc
forall a s loc. s -> [Error loc] -> loc -> Bool -> Str a s loc
Str state
ts ([Error loc]
msgs [Error loc] -> [Error loc] -> [Error loc]
forall a. [a] -> [a] -> [a]
++ [String -> loc -> Strings -> Error loc
forall pos. String -> pos -> Strings -> Error pos
Deleted  (a -> String
forall a. Show a => a -> String
show a
t)  loc
pos  Strings
exp]) (loc -> a -> loc
forall loc str. IsLocationUpdatedBy loc str => loc -> str -> loc
advance loc
pos a
t) Bool
True ))
                     in if a -> Bool
p a
t
                        then  String -> Steps r -> Steps r
forall b. String -> b -> b
show_symbol (String
"Accepting symbol: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" at position: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ loc -> String
forall a. Show a => a -> String
show loc
pos String -> ShowS
forall a. [a] -> [a] -> [a]
++String
"\n") 
                              (Int -> Steps r -> Steps r
forall a. Int -> Steps a -> Steps a
Step Int
1 (a -> Str a state loc -> Steps r
k a
t (state -> [Error loc] -> loc -> Bool -> Str a state loc
forall a s loc. s -> [Error loc] -> loc -> Bool -> Str a s loc
Str state
ts [Error loc]
msgs (loc -> a -> loc
forall loc str. IsLocationUpdatedBy loc str => loc -> str -> loc
advance loc
pos a
t) Bool
True)))
                        else  Strings -> [Strings -> (Int, Steps r)] -> Steps r
forall a. Strings -> [Strings -> (Int, Steps a)] -> Steps a
Fail [String
msg] (Strings -> (Int, Steps r)
ins(Strings -> (Int, Steps r))
-> [Strings -> (Int, Steps r)] -> [Strings -> (Int, Steps r)]
forall a. a -> [a] -> [a]
: if Bool
del_ok then [Strings -> (Int, Steps r)
del] else [])
            )
-- | `pRangeInsert` recognises an element between a lower and an upper bound. Furthermore it can be specified what element 
--   is to be inserted in case such an element is not at the head of the input.
pRangeInsert :: (Ord a, Show a, IsLocationUpdatedBy loc a, LL.ListLike state a) => (a, a) -> Insertion a -> P (Str a state loc) a
pRangeInsert :: (a, a) -> Insertion a -> P (Str a state loc) a
pRangeInsert (a
low, a
high)  = (a -> Bool) -> Insertion a -> P (Str a state loc) a
forall loc state a.
(Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
(a -> Bool) -> Insertion a -> P (Str a state loc) a
pSatisfy (\ a
t -> a
low a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
t Bool -> Bool -> Bool
&& a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
high)  

-- | `pRange` uses the information from the bounds to compute the `Insertion` information.
pRange ::  (Ord a, Show a, IsLocationUpdatedBy loc a, LL.ListLike state a) => (a, a) -> P (Str a state loc) a
pRange :: (a, a) -> P (Str a state loc) a
pRange lh :: (a, a)
lh@(a
low, a
high) = (a, a) -> Insertion a -> P (Str a state loc) a
forall a loc state.
(Ord a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
(a, a) -> Insertion a -> P (Str a state loc) a
pRangeInsert (a, a)
lh (String -> a -> Int -> Insertion a
forall a. String -> a -> Int -> Insertion a
Insertion (a -> String
forall a. Show a => a -> String
show a
low String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".." String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
high) a
low Int
5)


-- | `pSymInsert` recognises a specific element. Furthermore it can be specified what element 
--   is to be inserted in case such an element is not at the head of the input.
pSymInsert  :: (Eq a,Show a, IsLocationUpdatedBy loc a, LL.ListLike state a) => a -> Insertion a -> P (Str a state loc) a
pSymInsert :: a -> Insertion a -> P (Str a state loc) a
pSymInsert  a
t  = (a -> Bool) -> Insertion a -> P (Str a state loc) a
forall loc state a.
(Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
(a -> Bool) -> Insertion a -> P (Str a state loc) a
pSatisfy (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
t) 

-- | `pSym` recognises a specific element. Furthermore it can be specified what element. Information about `Insertion` is derived from the parameter.
--   is to be inserted in case such an element is not at the head of the input.
pSym ::   (Eq a,Show a, IsLocationUpdatedBy loc a, LL.ListLike state a) => a ->  P (Str a state loc) a    
pSym :: a -> P (Str a state loc) a
pSym  a
t = a -> Insertion a -> P (Str a state loc) a
forall a loc state.
(Eq a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
a -> Insertion a -> P (Str a state loc) a
pSymInsert a
t (String -> a -> Int -> Insertion a
forall a. String -> a -> Int -> Insertion a
Insertion (a -> String
forall a. Show a => a -> String
show a
t) a
t Int
5)

-- | `pMunchL` recognises the longest prefix of the input for which the passed predicate holds. The message parameter is used when tracing has been switched on. 
pMunchL :: forall loc state a .((Show a,  loc `IsLocationUpdatedBy` a, LL.ListLike state a) => (a -> Bool) -> String -> P (Str  a state loc) [a])
pMunchL :: (a -> Bool) -> String -> P (Str a state loc) [a]
pMunchL a -> Bool
p String
msg = (forall a.
 ([a] -> Str a state loc -> Steps a) -> Str a state loc -> Steps a)
-> Nat -> Maybe [a] -> P (Str a state loc) [a]
forall token state.
(forall a. (token -> state -> Steps a) -> state -> Steps a)
-> Nat -> Maybe token -> P state token
pSymExt forall a.
([a] -> Str a state loc -> Steps a) -> Str a state loc -> Steps a
splitState Nat
Zero Maybe [a]
forall a. Maybe a
Nothing
  where  splitState :: forall r. (([a] ->  (Str  a state loc)  -> Steps r) ->  (Str  a state loc) -> Steps r)
         splitState :: ([a] -> Str a state loc -> Steps r) -> Str a state loc -> Steps r
splitState [a] -> Str a state loc -> Steps r
k inp :: Str a state loc
inp@(Str state
tts [Error loc]
msgs loc
pos Bool
del_ok)
          =    String -> Steps r -> Steps r
forall p p. p -> p -> p
show_attempt (String
"Try Munch: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n") (
               let (state
fmunch, state
rest)  = (a -> Bool) -> state -> (state, state)
forall full item.
ListLike full item =>
(item -> Bool) -> full -> (full, full)
LL.span a -> Bool
p state
tts
                   munched :: [Item state]
munched         = state -> [Item state]
forall l. IsList l => l -> [Item l]
LL.toList state
fmunch
                   l :: Int
l               = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
[Item state]
munched
               in if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then String -> Steps r -> Steps r
forall b. String -> b -> b
show_munch (String
"Accepting munch: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => a -> String
show [a]
[Item state]
munched String -> ShowS
forall a. [a] -> [a] -> [a]
++  loc -> String
forall a. Show a => a -> String
show loc
pos String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n") 
                                (Int -> Steps r -> Steps r
forall a. Int -> Steps a -> Steps a
Step Int
l ([a] -> Str a state loc -> Steps r
k [a]
[Item state]
munched (state -> [Error loc] -> loc -> Bool -> Str a state loc
forall a s loc. s -> [Error loc] -> loc -> Bool -> Str a s loc
Str state
rest [Error loc]
msgs (loc -> [a] -> loc
forall loc str. IsLocationUpdatedBy loc str => loc -> str -> loc
advance loc
pos [a]
[Item state]
munched)  (Int
lInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0 Bool -> Bool -> Bool
|| Bool
del_ok))))
                           else String -> Steps r -> Steps r
forall b. String -> b -> b
show_munch (String
"Accepting munch: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" as emtty munch " String -> ShowS
forall a. [a] -> [a] -> [a]
++ loc -> String
forall a. Show a => a -> String
show loc
pos String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n") ([a] -> Str a state loc -> Steps r
k [] Str a state loc
inp)
               )

-- | `pMunch` recognises the longest prefix of the input for which the passed predicate holds.  
pMunch :: forall loc state a .((Show a,  loc `IsLocationUpdatedBy` a, LL.ListLike state a) => (a -> Bool)  -> P (Str  a state loc) [a])
pMunch :: (a -> Bool) -> P (Str a state loc) [a]
pMunch  a -> Bool
p   = (a -> Bool) -> String -> P (Str a state loc) [a]
forall loc state a.
(Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
(a -> Bool) -> String -> P (Str a state loc) [a]
pMunchL a -> Bool
p String
""

-- | `pTokenCost` succeeds if its parameter is a prefix of the input. 
pTokenCost :: forall loc state a .((Show a, Eq a,  loc `IsLocationUpdatedBy` a, LL.ListLike state a) => [a] -> Int -> P (Str  a state loc) [a])
pTokenCost :: [a] -> Int -> P (Str a state loc) [a]
pTokenCost [a]
as Int
cost = 
  if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
as then String -> P (Str a state loc) [a]
forall a. HasCallStack => String -> a
error String
"Module: BasicInstances, function: pTokenCost; call  with empty token"
             else (forall a.
 ([a] -> Str a state loc -> Steps a) -> Str a state loc -> Steps a)
-> Nat -> Maybe [a] -> P (Str a state loc) [a]
forall token state.
(forall a. (token -> state -> Steps a) -> state -> Steps a)
-> Nat -> Maybe token -> P state token
pSymExt forall a.
([a] -> Str a state loc -> Steps a) -> Str a state loc -> Steps a
splitState ([a] -> Nat
forall a. [a] -> Nat
nat_length [a]
as) Maybe [a]
forall a. Maybe a
Nothing
  where   tas :: state 
          tas :: state
tas = [Item state] -> state
forall l. IsList l => [Item l] -> l
LL.fromList [a]
[Item state]
as
          nat_length :: [a] -> Nat
nat_length [] = Nat
Zero 
          nat_length (a
_:[a]
as) = Nat -> Nat
Succ ([a] -> Nat
nat_length [a]
as)
          l :: Int
l = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
as
          msg :: String
msg = [a] -> String
forall a. Show a => a -> String
show [a]
as 
          splitState :: forall r. (([a] ->  (Str  a state loc)  -> Steps r) ->  (Str  a state loc) -> Steps r)
          splitState :: ([a] -> Str a state loc -> Steps r) -> Str a state loc -> Steps r
splitState [a] -> Str a state loc -> Steps r
k inp :: Str a state loc
inp@(Str state
tts [Error loc]
msgs loc
pos Bool
del_ok)
             = String -> Steps r -> Steps r
forall p p. p -> p -> p
show_attempt (String
"Try Token: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => a -> String
show [a]
as String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n") (
                      if state -> state -> Bool
forall full item.
(ListLike full item, Eq item) =>
full -> full -> Bool
LL.isPrefixOf state
tas state
tts
                      then  String -> Steps r -> Steps r
forall b. String -> b -> b
show_tokens (String
"Accepting token: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => a -> String
show [a]
as String -> ShowS
forall a. [a] -> [a] -> [a]
++String
"\n") 
                                      (Int -> Steps r -> Steps r
forall a. Int -> Steps a -> Steps a
Step Int
l ([a] -> Str a state loc -> Steps r
k [a]
as (state -> [Error loc] -> loc -> Bool -> Str a state loc
forall a s loc. s -> [Error loc] -> loc -> Bool -> Str a s loc
Str (Int -> state -> state
forall full item. ListLike full item => Int -> full -> full
LL.drop Int
l state
tts)  [Error loc]
msgs (loc -> [a] -> loc
forall loc str. IsLocationUpdatedBy loc str => loc -> str -> loc
advance loc
pos [a]
as) Bool
True)))
                      else  let ins :: Strings -> (Int, Steps r)
ins Strings
exp =  (Int
cost, [a] -> Str a state loc -> Steps r
k [a]
as (state -> [Error loc] -> loc -> Bool -> Str a state loc
forall a s loc. s -> [Error loc] -> loc -> Bool -> Str a s loc
Str state
tts ([Error loc]
msgs [Error loc] -> [Error loc] -> [Error loc]
forall a. [a] -> [a] -> [a]
++ [String -> loc -> Strings -> Error loc
forall pos. String -> pos -> Strings -> Error pos
Inserted String
msg loc
pos Strings
exp]) loc
pos Bool
False))
                            in if state -> Bool
forall full item. ListLike full item => full -> Bool
LL.null state
tts 
                               then  Strings -> [Strings -> (Int, Steps r)] -> Steps r
forall a. Strings -> [Strings -> (Int, Steps a)] -> Steps a
Fail [String
msg] [Strings -> (Int, Steps r)
ins]
                               else  let t :: a
t       = state -> a
forall full item. ListLike full item => full -> item
LL.head state
tts
                                         ts :: state
ts      = state -> state
forall full item. ListLike full item => full -> full
LL.tail state
tts
                                         del :: Strings -> (Int, Steps r)
del Strings
exp =  (Int
5, ([a] -> Str a state loc -> Steps r) -> Str a state loc -> Steps r
forall a.
([a] -> Str a state loc -> Steps a) -> Str a state loc -> Steps a
splitState  [a] -> Str a state loc -> Steps r
k 
                                                            (state -> [Error loc] -> loc -> Bool -> Str a state loc
forall a s loc. s -> [Error loc] -> loc -> Bool -> Str a s loc
Str state
ts ([Error loc]
msgs [Error loc] -> [Error loc] -> [Error loc]
forall a. [a] -> [a] -> [a]
++ [String -> loc -> Strings -> Error loc
forall pos. String -> pos -> Strings -> Error pos
Deleted  (a -> String
forall a. Show a => a -> String
show a
t) loc
pos Strings
exp]) 
                                                            (loc -> a -> loc
forall loc str. IsLocationUpdatedBy loc str => loc -> str -> loc
advance loc
pos a
t) Bool
True))
                                     in  Strings -> [Strings -> (Int, Steps r)] -> Steps r
forall a. Strings -> [Strings -> (Int, Steps a)] -> Steps a
Fail [String
msg] (Strings -> (Int, Steps r)
ins(Strings -> (Int, Steps r))
-> [Strings -> (Int, Steps r)] -> [Strings -> (Int, Steps r)]
forall a. a -> [a] -> [a]
: if Bool
del_ok then [Strings -> (Int, Steps r)
del] else [])
                      
                     )
pToken ::  forall loc state a .((Show a, Eq a,  loc `IsLocationUpdatedBy` a, LL.ListLike state a) => [a] -> P (Str  a state loc) [a])
pToken :: [a] -> P (Str a state loc) [a]
pToken     [a]
as   =   [a] -> Int -> P (Str a state loc) [a]
forall loc state a.
(Show a, Eq a, IsLocationUpdatedBy loc a, ListLike state a) =>
[a] -> Int -> P (Str a state loc) [a]
pTokenCost [a]
as Int
10

{-# INLINE show_tokens #-}

show_tokens :: String -> b -> b
show_tokens :: String -> b -> b
show_tokens String
m b
v =  {-  trace m -}   b
v

{-# INLINE show_munch #-}
show_munch :: String -> b -> b
show_munch :: String -> b -> b
show_munch  String
m b
v =   {- trace m -}  b
v

{-# INLINE show_symbol #-}
show_symbol :: String -> b -> b
show_symbol :: String -> b -> b
show_symbol String
m b
v =   {- trace m -}  b
v
-- show_symbol m v =     trace m   v
{-# INLINE show_attempt #-}
show_attempt :: p -> p -> p
show_attempt p
m p
v =  {- trace m -}  p
v