{-# LANGUAGE RankNTypes,
MultiParamTypeClasses,
FunctionalDependencies,
FlexibleInstances,
UndecidableInstances,
FlexibleContexts,
CPP #-}
#define DEMO(p,i) demo "p" i p
module Text.ParserCombinators.UU.Idioms where
import Text.ParserCombinators.UU
import Text.ParserCombinators.UU.BasicInstances hiding (Parser)
import Text.ParserCombinators.UU.Utils
import Text.ParserCombinators.UU.Demo.Examples hiding (show_demos)
import qualified Data.ListLike as LL
import Control.Applicative
data IF = IF
data THEN = THEN
data ELSE = ELSE
data FI = FI
data OR = OR
data String' = String' {String' -> String
fromStr :: String}
data Ii = Ii
iI ::Idiomatic i (a -> a) g => g
iI :: g
iI = P i (a -> a) -> g
forall st f g. Idiomatic st f g => P st f -> g
idiomatic ((a -> a) -> P i (a -> a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> a
forall a. a -> a
id)
class Idiomatic st f g | g -> f st where
idiomatic :: P st f -> g
instance Idiomatic st x (Ii -> P st x) where
idiomatic :: P st x -> Ii -> P st x
idiomatic P st x
ix Ii
Ii = P st x
ix
instance Idiomatic st f g => Idiomatic st (a -> f) (P st a -> g) where
idiomatic :: P st (a -> f) -> P st a -> g
idiomatic P st (a -> f)
isf P st a
is = P st f -> g
forall st f g. Idiomatic st f g => P st f -> g
idiomatic (P st (a -> f)
isf P st (a -> f) -> P st a -> P st f
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P st a
is)
instance Idiomatic st f g => Idiomatic st ((a -> b) -> f) ((a -> b) -> g) where
idiomatic :: P st ((a -> b) -> f) -> (a -> b) -> g
idiomatic P st ((a -> b) -> f)
isf a -> b
f = P st f -> g
forall st f g. Idiomatic st f g => P st f -> g
idiomatic (P st ((a -> b) -> f)
isf P st ((a -> b) -> f) -> P st (a -> b) -> P st f
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a -> b) -> P st (a -> b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> b
f))
instance (Idiomatic (Str Char state loc) f g, IsLocationUpdatedBy loc Char, LL.ListLike state Char)
=> Idiomatic (Str Char state loc) f (String -> g) where
idiomatic :: P (Str Char state loc) f -> String -> g
idiomatic P (Str Char state loc) f
isf String
str = P (Str Char state loc) f -> g
forall st f g. Idiomatic st f g => P st f -> g
idiomatic (P (Str Char state loc) f
isf P (Str Char state loc) f
-> P (Str Char state loc) String -> P (Str Char state loc) f
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P (Str Char state loc) String -> P (Str Char state loc) String
forall a. ParserTrafo a a
lexeme (String -> P (Str Char state loc) String
forall loc state a.
(Show a, Eq a, IsLocationUpdatedBy loc a, ListLike state a) =>
[a] -> P (Str a state loc) [a]
pToken String
str))
instance (Idiomatic (Str Char state loc) f g, IsLocationUpdatedBy loc Char, LL.ListLike state Char)
=> Idiomatic (Str Char state loc) f (Char -> g) where
idiomatic :: P (Str Char state loc) f -> Char -> g
idiomatic P (Str Char state loc) f
isf Char
c = P (Str Char state loc) f -> g
forall st f g. Idiomatic st f g => P st f -> g
idiomatic (P (Str Char state loc) f
isf P (Str Char state loc) f
-> P (Str Char state loc) Char -> P (Str Char state loc) f
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P (Str Char state loc) Char -> P (Str Char state loc) Char
forall a. ParserTrafo a a
lexeme (Char -> P (Str Char state loc) 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))
instance Idiomatic st f g => Idiomatic st (a -> f) (IF -> Bool -> THEN -> P st a -> ELSE -> P st a -> FI -> g) where
idiomatic :: P st (a -> f)
-> IF -> Bool -> THEN -> P st a -> ELSE -> P st a -> FI -> g
idiomatic P st (a -> f)
isf IF
IF Bool
b THEN
THEN P st a
t ELSE
ELSE P st a
e FI
FI = P st f -> g
forall st f g. Idiomatic st f g => P st f -> g
idiomatic (P st (a -> f)
isf P st (a -> f) -> P st a -> P st f
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (if Bool
b then P st a
t else P st a
e))
pNat :: Parser Int
pNat :: Parser Int
pNat = Parser Int
forall a. Num a => Parser a
pNatural
show_demos :: IO ()
show_demos :: IO ()
show_demos = String -> String -> Parser Int -> IO ()
forall r.
Show r =>
String -> String -> P (Str Char String LineColPos) r -> IO ()
demo String
"(+) <$> (iI (+) '(' pNat \"plus\" IF True THEN pNat ELSE pNat FI ')' Ii) <* lexeme (pSym '+') <*> pNat)" String
"(2 plus 3) + 8"
(Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (Int -> Int -> Int)
-> Parser Int -> P (Str Char String LineColPos) (Int -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Int -> Int -> Int)
-> Char
-> Parser Int
-> String
-> IF
-> Bool
-> THEN
-> Parser Int
-> ELSE
-> Parser Int
-> FI
-> Char
-> Ii
-> Parser Int
forall i a g. Idiomatic i (a -> a) g => g
iI Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Char
'(' Parser Int
pNat String
"plus" IF
IF Bool
True THEN
THEN Parser Int
pNat ELSE
ELSE Parser Int
pNat FI
FI Char
')' Ii
Ii) P (Str Char String LineColPos) (Int -> Int)
-> P (Str Char String LineColPos) Char
-> P (Str Char String LineColPos) (Int -> Int)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P (Str Char String LineColPos) Char
-> P (Str Char String LineColPos) Char
forall a. ParserTrafo a a
lexeme (Char -> P (Str Char String 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 String LineColPos) (Int -> Int)
-> Parser Int -> Parser Int
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int
pNat)