{-# LANGUAGE RankNTypes #-}
module Toml.FromValue.Matcher (
Matcher,
Result(..),
MatchMessage(..),
runMatcher,
withScope,
getScope,
warning,
Scope(..),
inKey,
inIndex,
) where
import Control.Applicative (Alternative(..))
import Control.Monad (MonadPlus, ap, liftM)
import Data.Monoid (Endo(..))
newtype Matcher a = Matcher {
Matcher a
-> forall r.
[Scope]
-> DList MatchMessage
-> (DList MatchMessage -> r)
-> (DList MatchMessage -> a -> r)
-> r
unMatcher ::
forall r.
[Scope] ->
DList MatchMessage ->
(DList MatchMessage -> r) ->
(DList MatchMessage -> a -> r) ->
r
}
instance Functor Matcher where
fmap :: (a -> b) -> Matcher a -> Matcher b
fmap = (a -> b) -> Matcher a -> Matcher b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance Applicative Matcher where
pure :: a -> Matcher a
pure a
x = (forall r.
[Scope]
-> DList MatchMessage
-> (DList MatchMessage -> r)
-> (DList MatchMessage -> a -> r)
-> r)
-> Matcher a
forall a.
(forall r.
[Scope]
-> DList MatchMessage
-> (DList MatchMessage -> r)
-> (DList MatchMessage -> a -> r)
-> r)
-> Matcher a
Matcher (\[Scope]
_env DList MatchMessage
warn DList MatchMessage -> r
_err DList MatchMessage -> a -> r
ok -> DList MatchMessage -> a -> r
ok DList MatchMessage
warn a
x)
<*> :: Matcher (a -> b) -> Matcher a -> Matcher b
(<*>) = Matcher (a -> b) -> Matcher a -> Matcher b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad Matcher where
Matcher a
m >>= :: Matcher a -> (a -> Matcher b) -> Matcher b
>>= a -> Matcher b
f = (forall r.
[Scope]
-> DList MatchMessage
-> (DList MatchMessage -> r)
-> (DList MatchMessage -> b -> r)
-> r)
-> Matcher b
forall a.
(forall r.
[Scope]
-> DList MatchMessage
-> (DList MatchMessage -> r)
-> (DList MatchMessage -> a -> r)
-> r)
-> Matcher a
Matcher (\[Scope]
env DList MatchMessage
warn DList MatchMessage -> r
err DList MatchMessage -> b -> r
ok -> Matcher a
-> [Scope]
-> DList MatchMessage
-> (DList MatchMessage -> r)
-> (DList MatchMessage -> a -> r)
-> r
forall a.
Matcher a
-> forall r.
[Scope]
-> DList MatchMessage
-> (DList MatchMessage -> r)
-> (DList MatchMessage -> a -> r)
-> r
unMatcher Matcher a
m [Scope]
env DList MatchMessage
warn DList MatchMessage -> r
err (\DList MatchMessage
warn' a
x -> Matcher b
-> [Scope]
-> DList MatchMessage
-> (DList MatchMessage -> r)
-> (DList MatchMessage -> b -> r)
-> r
forall a.
Matcher a
-> forall r.
[Scope]
-> DList MatchMessage
-> (DList MatchMessage -> r)
-> (DList MatchMessage -> a -> r)
-> r
unMatcher (a -> Matcher b
f a
x) [Scope]
env DList MatchMessage
warn' DList MatchMessage -> r
err DList MatchMessage -> b -> r
ok))
{-# INLINE (>>=) #-}
instance Alternative Matcher where
empty :: Matcher a
empty = (forall r.
[Scope]
-> DList MatchMessage
-> (DList MatchMessage -> r)
-> (DList MatchMessage -> a -> r)
-> r)
-> Matcher a
forall a.
(forall r.
[Scope]
-> DList MatchMessage
-> (DList MatchMessage -> r)
-> (DList MatchMessage -> a -> r)
-> r)
-> Matcher a
Matcher (\[Scope]
_env DList MatchMessage
_warn DList MatchMessage -> r
err DList MatchMessage -> a -> r
_ok -> DList MatchMessage -> r
err DList MatchMessage
forall a. Monoid a => a
mempty)
Matcher forall r.
[Scope]
-> DList MatchMessage
-> (DList MatchMessage -> r)
-> (DList MatchMessage -> a -> r)
-> r
x <|> :: Matcher a -> Matcher a -> Matcher a
<|> Matcher forall r.
[Scope]
-> DList MatchMessage
-> (DList MatchMessage -> r)
-> (DList MatchMessage -> a -> r)
-> r
y = (forall r.
[Scope]
-> DList MatchMessage
-> (DList MatchMessage -> r)
-> (DList MatchMessage -> a -> r)
-> r)
-> Matcher a
forall a.
(forall r.
[Scope]
-> DList MatchMessage
-> (DList MatchMessage -> r)
-> (DList MatchMessage -> a -> r)
-> r)
-> Matcher a
Matcher (\[Scope]
env DList MatchMessage
warn DList MatchMessage -> r
err DList MatchMessage -> a -> r
ok -> [Scope]
-> DList MatchMessage
-> (DList MatchMessage -> r)
-> (DList MatchMessage -> a -> r)
-> r
forall r.
[Scope]
-> DList MatchMessage
-> (DList MatchMessage -> r)
-> (DList MatchMessage -> a -> r)
-> r
x [Scope]
env DList MatchMessage
warn (\DList MatchMessage
errs1 -> [Scope]
-> DList MatchMessage
-> (DList MatchMessage -> r)
-> (DList MatchMessage -> a -> r)
-> r
forall r.
[Scope]
-> DList MatchMessage
-> (DList MatchMessage -> r)
-> (DList MatchMessage -> a -> r)
-> r
y [Scope]
env DList MatchMessage
warn (\DList MatchMessage
errs2 -> DList MatchMessage -> r
err (DList MatchMessage
errs1 DList MatchMessage -> DList MatchMessage -> DList MatchMessage
forall a. Semigroup a => a -> a -> a
<> DList MatchMessage
errs2)) DList MatchMessage -> a -> r
ok) DList MatchMessage -> a -> r
ok)
instance MonadPlus Matcher
data Scope
= ScopeIndex Int
| ScopeKey String
deriving (
Read ,
Show ,
Eq ,
Ord )
data MatchMessage = MatchMessage {
MatchMessage -> [Scope]
matchPath :: [Scope],
MatchMessage -> String
matchMessage :: String
} deriving (
Read ,
Show ,
Eq ,
Ord )
newtype DList a = DList (Endo [a])
deriving (b -> DList a -> DList a
NonEmpty (DList a) -> DList a
DList a -> DList a -> DList a
(DList a -> DList a -> DList a)
-> (NonEmpty (DList a) -> DList a)
-> (forall b. Integral b => b -> DList a -> DList a)
-> Semigroup (DList a)
forall b. Integral b => b -> DList a -> DList a
forall a. NonEmpty (DList a) -> DList a
forall a. DList a -> DList a -> DList a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a b. Integral b => b -> DList a -> DList a
stimes :: b -> DList a -> DList a
$cstimes :: forall a b. Integral b => b -> DList a -> DList a
sconcat :: NonEmpty (DList a) -> DList a
$csconcat :: forall a. NonEmpty (DList a) -> DList a
<> :: DList a -> DList a -> DList a
$c<> :: forall a. DList a -> DList a -> DList a
Semigroup, Semigroup (DList a)
DList a
Semigroup (DList a)
-> DList a
-> (DList a -> DList a -> DList a)
-> ([DList a] -> DList a)
-> Monoid (DList a)
[DList a] -> DList a
DList a -> DList a -> DList a
forall a. Semigroup (DList a)
forall a. DList a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. [DList a] -> DList a
forall a. DList a -> DList a -> DList a
mconcat :: [DList a] -> DList a
$cmconcat :: forall a. [DList a] -> DList a
mappend :: DList a -> DList a -> DList a
$cmappend :: forall a. DList a -> DList a -> DList a
mempty :: DList a
$cmempty :: forall a. DList a
$cp1Monoid :: forall a. Semigroup (DList a)
Monoid)
one :: a -> DList a
one :: a -> DList a
one a
x = Endo [a] -> DList a
forall a. Endo [a] -> DList a
DList (([a] -> [a]) -> Endo [a]
forall a. (a -> a) -> Endo a
Endo (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:))
runDList :: DList a -> [a]
runDList :: DList a -> [a]
runDList (DList Endo [a]
x) = Endo [a]
x Endo [a] -> [a] -> [a]
forall a. Endo a -> a -> a
`appEndo` []
data Result e a
= Failure [e]
| Success [e] a
deriving (
Read ,
Show ,
Eq ,
Ord )
runMatcher :: Matcher a -> Result MatchMessage a
runMatcher :: Matcher a -> Result MatchMessage a
runMatcher (Matcher forall r.
[Scope]
-> DList MatchMessage
-> (DList MatchMessage -> r)
-> (DList MatchMessage -> a -> r)
-> r
m) = [Scope]
-> DList MatchMessage
-> (DList MatchMessage -> Result MatchMessage a)
-> (DList MatchMessage -> a -> Result MatchMessage a)
-> Result MatchMessage a
forall r.
[Scope]
-> DList MatchMessage
-> (DList MatchMessage -> r)
-> (DList MatchMessage -> a -> r)
-> r
m [] DList MatchMessage
forall a. Monoid a => a
mempty ([MatchMessage] -> Result MatchMessage a
forall e a. [e] -> Result e a
Failure ([MatchMessage] -> Result MatchMessage a)
-> (DList MatchMessage -> [MatchMessage])
-> DList MatchMessage
-> Result MatchMessage a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList MatchMessage -> [MatchMessage]
forall a. DList a -> [a]
runDList) ([MatchMessage] -> a -> Result MatchMessage a
forall e a. [e] -> a -> Result e a
Success ([MatchMessage] -> a -> Result MatchMessage a)
-> (DList MatchMessage -> [MatchMessage])
-> DList MatchMessage
-> a
-> Result MatchMessage a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList MatchMessage -> [MatchMessage]
forall a. DList a -> [a]
runDList)
withScope :: Scope -> Matcher a -> Matcher a
withScope :: Scope -> Matcher a -> Matcher a
withScope Scope
ctx (Matcher forall r.
[Scope]
-> DList MatchMessage
-> (DList MatchMessage -> r)
-> (DList MatchMessage -> a -> r)
-> r
m) = (forall r.
[Scope]
-> DList MatchMessage
-> (DList MatchMessage -> r)
-> (DList MatchMessage -> a -> r)
-> r)
-> Matcher a
forall a.
(forall r.
[Scope]
-> DList MatchMessage
-> (DList MatchMessage -> r)
-> (DList MatchMessage -> a -> r)
-> r)
-> Matcher a
Matcher (\[Scope]
env -> [Scope]
-> DList MatchMessage
-> (DList MatchMessage -> r)
-> (DList MatchMessage -> a -> r)
-> r
forall r.
[Scope]
-> DList MatchMessage
-> (DList MatchMessage -> r)
-> (DList MatchMessage -> a -> r)
-> r
m (Scope
ctx Scope -> [Scope] -> [Scope]
forall a. a -> [a] -> [a]
: [Scope]
env))
getScope :: Matcher [Scope]
getScope :: Matcher [Scope]
getScope = (forall r.
[Scope]
-> DList MatchMessage
-> (DList MatchMessage -> r)
-> (DList MatchMessage -> [Scope] -> r)
-> r)
-> Matcher [Scope]
forall a.
(forall r.
[Scope]
-> DList MatchMessage
-> (DList MatchMessage -> r)
-> (DList MatchMessage -> a -> r)
-> r)
-> Matcher a
Matcher (\[Scope]
env DList MatchMessage
warn DList MatchMessage -> r
_err DList MatchMessage -> [Scope] -> r
ok -> DList MatchMessage -> [Scope] -> r
ok DList MatchMessage
warn ([Scope] -> [Scope]
forall a. [a] -> [a]
reverse [Scope]
env))
warning :: String -> Matcher ()
warning :: String -> Matcher ()
warning String
w =
do [Scope]
loc <- Matcher [Scope]
getScope
(forall r.
[Scope]
-> DList MatchMessage
-> (DList MatchMessage -> r)
-> (DList MatchMessage -> () -> r)
-> r)
-> Matcher ()
forall a.
(forall r.
[Scope]
-> DList MatchMessage
-> (DList MatchMessage -> r)
-> (DList MatchMessage -> a -> r)
-> r)
-> Matcher a
Matcher (\[Scope]
_env DList MatchMessage
warn DList MatchMessage -> r
_err DList MatchMessage -> () -> r
ok -> DList MatchMessage -> () -> r
ok (DList MatchMessage
warn DList MatchMessage -> DList MatchMessage -> DList MatchMessage
forall a. Semigroup a => a -> a -> a
<> MatchMessage -> DList MatchMessage
forall a. a -> DList a
one ([Scope] -> String -> MatchMessage
MatchMessage [Scope]
loc String
w)) ())
instance MonadFail Matcher where
fail :: String -> Matcher a
fail String
e =
do [Scope]
loc <- Matcher [Scope]
getScope
(forall r.
[Scope]
-> DList MatchMessage
-> (DList MatchMessage -> r)
-> (DList MatchMessage -> a -> r)
-> r)
-> Matcher a
forall a.
(forall r.
[Scope]
-> DList MatchMessage
-> (DList MatchMessage -> r)
-> (DList MatchMessage -> a -> r)
-> r)
-> Matcher a
Matcher (\[Scope]
_env DList MatchMessage
_warn DList MatchMessage -> r
err DList MatchMessage -> a -> r
_ok -> DList MatchMessage -> r
err (MatchMessage -> DList MatchMessage
forall a. a -> DList a
one ([Scope] -> String -> MatchMessage
MatchMessage [Scope]
loc String
e)))
inKey :: String -> Matcher a -> Matcher a
inKey :: String -> Matcher a -> Matcher a
inKey = Scope -> Matcher a -> Matcher a
forall a. Scope -> Matcher a -> Matcher a
withScope (Scope -> Matcher a -> Matcher a)
-> (String -> Scope) -> String -> Matcher a -> Matcher a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Scope
ScopeKey
inIndex :: Int -> Matcher a -> Matcher a
inIndex :: Int -> Matcher a -> Matcher a
inIndex = Scope -> Matcher a -> Matcher a
forall a. Scope -> Matcher a -> Matcher a
withScope (Scope -> Matcher a -> Matcher a)
-> (Int -> Scope) -> Int -> Matcher a -> Matcher a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Scope
ScopeIndex