{-# OPTIONS_HADDOCK  ignore-exports #-}
{-# LANGUAGE  FlexibleInstances,
              TypeSynonymInstances,
              MultiParamTypeClasses,
              Rank2Types, FlexibleContexts, NoMonomorphismRestriction,
              CPP  #-}

-- | This module contains a lot of examples of the typical use of our parser combinator library. 
--   We strongly encourage you to take a look at the source code.
--   At the end you find a @`main`@ function which demonstrates the main characteristics. 
--   Only the @`run`@ function is exported since it may come in handy elsewhere.

module Text.ParserCombinators.UU.Demo.Examples  where
import Data.Char
import Text.ParserCombinators.UU
import Text.ParserCombinators.UU.Utils
import Text.ParserCombinators.UU.BasicInstances hiding (Parser)
import System.IO
import GHC.IO.Handle.Types
import qualified Data.ListLike as LL

-- import Control.Monad

#define DEMO(p,i) demo "p" i p

type Parser a = P (Str Char String LineColPos) a

justamessage :: [Char]
justamessage = [Char]
"justamessage"

-- | Running the function `show_demos` should give the following output:
--
-- >>>   run pa  "a"
--  Result: "a"
-- 
-- >>>   run pa  ""
--  Result: "a"
--  Correcting steps: 
--    Inserted  'a' at position LineColPos 0 0 0 expecting 'a'
-- 
-- >>>   run pa  "b"
--  Result: "a"
--  Correcting steps: 
--    Deleted   'b' at position LineColPos 0 0 0 expecting 'a'
--    Inserted  'a' at position LineColPos 0 1 1 expecting 'a'
-- 
-- >>>   run ((++) <$> pa <*> pa)  "bbab"
--  Result: "aa"
--  Correcting steps: 
--    Deleted   'b' at position LineColPos 0 0 0 expecting 'a'
--    Deleted   'b' at position LineColPos 0 1 1 expecting 'a'
--    Deleted   'b' at position LineColPos 0 3 3 expecting 'a'
--    Inserted  'a' at position LineColPos 0 4 4 expecting 'a'
-- 
-- >>>   run pa  "ba"
--  Result: "a"
--  Correcting steps: 
--    Deleted   'b' at position LineColPos 0 0 0 expecting 'a'
-- 
-- >>>   run pa  "aa"
--  Result: "a"
--  Correcting steps: 
--    The token 'a' was not consumed by the parsing process.
-- 
-- >>>   run (pCount pa :: Parser Int)  "aaa"
--  Result: 3
-- 
-- >>>   run (do  {l <- pCount pa; pExact l pb})  "aaacabbbbb"
--  Result: ["b","b","b","b"]
--  Correcting steps: 
--    Deleted   'c' at position LineColPos 0 3 3 expecting one of ['b', 'a']
--    The token 'b' was not consumed by the parsing process.
-- 
-- >>>   run (amb ( (++) <$> pa2 <*> pa3 <|> (++) <$> pa3 <*> pa2))  "aaaaa"
--  Result: ["aaaaa","aaaaa"]
-- 
-- >>>   run (pList pLower)  "doaitse"
--  Result: "doaitse"
-- 
-- >>>   run paz  "abc2ez"
--  Result: "abcez"
--  Correcting steps: 
--    Deleted   '2' at position LineColPos 0 3 3 expecting 'a'..'z'
-- 
-- >>>   run (max <$> pParens ((+1) <$> wfp) <*> wfp `opt` 0)  "((()))()(())"
--  Result: 3
-- 
-- >>>   run (pa <|> pb <?> justamessage)  "c"
--  Result: "b"
--  Correcting steps: 
--    Deleted   'c' at position LineColPos 0 0 0 expecting justamessage
--    Inserted  'b' at position LineColPos 0 1 1 expecting 'b'
-- 
-- >>>   run (amb (pEither  parseIntString  pIntList))  "(123;456;789)"
--  Result: [Left ["123","456","789"],Right [123,456,789]]
-- 
show_demos :: IO ()
show_demos :: IO ()
show_demos = 
       do [Char] -> [Char] -> P (Str Char [Char] LineColPos) [Char] -> IO ()
forall r.
Show r =>
[Char] -> [Char] -> P (Str Char [Char] LineColPos) r -> IO ()
DEMO(pa,  "a")
          [Char] -> [Char] -> P (Str Char [Char] LineColPos) [Char] -> IO ()
forall r.
Show r =>
[Char] -> [Char] -> P (Str Char [Char] LineColPos) r -> IO ()
DEMO(pa,  "" )
          [Char] -> [Char] -> P (Str Char [Char] LineColPos) [Char] -> IO ()
forall r.
Show r =>
[Char] -> [Char] -> P (Str Char [Char] LineColPos) r -> IO ()
DEMO(pa,  "b")
          [Char] -> [Char] -> P (Str Char [Char] LineColPos) [Char] -> IO ()
forall r.
Show r =>
[Char] -> [Char] -> P (Str Char [Char] LineColPos) r -> IO ()
DEMO(((++) <$> pa <*> pa), "bbab")
          [Char] -> [Char] -> P (Str Char [Char] LineColPos) [Char] -> IO ()
forall r.
Show r =>
[Char] -> [Char] -> P (Str Char [Char] LineColPos) r -> IO ()
DEMO(pa,  "ba")
          [Char] -> [Char] -> P (Str Char [Char] LineColPos) [Char] -> IO ()
forall r.
Show r =>
[Char] -> [Char] -> P (Str Char [Char] LineColPos) r -> IO ()
DEMO(pa,  "aa")
          [Char] -> [Char] -> P (Str Char [Char] LineColPos) Int -> IO ()
forall r.
Show r =>
[Char] -> [Char] -> P (Str Char [Char] LineColPos) r -> IO ()
DEMO((pCount pa :: Parser Int),                                 "aaa")
          [Char]
-> [Char] -> P (Str Char [Char] LineColPos) [[Char]] -> IO ()
forall r.
Show r =>
[Char] -> [Char] -> P (Str Char [Char] LineColPos) r -> IO ()
DEMO((do  {l <- pCount pa; pExact l pb}),                       "aaacabbbbb")
          [Char]
-> [Char] -> P (Str Char [Char] LineColPos) [[Char]] -> IO ()
forall r.
Show r =>
[Char] -> [Char] -> P (Str Char [Char] LineColPos) r -> IO ()
DEMO((amb ( (++) <$> pa2 <*> pa3 <|> (++) <$> pa3 <*> pa2)),    "aaaaa")
          [Char] -> [Char] -> P (Str Char [Char] LineColPos) [Char] -> IO ()
forall r.
Show r =>
[Char] -> [Char] -> P (Str Char [Char] LineColPos) r -> IO ()
DEMO((pList pLower),                                            "doaitse")
          [Char] -> [Char] -> P (Str Char [Char] LineColPos) [Char] -> IO ()
forall r.
Show r =>
[Char] -> [Char] -> P (Str Char [Char] LineColPos) r -> IO ()
DEMO(paz,                                                       "abc2ez")
          [Char] -> [Char] -> P (Str Char [Char] LineColPos) Int -> IO ()
forall r.
Show r =>
[Char] -> [Char] -> P (Str Char [Char] LineColPos) r -> IO ()
DEMO((max <$> pParens ((+1) <$> wfp) <*> wfp `opt` 0),          "((()))()(())")
          [Char] -> [Char] -> P (Str Char [Char] LineColPos) [Char] -> IO ()
forall r.
Show r =>
[Char] -> [Char] -> P (Str Char [Char] LineColPos) r -> IO ()
DEMO((pa <|> pb <?> justamessage),                              "c")
          [Char]
-> [Char]
-> P (Str Char [Char] LineColPos) [Either [[Char]] [Int]]
-> IO ()
forall r.
Show r =>
[Char] -> [Char] -> P (Str Char [Char] LineColPos) r -> IO ()
DEMO((amb (pEither  parseIntString  pIntList)),                 "(123;456;789)")
--          DEMO((pa *> pMunch ( `elem` "^=*") <* pb),                      "a^=^**^^b")

-- | The fuction @`run`@ runs the parser and shows both the result, and the correcting steps which were taken during the parsing process.
run :: Show t =>  Parser t -> String -> IO ()
run :: Parser t -> [Char] -> IO ()
run Parser t
p [Char]
inp = do  let r :: (t, [Error LineColPos])
r@(t
a, [Error LineColPos]
errors) =  P (Str Char [Char] LineColPos) (t, [Error LineColPos])
-> Str Char [Char] LineColPos -> (t, [Error LineColPos])
forall t a. Eof t => P t a -> t -> a
parse ( (,) (t -> [Error LineColPos] -> (t, [Error LineColPos]))
-> Parser t
-> P (Str Char [Char] LineColPos)
     ([Error LineColPos] -> (t, [Error LineColPos]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser t
p P (Str Char [Char] LineColPos)
  ([Error LineColPos] -> (t, [Error LineColPos]))
-> P (Str Char [Char] LineColPos) [Error LineColPos]
-> P (Str Char [Char] LineColPos) (t, [Error LineColPos])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P (Str Char [Char] LineColPos) [Error LineColPos]
forall st error. (StoresErrors st error, Eof st) => P st [error]
pEnd) (LineColPos -> [Char] -> Str Char [Char] LineColPos
forall s a loc. ListLike s a => loc -> s -> Str a s loc
createStr (Int -> Int -> Int -> LineColPos
LineColPos Int
0 Int
0 Int
0) [Char]
inp)
                [Char] -> IO ()
putStrLn ([Char]
"--  Result: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ t -> [Char]
forall a. Show a => a -> [Char]
show t
a)
                if [Error LineColPos] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Error LineColPos]
errors then  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                               else  do [Char] -> IO ()
putStr ([Char]
"--  Correcting steps: \n")
                                        [Error LineColPos] -> IO ()
forall a. Show a => [a] -> IO ()
show_errors [Error LineColPos]
errors
                [Char] -> IO ()
putStrLn [Char]
"-- "
             where show_errors :: (Show a) => [a] -> IO ()
                   show_errors :: [a] -> IO ()
show_errors = [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([IO ()] -> IO ()) -> ([a] -> [IO ()]) -> [a] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> IO ()) -> [a] -> [IO ()]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (a -> [Char]) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
forall a. Show a => a -> [Char]
show))
run' :: P (Str (Item s) s LineColPos) a -> s -> IO ()
run' P (Str (Item s) s LineColPos) a
p s
inp = do let r :: (a, [Error LineColPos])
r@(a
a, [Error LineColPos]
errors) =  P (Str (Item s) s LineColPos) (a, [Error LineColPos])
-> Str (Item s) s LineColPos -> (a, [Error LineColPos])
forall t a. Eof t => P t a -> t -> a
parse ( (,) (a -> [Error LineColPos] -> (a, [Error LineColPos]))
-> P (Str (Item s) s LineColPos) a
-> P (Str (Item s) s LineColPos)
     ([Error LineColPos] -> (a, [Error LineColPos]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (Str (Item s) s LineColPos) a
p P (Str (Item s) s LineColPos)
  ([Error LineColPos] -> (a, [Error LineColPos]))
-> P (Str (Item s) s LineColPos) [Error LineColPos]
-> P (Str (Item s) s LineColPos) (a, [Error LineColPos])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P (Str (Item s) s LineColPos) [Error LineColPos]
forall st error. (StoresErrors st error, Eof st) => P st [error]
pEnd) (LineColPos -> s -> Str (Item s) s LineColPos
forall s a loc. ListLike s a => loc -> s -> Str a s loc
createStr (Int -> Int -> Int -> LineColPos
LineColPos Int
0 Int
0 Int
0) s
inp)
                if [Error LineColPos] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Error LineColPos]
errors then  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                      else  do [Char] -> IO ()
putStr ([Char]
"--  Correcting steps: \n")
                               [Error LineColPos] -> IO ()
forall a. Show a => [a] -> IO ()
show_errors [Error LineColPos]
errors               
                [Char] -> IO ()
putStrLn ([Char]
"--  Result: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
a)                
                [Char] -> IO ()
putStrLn [Char]
"-- "
             where show_errors :: (Show a) => [a] -> IO ()
                   show_errors :: [a] -> IO ()
show_errors = [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([IO ()] -> IO ()) -> ([a] -> [IO ()]) -> [a] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> IO ()) -> [a] -> [IO ()]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> IO ()
putStrLn ([Char] -> IO ()) -> (a -> [Char]) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
forall a. Show a => a -> [Char]
show))

-- | Our first two parsers are simple; one recognises a single 'a' character and the other one a single 'b'. Since we will use them later we 
--   convert the recognised character into `String` so they can be easily combined.
pa  ::Parser String 
pa :: P (Str Char [Char] LineColPos) [Char]
pa  = Char -> [Char]
forall a. a -> [a]
lift (Char -> [Char])
-> P (Str Char [Char] LineColPos) Char
-> P (Str Char [Char] LineColPos) [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> P (Str Char [Char] LineColPos) Char
forall a loc state.
(Eq a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
a -> P (Str a state loc) a
pSym Char
'a'
pb  :: Parser String 
pb :: P (Str Char [Char] LineColPos) [Char]
pb = Char -> [Char]
forall a. a -> [a]
lift (Char -> [Char])
-> P (Str Char [Char] LineColPos) Char
-> P (Str Char [Char] LineColPos) [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> P (Str Char [Char] LineColPos) Char
forall a loc state.
(Eq a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
a -> P (Str a state loc) a
pSym Char
'b'
pc  :: Parser String 
pc :: P (Str Char [Char] LineColPos) [Char]
pc = Char -> [Char]
forall a. a -> [a]
lift (Char -> [Char])
-> P (Str Char [Char] LineColPos) Char
-> P (Str Char [Char] LineColPos) [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> P (Str Char [Char] LineColPos) Char
forall a loc state.
(Eq a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
a -> P (Str a state loc) a
pSym Char
'c'
lift :: a -> [a]
lift a
a = [a
a]

(<++>) :: Parser String -> Parser String -> Parser String
P (Str Char [Char] LineColPos) [Char]
p <++> :: P (Str Char [Char] LineColPos) [Char]
-> P (Str Char [Char] LineColPos) [Char]
-> P (Str Char [Char] LineColPos) [Char]
<++> P (Str Char [Char] LineColPos) [Char]
q = [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
(++) ([Char] -> [Char] -> [Char])
-> P (Str Char [Char] LineColPos) [Char]
-> P (Str Char [Char] LineColPos) ([Char] -> [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (Str Char [Char] LineColPos) [Char]
p P (Str Char [Char] LineColPos) ([Char] -> [Char])
-> P (Str Char [Char] LineColPos) [Char]
-> P (Str Char [Char] LineColPos) [Char]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P (Str Char [Char] LineColPos) [Char]
q
pa2 :: P (Str Char [Char] LineColPos) [Char]
pa2 =   P (Str Char [Char] LineColPos) [Char]
pa P (Str Char [Char] LineColPos) [Char]
-> P (Str Char [Char] LineColPos) [Char]
-> P (Str Char [Char] LineColPos) [Char]
<++> P (Str Char [Char] LineColPos) [Char]
pa
pa3 :: P (Str Char [Char] LineColPos) [Char]
pa3 =   P (Str Char [Char] LineColPos) [Char]
pa P (Str Char [Char] LineColPos) [Char]
-> P (Str Char [Char] LineColPos) [Char]
-> P (Str Char [Char] LineColPos) [Char]
<++> P (Str Char [Char] LineColPos) [Char]
pa2

paz :: Parser String
paz :: P (Str Char [Char] LineColPos) [Char]
paz = P (Str Char [Char] LineColPos) Char
-> P (Str Char [Char] LineColPos) [Char]
forall (p :: * -> *) a. IsParser p => p a -> p [a]
pList ((Char -> Bool)
-> Insertion Char -> P (Str Char [Char] LineColPos) Char
forall loc state a.
(Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
(a -> Bool) -> Insertion a -> P (Str a state loc) a
pSatisfy (\Char
t -> Char
'a' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
t Bool -> Bool -> Bool
&& Char
t Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z') ([Char] -> Char -> Int -> Insertion Char
forall a. [Char] -> a -> Int -> Insertion a
Insertion [Char]
"'a'..'z'" Char
'k' Int
5)) 

-- | The applicative style makes it very easy to merge recogition and computing a result. 
--   As an example we parse a sequence of nested well formed parentheses pairs and
--   compute the maximum nesting depth with @`wfp`@: 
wfp :: Parser Int
wfp :: P (Str Char [Char] LineColPos) Int
wfp =  Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int -> Int -> Int)
-> P (Str Char [Char] LineColPos) Int
-> P (Str Char [Char] LineColPos) (Int -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (Str Char [Char] LineColPos) Int
-> P (Str Char [Char] LineColPos) Int
forall a. ParserTrafo a a
pParens ((Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> Int)
-> P (Str Char [Char] LineColPos) Int
-> P (Str Char [Char] LineColPos) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (Str Char [Char] LineColPos) Int
wfp) P (Str Char [Char] LineColPos) (Int -> Int)
-> P (Str Char [Char] LineColPos) Int
-> P (Str Char [Char] LineColPos) Int
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P (Str Char [Char] LineColPos) Int
wfp P (Str Char [Char] LineColPos) Int
-> Int -> P (Str Char [Char] LineColPos) Int
forall (p :: * -> *) a. ExtAlternative p => p a -> a -> p a
`opt` Int
0

-- | It is very easy to recognise infix expressions with any number of priorities and operators:
--
-- > operators       = [[('+', (+)), ('-', (-))],  [('*' , (*))], [('^', (^))]]
-- > same_prio  ops  = msum [ op <$ pSym c | (c, op) <- ops]
-- > expr            = foldr pChainl ( pNatural <|> pParens expr) (map same_prio operators) -- 
--
-- which we can call:  
--
-- > run expr "15-3*5+2^5"
--
-- > Result: 32
--
-- Note that also here correction takes place: 
--
-- > run expr "2 + + 3 5"
--
-- > Result: 37
-- > Correcting steps: 
-- >    Deleted  ' ' at position 1 expecting one of ['0'..'9', '^', '*', '-', '+']
-- >    Deleted  ' ' at position 3 expecting one of ['(', '0'..'9']
-- >    Inserted '0' at position 4 expecting '0'..'9'
-- >    Deleted  ' ' at position 5 expecting one of ['(', '0'..'9']
-- >    Deleted  ' ' at position 7 expecting one of ['0'..'9', '^', '*', '-', '+']
-- 


test11 :: IO ()
test11 = P (Str Char [Char] LineColPos) Int -> [Char] -> IO ()
forall t. Show t => Parser t -> [Char] -> IO ()
run P (Str Char [Char] LineColPos) Int
expr [Char]
"15-3*5"
expr :: Parser Int
operators :: [[(Char, a -> a -> a)]]
operators       = [[(Char
'+', a -> a -> a
forall a. Num a => a -> a -> a
(+)), (Char
'-', (-))],  [(Char
'*' , a -> a -> a
forall a. Num a => a -> a -> a
(*))], [(Char
'^', a -> a -> a
forall a b. (Num a, Integral b) => a -> b -> a
(^))]]
same_prio :: [(Item state, a)] -> P (Str (Item state) state loc) a
same_prio  [(Item state, a)]
ops  = (P (Str (Item state) state loc) a
 -> P (Str (Item state) state loc) a
 -> P (Str (Item state) state loc) a)
-> P (Str (Item state) state loc) a
-> [P (Str (Item state) state loc) a]
-> P (Str (Item state) state loc) a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr P (Str (Item state) state loc) a
-> P (Str (Item state) state loc) a
-> P (Str (Item state) state loc) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) P (Str (Item state) state loc) a
forall (f :: * -> *) a. Alternative f => f a
empty [ a
op a
-> P (Str (Item state) state loc) (Item state)
-> P (Str (Item state) state loc) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Item state -> P (Str (Item state) state loc) (Item state)
forall a loc state.
(Eq a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
a -> P (Str a state loc) a
pSym Item state
c | (Item state
c, a
op) <- [(Item state, a)]
ops]
expr :: P (Str Char [Char] LineColPos) Int
expr            = (P (Str Char [Char] LineColPos) (Int -> Int -> Int)
 -> P (Str Char [Char] LineColPos) Int
 -> P (Str Char [Char] LineColPos) Int)
-> P (Str Char [Char] LineColPos) Int
-> [P (Str Char [Char] LineColPos) (Int -> Int -> Int)]
-> P (Str Char [Char] LineColPos) Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr P (Str Char [Char] LineColPos) (Int -> Int -> Int)
-> P (Str Char [Char] LineColPos) Int
-> P (Str Char [Char] LineColPos) Int
forall (p :: * -> *) c. IsParser p => p (c -> c -> c) -> p c -> p c
pChainl ( P (Str Char [Char] LineColPos) Int
forall a. Num a => Parser a
pNatural P (Str Char [Char] LineColPos) Int
-> P (Str Char [Char] LineColPos) Int
-> P (Str Char [Char] LineColPos) Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P (Str Char [Char] LineColPos) Int
-> P (Str Char [Char] LineColPos) Int
forall a. ParserTrafo a a
pParens P (Str Char [Char] LineColPos) Int
expr) (([(Char, Int -> Int -> Int)]
 -> P (Str Char [Char] LineColPos) (Int -> Int -> Int))
-> [[(Char, Int -> Int -> Int)]]
-> [P (Str Char [Char] LineColPos) (Int -> Int -> Int)]
forall a b. (a -> b) -> [a] -> [b]
map [(Char, Int -> Int -> Int)]
-> P (Str Char [Char] LineColPos) (Int -> Int -> Int)
forall state loc a.
(Eq (Item state), IsLocationUpdatedBy loc (Item state),
 ListLike state (Item state), Show (Item state)) =>
[(Item state, a)] -> P (Str (Item state) state loc) a
same_prio [[(Char, Int -> Int -> Int)]]
forall a. Integral a => [[(Char, a -> a -> a)]]
operators) 


-- | A common case where ambiguity arises is when we e.g. want to recognise identifiers, 
--   but only those which are not keywords. 
--   The combinator `micro` inserts steps with a specfied cost in the result 
--   of the parser which can be used to disambiguate:
--
-- > 
-- > ident ::  Parser String
-- > ident = ((:) <$> pSym ('a','z') <*> pMunch (\x -> 'a' <= x && x <= 'z') `micro` 2) <* spaces
-- > idents = pList1 ident
-- > pKey keyw = pToken keyw `micro` 1 <* spaces
-- > spaces :: Parser String
-- > spaces = pMunch (==' ')
-- > takes_second_alt =   pList ident 
-- >                \<|> (\ c t e -> ["IfThenElse"] ++  c   ++  t  ++  e) 
-- >                    \<$ pKey "if"   <*> pList_ng ident 
-- >                    \<* pKey "then" <*> pList_ng ident
-- >                    \<* pKey "else" <*> pList_ng ident  
--
--  A keyword is followed by a small cost @1@, which makes sure that 
--  identifiers which have a keyword as a prefix win over the keyword. Identifiers are however
--   followed by a cost @2@, with as result that in this case the keyword wins. 
--   Note that a limitation of this approach is that keywords are only recognised as such when expected!
-- 
-- > test13 = run takes_second_alt "if a then if else c"
-- > test14 = run takes_second_alt "ifx a then if else c"
-- 
-- with results for @test13@ and @test14@:
--
-- > Result: ["IfThenElse","a","if","c"]
-- > Result: ["ifx","a","then","if", "else","c"]
-- 

-- | A mistake which is made quite often is to construct  a parser which can recognise a sequence of elements using one of the 
--  derived combinators (say @`pList`@), but where the argument parser can recognise the empty string. 
--  The derived combinators check whether this is the case and terminate the parsing process with an error message:
--
-- > run (pList spaces) ""
-- > Result: *** Exception: The combinator pList
-- >  requires that it's argument cannot recognise the empty string
--
-- > run (pMaybe spaces) " "
-- > Result: *** Exception: The combinator pMaybe
-- > requires that it's argument cannot recognise the empty string
test16 :: IO ()
test16 :: IO ()
test16 = P (Str Char [Char] LineColPos) [[Char]] -> [Char] -> IO ()
forall t. Show t => Parser t -> [Char] -> IO ()
run (P (Str Char [Char] LineColPos) [Char]
-> P (Str Char [Char] LineColPos) [[Char]]
forall (p :: * -> *) a. IsParser p => p a -> p [a]
pList P (Str Char [Char] LineColPos) [Char]
spaces) [Char]
"  "

ident :: P (Str Char [Char] LineColPos) [Char]
ident = ((:) (Char -> [Char] -> [Char])
-> P (Str Char [Char] LineColPos) Char
-> P (Str Char [Char] LineColPos) ([Char] -> [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char, Char) -> P (Str Char [Char] LineColPos) Char
forall a loc state.
(Ord a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
(a, a) -> P (Str a state loc) a
pRange (Char
'a',Char
'z') P (Str Char [Char] LineColPos) ([Char] -> [Char])
-> P (Str Char [Char] LineColPos) [Char]
-> P (Str Char [Char] LineColPos) [Char]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Bool) -> P (Str Char [Char] LineColPos) [Char]
forall loc state a.
(Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
(a -> Bool) -> P (Str a state loc) [a]
pMunch (\Char
x -> Char
'a' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
x Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z') P (Str Char [Char] LineColPos) [Char]
-> Int -> P (Str Char [Char] LineColPos) [Char]
forall state a. P state a -> Int -> P state a
`micro` Int
2) P (Str Char [Char] LineColPos) [Char]
-> P (Str Char [Char] LineColPos) [Char]
-> P (Str Char [Char] LineColPos) [Char]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P (Str Char [Char] LineColPos) [Char]
spaces
idents :: P (Str Char [Char] LineColPos) [[Char]]
idents = P (Str Char [Char] LineColPos) [Char]
-> P (Str Char [Char] LineColPos) [[Char]]
forall (p :: * -> *) a. IsParser p => p a -> p [a]
pList1 P (Str Char [Char] LineColPos) [Char]
ident

pKey :: [Char] -> P (Str Char [Char] LineColPos) [Char]
pKey [Char]
keyw = [Char] -> P (Str Char [Char] LineColPos) [Char]
forall loc state a.
(Show a, Eq a, IsLocationUpdatedBy loc a, ListLike state a) =>
[a] -> P (Str a state loc) [a]
pToken [Char]
keyw P (Str Char [Char] LineColPos) [Char]
-> Int -> P (Str Char [Char] LineColPos) [Char]
forall state a. P state a -> Int -> P state a
`micro` Int
1 P (Str Char [Char] LineColPos) [Char]
-> P (Str Char [Char] LineColPos) [Char]
-> P (Str Char [Char] LineColPos) [Char]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P (Str Char [Char] LineColPos) [Char]
spaces
spaces :: Parser String
spaces :: P (Str Char [Char] LineColPos) [Char]
spaces = (Char -> Bool) -> P (Str Char [Char] LineColPos) [Char]
forall loc state a.
(Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
(a -> Bool) -> P (Str a state loc) [a]
pMunch (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
" \n")
 
takes_second_alt :: P (Str Char [Char] LineColPos) [[Char]]
takes_second_alt =   P (Str Char [Char] LineColPos) [Char]
-> P (Str Char [Char] LineColPos) [[Char]]
forall (p :: * -> *) a. IsParser p => p a -> p [a]
pList P (Str Char [Char] LineColPos) [Char]
ident 
              P (Str Char [Char] LineColPos) [[Char]]
-> P (Str Char [Char] LineColPos) [[Char]]
-> P (Str Char [Char] LineColPos) [[Char]]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (\ [[Char]]
c [[Char]]
t [[Char]]
e -> [[Char]
"IfThenElse"] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++  [[Char]]
c   [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++  [[Char]]
t  [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++  [[Char]]
e) 
                  ([[Char]] -> [[Char]] -> [[Char]] -> [[Char]])
-> P (Str Char [Char] LineColPos) [Char]
-> P (Str Char [Char] LineColPos)
     ([[Char]] -> [[Char]] -> [[Char]] -> [[Char]])
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P (Str Char [Char] LineColPos) [Char]
pKey [Char]
"if"   P (Str Char [Char] LineColPos)
  ([[Char]] -> [[Char]] -> [[Char]] -> [[Char]])
-> P (Str Char [Char] LineColPos) [[Char]]
-> P (Str Char [Char] LineColPos)
     ([[Char]] -> [[Char]] -> [[Char]])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P (Str Char [Char] LineColPos) [Char]
-> P (Str Char [Char] LineColPos) [[Char]]
forall (p :: * -> *) a. IsParser p => p a -> p [a]
pList_ng P (Str Char [Char] LineColPos) [Char]
ident 
                  P (Str Char [Char] LineColPos) ([[Char]] -> [[Char]] -> [[Char]])
-> P (Str Char [Char] LineColPos) [Char]
-> P (Str Char [Char] LineColPos)
     ([[Char]] -> [[Char]] -> [[Char]])
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Char] -> P (Str Char [Char] LineColPos) [Char]
pKey [Char]
"then" P (Str Char [Char] LineColPos) ([[Char]] -> [[Char]] -> [[Char]])
-> P (Str Char [Char] LineColPos) [[Char]]
-> P (Str Char [Char] LineColPos) ([[Char]] -> [[Char]])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P (Str Char [Char] LineColPos) [Char]
-> P (Str Char [Char] LineColPos) [[Char]]
forall (p :: * -> *) a. IsParser p => p a -> p [a]
pList_ng P (Str Char [Char] LineColPos) [Char]
ident
                  P (Str Char [Char] LineColPos) ([[Char]] -> [[Char]])
-> P (Str Char [Char] LineColPos) [Char]
-> P (Str Char [Char] LineColPos) ([[Char]] -> [[Char]])
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Char] -> P (Str Char [Char] LineColPos) [Char]
pKey [Char]
"else" P (Str Char [Char] LineColPos) ([[Char]] -> [[Char]])
-> P (Str Char [Char] LineColPos) [[Char]]
-> P (Str Char [Char] LineColPos) [[Char]]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P (Str Char [Char] LineColPos) [Char]
-> P (Str Char [Char] LineColPos) [[Char]]
forall (p :: * -> *) a. IsParser p => p a -> p [a]
pList_ng P (Str Char [Char] LineColPos) [Char]
ident  
test13 :: IO ()
test13 = P (Str Char [Char] LineColPos) [[Char]] -> [Char] -> IO ()
forall t. Show t => Parser t -> [Char] -> IO ()
run P (Str Char [Char] LineColPos) [[Char]]
takes_second_alt [Char]
"if a then if else c"
test14 :: IO ()
test14 = P (Str Char [Char] LineColPos) [[Char]] -> [Char] -> IO ()
forall t. Show t => Parser t -> [Char] -> IO ()
run P (Str Char [Char] LineColPos) [[Char]]
takes_second_alt [Char]
"ifx a then if else c"



pManyTill :: P st a -> P st b -> P st [a]
pManyTill :: P st a -> P st b -> P st [a]
pManyTill P st a
p P st b
end = [] [a] -> P st b -> P st [a]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ P st b
end 
                  P st [a] -> P st [a] -> P st [a]
forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|> 
                  (:) (a -> [a] -> [a]) -> P st a -> P st ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P st a
p P st ([a] -> [a]) -> P st [a] -> P st [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P st a -> P st b -> P st [a]
forall st a b. P st a -> P st b -> P st [a]
pManyTill P st a
p P st b
end
simpleComment :: P (Str Char state loc) [Char]
simpleComment   =  [Char] -> P (Str Char state loc) [Char]
forall loc state.
(IsLocationUpdatedBy loc Char, ListLike state Char) =>
[Char] -> P (Str Char state loc) [Char]
string [Char]
"<!--"  P (Str Char state loc) [Char]
-> P (Str Char state loc) [Char] -> P (Str Char state loc) [Char]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>  P (Str Char state loc) Char
-> P (Str Char state loc) [Char] -> P (Str Char state loc) [Char]
forall st a b. P st a -> P st b -> P st [a]
pManyTill P (Str Char state loc) Char
Parser Char
pAscii  ([Char] -> P (Str Char state loc) [Char]
forall loc state.
(IsLocationUpdatedBy loc Char, ListLike state Char) =>
[Char] -> P (Str Char state loc) [Char]
string [Char]
"-->")


string ::(IsLocationUpdatedBy loc Char, LL.ListLike state Char) => String -> P (Str Char state loc)  String
string :: [Char] -> P (Str Char state loc) [Char]
string = [Char] -> P (Str Char state loc) [Char]
forall loc state a.
(Show a, Eq a, IsLocationUpdatedBy loc a, ListLike state a) =>
[a] -> P (Str a state loc) [a]
pToken


pVarId :: P (Str Char state loc) [Char]
pVarId  = (:) (Char -> [Char] -> [Char])
-> P (Str Char state loc) Char
-> P (Str Char state loc) ([Char] -> [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (Str Char state loc) Char
Parser Char
pLower P (Str Char state loc) ([Char] -> [Char])
-> P (Str Char state loc) [Char] -> P (Str Char state loc) [Char]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P (Str Char state loc) Char -> P (Str Char state loc) [Char]
forall (p :: * -> *) a. IsParser p => p a -> p [a]
pList P (Str Char state loc) Char
Parser Char
pIdChar
pConId :: P (Str Char state loc) [Char]
pConId  = (:) (Char -> [Char] -> [Char])
-> P (Str Char state loc) Char
-> P (Str Char state loc) ([Char] -> [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (Str Char state loc) Char
Parser Char
pUpper P (Str Char state loc) ([Char] -> [Char])
-> P (Str Char state loc) [Char] -> P (Str Char state loc) [Char]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P (Str Char state loc) Char -> P (Str Char state loc) [Char]
forall (p :: * -> *) a. IsParser p => p a -> p [a]
pList P (Str Char state loc) Char
Parser Char
pIdChar
pIdChar :: P (Str Char state loc) Char
pIdChar = P (Str Char state loc) Char
Parser Char
pLower P (Str Char state loc) Char
-> P (Str Char state loc) Char -> P (Str Char state loc) Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P (Str Char state loc) Char
Parser Char
pUpper P (Str Char state loc) Char
-> P (Str Char state loc) Char -> P (Str Char state loc) Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P (Str Char state loc) Char
Parser Char
pDigit P (Str Char state loc) Char
-> P (Str Char state loc) Char -> P (Str Char state loc) Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> P (Str Char state loc) Char
forall loc state.
(IsLocationUpdatedBy loc Char, ListLike state Char) =>
[Char] -> P (Str Char state loc) Char
pAnySym [Char]
"='"

pAnyToken :: (IsLocationUpdatedBy loc Char, LL.ListLike state Char) => [String] -> P (Str Char state loc)  String 
pAnyToken :: [[Char]] -> P (Str Char state loc) [Char]
pAnyToken = ([Char] -> P (Str Char state loc) [Char])
-> [[Char]] -> P (Str Char state loc) [Char]
forall (p :: * -> *) a a1. IsParser p => (a -> p a1) -> [a] -> p a1
pAny [Char] -> P (Str Char state loc) [Char]
forall loc state a.
(Show a, Eq a, IsLocationUpdatedBy loc a, ListLike state a) =>
[a] -> P (Str a state loc) [a]
pToken

-- parsing two alternatives and returning both rsults
pIntList :: Parser [Int]
pIntList :: P (Str Char [Char] LineColPos) [Int]
pIntList       =  P (Str Char [Char] LineColPos) [Int]
-> P (Str Char [Char] LineColPos) [Int]
forall a. ParserTrafo a a
pParens ((Char -> P (Str Char [Char] LineColPos) Char
forall a loc state.
(Eq a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
a -> P (Str a state loc) a
pSym Char
';') P (Str Char [Char] LineColPos) Char
-> P (Str Char [Char] LineColPos) Int
-> P (Str Char [Char] LineColPos) [Int]
forall (p :: * -> *) a1 a. IsParser p => p a1 -> p a -> p [a]
`pListSep` ([Char] -> Int
forall a. Read a => [Char] -> a
read ([Char] -> Int)
-> P (Str Char [Char] LineColPos) [Char]
-> P (Str Char [Char] LineColPos) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (Str Char [Char] LineColPos) Char
-> P (Str Char [Char] LineColPos) [Char]
forall (p :: * -> *) a. IsParser p => p a -> p [a]
pList1 ((Char, Char) -> P (Str Char [Char] LineColPos) Char
forall a loc state.
(Ord a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
(a, a) -> P (Str a state loc) a
pRange (Char
'0', Char
'9'))))
parseIntString :: Parser [String]
parseIntString :: P (Str Char [Char] LineColPos) [[Char]]
parseIntString =  P (Str Char [Char] LineColPos) [[Char]]
-> P (Str Char [Char] LineColPos) [[Char]]
forall a. ParserTrafo a a
pParens ((Char -> P (Str Char [Char] LineColPos) Char
forall a loc state.
(Eq a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
a -> P (Str a state loc) a
pSym Char
';') P (Str Char [Char] LineColPos) Char
-> P (Str Char [Char] LineColPos) [Char]
-> P (Str Char [Char] LineColPos) [[Char]]
forall (p :: * -> *) a1 a. IsParser p => p a1 -> p a -> p [a]
`pListSep` (         P (Str Char [Char] LineColPos) Char
-> P (Str Char [Char] LineColPos) [Char]
forall (p :: * -> *) a. IsParser p => p a -> p [a]
pList1 ((Char, Char) -> P (Str Char [Char] LineColPos) Char
forall a loc state.
(Ord a, Show a, IsLocationUpdatedBy loc a, ListLike state a) =>
(a, a) -> P (Str a state loc) a
pRange(Char
'0', Char
'9'))))




demo :: Show r => String -> String -> P (Str Char String LineColPos) r -> IO ()
demo :: [Char] -> [Char] -> P (Str Char [Char] LineColPos) r -> IO ()
demo [Char]
str  [Char]
input P (Str Char [Char] LineColPos) r
p= do [Char] -> IO ()
putStr ([Char]
"-- >>>   run " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
str [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"  " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
input [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n")
                      P (Str Char [Char] LineColPos) r -> [Char] -> IO ()
forall t. Show t => Parser t -> [Char] -> IO ()
run P (Str Char [Char] LineColPos) r
p [Char]
input