{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
module Language.R.Matcher
( Matcher(..)
, matchOnly
, somesexp
, sexp
, with
, hexp
, null
, s4
, s3
, guardType
, typeOf
, getS3Class
, someAttribute
, attribute
, attributes
, lookupAttribute
, names
, dim
, dimnames
, rownames
, factor
, charList
, choice
, list
) where
import Control.Applicative
import Control.DeepSeq
import Control.Exception (evaluate)
import Control.Monad (guard, ap, liftM)
import Data.Foldable (asum)
import Data.Functor (void)
import Data.Maybe (mapMaybe)
import Data.Semigroup as Sem
import Data.Singletons
import Data.Traversable
import Data.Typeable (Typeable)
import qualified Data.Vector.SEXP as SV
import Foreign hiding (void, with)
import Foreign.C.String
import qualified Foreign.R as R
import GHC.Generics (Generic)
import qualified H.Prelude as H
import H.Prelude hiding (typeOf, hexp)
import System.IO.Unsafe
import Prelude hiding (null)
newtype Matcher s a = Matcher
{ Matcher s a
-> forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r
runMatcher
:: forall r.
SomeSEXP s
-> (a -> r)
-> (MatcherError s -> r)
-> r
}
instance Monad (Matcher s) where
return :: a -> Matcher s a
return x :: a
x = (forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r)
-> Matcher s a
forall s a.
(forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r)
-> Matcher s a
Matcher ((forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r)
-> Matcher s a)
-> (forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r)
-> Matcher s a
forall a b. (a -> b) -> a -> b
$ \_ f :: a -> r
f _ -> a -> r
f a
x
Matcher f :: forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r
f >>= :: Matcher s a -> (a -> Matcher s b) -> Matcher s b
>>= k :: a -> Matcher s b
k = (forall r. SomeSEXP s -> (b -> r) -> (MatcherError s -> r) -> r)
-> Matcher s b
forall s a.
(forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r)
-> Matcher s a
Matcher ((forall r. SomeSEXP s -> (b -> r) -> (MatcherError s -> r) -> r)
-> Matcher s b)
-> (forall r. SomeSEXP s -> (b -> r) -> (MatcherError s -> r) -> r)
-> Matcher s b
forall a b. (a -> b) -> a -> b
$ \s :: SomeSEXP s
s ok :: b -> r
ok err :: MatcherError s -> r
err -> SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r
forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r
f SomeSEXP s
s (\o :: a
o -> Matcher s b -> SomeSEXP s -> (b -> r) -> (MatcherError s -> r) -> r
forall s a.
Matcher s a
-> forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r
runMatcher (a -> Matcher s b
k a
o) SomeSEXP s
s b -> r
ok MatcherError s -> r
err) MatcherError s -> r
err
instance MonadFail (Matcher s) where
fail :: String -> Matcher s a
fail s :: String
s = (forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r)
-> Matcher s a
forall s a.
(forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r)
-> Matcher s a
Matcher ((forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r)
-> Matcher s a)
-> (forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r)
-> Matcher s a
forall a b. (a -> b) -> a -> b
$ \_ _ err :: MatcherError s -> r
err -> MatcherError s -> r
err (MatcherError s -> r) -> MatcherError s -> r
forall a b. (a -> b) -> a -> b
$ String -> MatcherError s
forall s. String -> MatcherError s
MatcherError String
s
instance Applicative (Matcher s) where
pure :: a -> Matcher s a
pure = a -> Matcher s a
forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: Matcher s (a -> b) -> Matcher s a -> Matcher s b
(<*>) = Matcher s (a -> b) -> Matcher s a -> Matcher s b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Functor (Matcher s) where
fmap :: (a -> b) -> Matcher s a -> Matcher s b
fmap = (a -> b) -> Matcher s a -> Matcher s b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance Alternative (Matcher s) where
empty :: Matcher s a
empty = String -> Matcher s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "empty"
f :: Matcher s a
f <|> :: Matcher s a -> Matcher s a -> Matcher s a
<|> g :: Matcher s a
g = (forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r)
-> Matcher s a
forall s a.
(forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r)
-> Matcher s a
Matcher ((forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r)
-> Matcher s a)
-> (forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r)
-> Matcher s a
forall a b. (a -> b) -> a -> b
$ \s :: SomeSEXP s
s ok :: a -> r
ok err :: MatcherError s -> r
err ->
Matcher s a -> SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r
forall s a.
Matcher s a
-> forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r
runMatcher Matcher s a
f SomeSEXP s
s a -> r
ok (\e' :: MatcherError s
e' -> Matcher s a -> SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r
forall s a.
Matcher s a
-> forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r
runMatcher Matcher s a
g SomeSEXP s
s a -> r
ok (MatcherError s -> r
err (MatcherError s -> r)
-> (MatcherError s -> MatcherError s) -> MatcherError s -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MatcherError s -> MatcherError s -> MatcherError s
forall a. Monoid a => a -> a -> a
mappend MatcherError s
e')))
instance Sem.Semigroup (MatcherError s) where
a :: MatcherError s
a <> :: MatcherError s -> MatcherError s -> MatcherError s
<> MatcherError "empty" = MatcherError s
a
_ <> a :: MatcherError s
a = MatcherError s
a
instance Monoid (MatcherError s) where
mempty :: MatcherError s
mempty = String -> MatcherError s
forall s. String -> MatcherError s
MatcherError "empty"
mappend :: MatcherError s -> MatcherError s -> MatcherError s
mappend = MatcherError s -> MatcherError s -> MatcherError s
forall a. Semigroup a => a -> a -> a
(<>)
data MatcherError s
= MatcherError String
| TypeMissmatch (SomeSEXP s) R.SEXPTYPE R.SEXPTYPE
| NoSuchAttribute (SomeSEXP s) String
deriving (Typeable, Int -> MatcherError s -> ShowS
[MatcherError s] -> ShowS
MatcherError s -> String
(Int -> MatcherError s -> ShowS)
-> (MatcherError s -> String)
-> ([MatcherError s] -> ShowS)
-> Show (MatcherError s)
forall s. Int -> MatcherError s -> ShowS
forall s. [MatcherError s] -> ShowS
forall s. MatcherError s -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MatcherError s] -> ShowS
$cshowList :: forall s. [MatcherError s] -> ShowS
show :: MatcherError s -> String
$cshow :: forall s. MatcherError s -> String
showsPrec :: Int -> MatcherError s -> ShowS
$cshowsPrec :: forall s. Int -> MatcherError s -> ShowS
Show, (forall x. MatcherError s -> Rep (MatcherError s) x)
-> (forall x. Rep (MatcherError s) x -> MatcherError s)
-> Generic (MatcherError s)
forall x. Rep (MatcherError s) x -> MatcherError s
forall x. MatcherError s -> Rep (MatcherError s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall s x. Rep (MatcherError s) x -> MatcherError s
forall s x. MatcherError s -> Rep (MatcherError s) x
$cto :: forall s x. Rep (MatcherError s) x -> MatcherError s
$cfrom :: forall s x. MatcherError s -> Rep (MatcherError s) x
Generic)
instance NFData (MatcherError s)
matchOnly
:: (MonadR m, NFData a)
=> Matcher s a
-> SomeSEXP s
-> m (Either (MatcherError s) a)
matchOnly :: Matcher s a -> SomeSEXP s -> m (Either (MatcherError s) a)
matchOnly p :: Matcher s a
p s :: SomeSEXP s
s =
Matcher s a
-> SomeSEXP s
-> (a -> m (Either (MatcherError s) a))
-> (MatcherError s -> m (Either (MatcherError s) a))
-> m (Either (MatcherError s) a)
forall s a.
Matcher s a
-> forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r
runMatcher Matcher s a
p SomeSEXP s
s (Either (MatcherError s) a -> m (Either (MatcherError s) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (MatcherError s) a -> m (Either (MatcherError s) a))
-> (a -> Either (MatcherError s) a)
-> a
-> m (Either (MatcherError s) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (MatcherError s) a -> Either (MatcherError s) a
forall a. NFData a => a -> a
force (Either (MatcherError s) a -> Either (MatcherError s) a)
-> (a -> Either (MatcherError s) a)
-> a
-> Either (MatcherError s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either (MatcherError s) a
forall a b. b -> Either a b
Right) (Either (MatcherError s) a -> m (Either (MatcherError s) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (MatcherError s) a -> m (Either (MatcherError s) a))
-> (MatcherError s -> Either (MatcherError s) a)
-> MatcherError s
-> m (Either (MatcherError s) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (MatcherError s) a -> Either (MatcherError s) a
forall a. NFData a => a -> a
force (Either (MatcherError s) a -> Either (MatcherError s) a)
-> (MatcherError s -> Either (MatcherError s) a)
-> MatcherError s
-> Either (MatcherError s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatcherError s -> Either (MatcherError s) a
forall a b. a -> Either a b
Left)
somesexp :: Matcher s (SomeSEXP s)
somesexp :: Matcher s (SomeSEXP s)
somesexp = (forall r.
SomeSEXP s -> (SomeSEXP s -> r) -> (MatcherError s -> r) -> r)
-> Matcher s (SomeSEXP s)
forall s a.
(forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r)
-> Matcher s a
Matcher ((forall r.
SomeSEXP s -> (SomeSEXP s -> r) -> (MatcherError s -> r) -> r)
-> Matcher s (SomeSEXP s))
-> (forall r.
SomeSEXP s -> (SomeSEXP s -> r) -> (MatcherError s -> r) -> r)
-> Matcher s (SomeSEXP s)
forall a b. (a -> b) -> a -> b
$ \s :: SomeSEXP s
s ok :: SomeSEXP s -> r
ok _ -> SomeSEXP s -> r
ok SomeSEXP s
s
sexp :: SSEXPTYPE ty -> Matcher s (SEXP s ty)
sexp :: SSEXPTYPE ty -> Matcher s (SEXP s ty)
sexp p :: SSEXPTYPE ty
p = (forall r.
SomeSEXP s -> (SEXP s ty -> r) -> (MatcherError s -> r) -> r)
-> Matcher s (SEXP s ty)
forall s a.
(forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r)
-> Matcher s a
Matcher ((forall r.
SomeSEXP s -> (SEXP s ty -> r) -> (MatcherError s -> r) -> r)
-> Matcher s (SEXP s ty))
-> (forall r.
SomeSEXP s -> (SEXP s ty -> r) -> (MatcherError s -> r) -> r)
-> Matcher s (SEXP s ty)
forall a b. (a -> b) -> a -> b
$ \(SomeSEXP s :: SEXP s a
s) ok :: SEXP s ty -> r
ok err :: MatcherError s -> r
err ->
if Sing ty -> Demote SEXPTYPE
forall k (a :: k). SingKind k => Sing a -> Demote k
fromSing Sing ty
SSEXPTYPE ty
p SEXPTYPE -> SEXPTYPE -> Bool
forall a. Eq a => a -> a -> Bool
== SEXP s a -> SEXPTYPE
forall s (a :: SEXPTYPE). SEXP s a -> SEXPTYPE
H.typeOf SEXP s a
s
then SEXP s ty -> r
ok (SEXP s a -> SEXP s ty
forall s (a :: SEXPTYPE) (b :: SEXPTYPE). SEXP s a -> SEXP s b
R.unsafeCoerce SEXP s a
s)
else MatcherError s -> r
err (MatcherError s -> r) -> MatcherError s -> r
forall a b. (a -> b) -> a -> b
$ SomeSEXP s -> SEXPTYPE -> SEXPTYPE -> MatcherError s
forall s. SomeSEXP s -> SEXPTYPE -> SEXPTYPE -> MatcherError s
TypeMissmatch (SEXP s a -> SomeSEXP s
forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP SEXP s a
s) (SEXP s a -> SEXPTYPE
forall s (a :: SEXPTYPE). SEXP s a -> SEXPTYPE
R.typeOf SEXP s a
s) (Sing ty -> Demote SEXPTYPE
forall k (a :: k). SingKind k => Sing a -> Demote k
fromSing Sing ty
SSEXPTYPE ty
p)
with :: SomeSEXP s -> Matcher s a -> Matcher s a
with :: SomeSEXP s -> Matcher s a -> Matcher s a
with s :: SomeSEXP s
s p :: Matcher s a
p = (forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r)
-> Matcher s a
forall s a.
(forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r)
-> Matcher s a
Matcher ((forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r)
-> Matcher s a)
-> (forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r)
-> Matcher s a
forall a b. (a -> b) -> a -> b
$ \_ ok :: a -> r
ok err :: MatcherError s -> r
err -> Matcher s a -> SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r
forall s a.
Matcher s a
-> forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r
runMatcher Matcher s a
p SomeSEXP s
s a -> r
ok MatcherError s -> r
err
null :: Matcher s ()
null :: Matcher s ()
null = Matcher s (SEXP s 'Nil) -> Matcher s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Matcher s (SEXP s 'Nil) -> Matcher s ())
-> Matcher s (SEXP s 'Nil) -> Matcher s ()
forall a b. (a -> b) -> a -> b
$ SSEXPTYPE 'Nil -> Matcher s (SEXP s 'Nil)
forall (ty :: SEXPTYPE) s. SSEXPTYPE ty -> Matcher s (SEXP s ty)
sexp SSEXPTYPE 'Nil
SNil
s4 :: Matcher s ()
s4 :: Matcher s ()
s4 = (forall r. SomeSEXP s -> (() -> r) -> (MatcherError s -> r) -> r)
-> Matcher s ()
forall s a.
(forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r)
-> Matcher s a
Matcher ((forall r. SomeSEXP s -> (() -> r) -> (MatcherError s -> r) -> r)
-> Matcher s ())
-> (forall r.
SomeSEXP s -> (() -> r) -> (MatcherError s -> r) -> r)
-> Matcher s ()
forall a b. (a -> b) -> a -> b
$ \(SomeSEXP s :: SEXP s a
s) ok :: () -> r
ok err :: MatcherError s -> r
err ->
if SEXP s a -> Bool
forall s (ty :: SEXPTYPE). SEXP s ty -> Bool
R.isS4 SEXP s a
s
then () -> r
ok ()
else MatcherError s -> r
err (SomeSEXP s -> SEXPTYPE -> SEXPTYPE -> MatcherError s
forall s. SomeSEXP s -> SEXPTYPE -> SEXPTYPE -> MatcherError s
TypeMissmatch (SEXP s a -> SomeSEXP s
forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP SEXP s a
s) (SEXP s a -> SEXPTYPE
forall s (a :: SEXPTYPE). SEXP s a -> SEXPTYPE
R.typeOf SEXP s a
s) SEXPTYPE
R.S4)
s3 :: [String] -> Matcher s ()
s3 :: [String] -> Matcher s ()
s3 ns :: [String]
ns = Matcher s [String]
forall s. Matcher s [String]
getS3Class Matcher s [String] -> ([String] -> Matcher s ()) -> Matcher s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Matcher s ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Matcher s ())
-> ([String] -> Bool) -> [String] -> Matcher s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String]
ns [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
==)
guardType :: R.SEXPTYPE -> Matcher s ()
guardType :: SEXPTYPE -> Matcher s ()
guardType s :: SEXPTYPE
s = Matcher s SEXPTYPE
forall s. Matcher s SEXPTYPE
typeOf Matcher s SEXPTYPE -> (SEXPTYPE -> Matcher s ()) -> Matcher s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Matcher s ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Matcher s ())
-> (SEXPTYPE -> Bool) -> SEXPTYPE -> Matcher s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SEXPTYPE
s SEXPTYPE -> SEXPTYPE -> Bool
forall a. Eq a => a -> a -> Bool
==)
someAttribute :: String -> Matcher s (SomeSEXP s)
someAttribute :: String -> Matcher s (SomeSEXP s)
someAttribute n :: String
n = (forall r.
SomeSEXP s -> (SomeSEXP s -> r) -> (MatcherError s -> r) -> r)
-> Matcher s (SomeSEXP s)
forall s a.
(forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r)
-> Matcher s a
Matcher ((forall r.
SomeSEXP s -> (SomeSEXP s -> r) -> (MatcherError s -> r) -> r)
-> Matcher s (SomeSEXP s))
-> (forall r.
SomeSEXP s -> (SomeSEXP s -> r) -> (MatcherError s -> r) -> r)
-> Matcher s (SomeSEXP s)
forall a b. (a -> b) -> a -> b
$ \(SomeSEXP s :: SEXP s a
s) ok :: SomeSEXP s -> r
ok err :: MatcherError s -> r
err ->
let result :: SEXP s Any
result = IO (SEXP s Any) -> SEXP s Any
forall a. IO a -> a
unsafePerformIO (IO (SEXP s Any) -> SEXP s Any) -> IO (SEXP s Any) -> SEXP s Any
forall a b. (a -> b) -> a -> b
$ do
SEXP V 'Symbol
c <- String -> (CString -> IO (SEXP V 'Symbol)) -> IO (SEXP V 'Symbol)
forall a. String -> (CString -> IO a) -> IO a
withCString String
n CString -> IO (SEXP V 'Symbol)
R.install
SEXP s Any -> IO (SEXP s Any)
forall a. a -> IO a
evaluate (SEXP s Any -> IO (SEXP s Any)) -> SEXP s Any -> IO (SEXP s Any)
forall a b. (a -> b) -> a -> b
$ SEXP s a -> SEXP V 'Symbol -> SEXP s Any
forall s (a :: SEXPTYPE) s2 (b :: SEXPTYPE) (c :: SEXPTYPE).
SEXP s a -> SEXP s2 b -> SEXP s c
R.getAttribute SEXP s a
s SEXP V 'Symbol
c
in case SEXP s Any -> SEXPTYPE
forall s (a :: SEXPTYPE). SEXP s a -> SEXPTYPE
R.typeOf SEXP s Any
result of
R.Nil -> MatcherError s -> r
err (SomeSEXP s -> String -> MatcherError s
forall s. SomeSEXP s -> String -> MatcherError s
NoSuchAttribute (SEXP s a -> SomeSEXP s
forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP SEXP s a
s) String
n)
_ -> SomeSEXP s -> r
ok (SEXP s Any -> SomeSEXP s
forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP SEXP s Any
result)
attribute :: SSEXPTYPE a -> String -> Matcher s (SEXP s a)
attribute :: SSEXPTYPE a -> String -> Matcher s (SEXP s a)
attribute p :: SSEXPTYPE a
p s :: String
s = do
(SomeSEXP z :: SEXP s a
z) <- String -> Matcher s (SomeSEXP s)
forall s. String -> Matcher s (SomeSEXP s)
someAttribute String
s
if Sing a -> Demote SEXPTYPE
forall k (a :: k). SingKind k => Sing a -> Demote k
fromSing Sing a
SSEXPTYPE a
p SEXPTYPE -> SEXPTYPE -> Bool
forall a. Eq a => a -> a -> Bool
== SEXP s a -> SEXPTYPE
forall s (a :: SEXPTYPE). SEXP s a -> SEXPTYPE
H.typeOf SEXP s a
z
then SEXP s a -> Matcher s (SEXP s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (SEXP s a -> Matcher s (SEXP s a))
-> SEXP s a -> Matcher s (SEXP s a)
forall a b. (a -> b) -> a -> b
$ SEXP s a -> SEXP s a
forall s (a :: SEXPTYPE) (b :: SEXPTYPE). SEXP s a -> SEXP s b
R.unsafeCoerce SEXP s a
z
else Matcher s (SEXP s a)
forall (f :: * -> *) a. Alternative f => f a
empty
attributes :: Matcher s (Maybe a) -> Matcher s [(String, a)]
attributes :: Matcher s (Maybe a) -> Matcher s [(String, a)]
attributes p :: Matcher s (Maybe a)
p = do
SomeSEXP s :: SEXP s a
s <- Matcher s (SomeSEXP s)
forall s. Matcher s (SomeSEXP s)
somesexp
let sa :: SomeSEXP s
sa = IO (SomeSEXP s) -> SomeSEXP s
forall a. IO a -> a
unsafePerformIO (IO (SomeSEXP s) -> SomeSEXP s) -> IO (SomeSEXP s) -> SomeSEXP s
forall a b. (a -> b) -> a -> b
$ SEXP s Any -> SomeSEXP s
forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP (SEXP s Any -> SomeSEXP s) -> IO (SEXP s Any) -> IO (SomeSEXP s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEXP s a -> IO (SEXP s Any)
forall s (a :: SEXPTYPE) (b :: SEXPTYPE). SEXP s a -> IO (SEXP s b)
R.getAttributes SEXP s a
s
SomeSEXP s -> Matcher s [(String, a)] -> Matcher s [(String, a)]
forall s a. SomeSEXP s -> Matcher s a -> Matcher s a
with SomeSEXP s
sa (Matcher s [(String, a)] -> Matcher s [(String, a)])
-> Matcher s [(String, a)] -> Matcher s [(String, a)]
forall a b. (a -> b) -> a -> b
$ [Matcher s [(String, a)]] -> Matcher s [(String, a)]
forall s a. [Matcher s a] -> Matcher s a
choice
[ Matcher s ()
forall s. Matcher s ()
null Matcher s () -> Matcher s [(String, a)] -> Matcher s [(String, a)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [(String, a)] -> Matcher s [(String, a)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
, do Maybe [String]
mns <- Matcher s [String] -> Matcher s (Maybe [String])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Matcher s [String]
forall s. Matcher s [String]
names
case Maybe [String]
mns of
Nothing -> [(String, a)] -> Matcher s [(String, a)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Just ns :: [String]
ns -> do
[Maybe a]
ps <- Int -> Matcher s (Maybe a) -> Matcher s [Maybe a]
forall s a. Int -> Matcher s a -> Matcher s [a]
list ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ns) Matcher s (Maybe a)
p
[(String, a)] -> Matcher s [(String, a)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, a)] -> Matcher s [(String, a)])
-> [(String, a)] -> Matcher s [(String, a)]
forall a b. (a -> b) -> a -> b
$ ((String, Maybe a) -> Maybe (String, a))
-> [(String, Maybe a)] -> [(String, a)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(x :: String
x,y :: Maybe a
y) -> (a -> (String, a)) -> Maybe a -> Maybe (String, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
x,) Maybe a
y) ([(String, Maybe a)] -> [(String, a)])
-> [(String, Maybe a)] -> [(String, a)]
forall a b. (a -> b) -> a -> b
$ [String] -> [Maybe a] -> [(String, Maybe a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
ns [Maybe a]
ps
, [(String, a)] -> Matcher s [(String, a)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
]
lookupAttribute :: String -> Matcher s (Maybe (SomeSEXP s))
lookupAttribute :: String -> Matcher s (Maybe (SomeSEXP s))
lookupAttribute s :: String
s = (SomeSEXP s -> Maybe (SomeSEXP s)
forall a. a -> Maybe a
Just (SomeSEXP s -> Maybe (SomeSEXP s))
-> Matcher s (SomeSEXP s) -> Matcher s (Maybe (SomeSEXP s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Matcher s (SomeSEXP s)
forall s. String -> Matcher s (SomeSEXP s)
someAttribute String
s) Matcher s (Maybe (SomeSEXP s))
-> Matcher s (Maybe (SomeSEXP s)) -> Matcher s (Maybe (SomeSEXP s))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (SomeSEXP s) -> Matcher s (Maybe (SomeSEXP s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (SomeSEXP s)
forall a. Maybe a
Nothing
hexp :: SSEXPTYPE ty -> (HExp s ty -> Matcher s a) -> Matcher s a
hexp :: SSEXPTYPE ty -> (HExp s ty -> Matcher s a) -> Matcher s a
hexp ty :: SSEXPTYPE ty
ty f :: HExp s ty -> Matcher s a
f = HExp s ty -> Matcher s a
f (HExp s ty -> Matcher s a)
-> (SEXP s ty -> HExp s ty) -> SEXP s ty -> Matcher s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SEXP s ty -> HExp s ty
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
H.hexp (SEXP s ty -> Matcher s a) -> Matcher s (SEXP s ty) -> Matcher s a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SSEXPTYPE ty -> Matcher s (SEXP s ty)
forall (ty :: SEXPTYPE) s. SSEXPTYPE ty -> Matcher s (SEXP s ty)
sexp SSEXPTYPE ty
ty
typeOf :: Matcher s R.SEXPTYPE
typeOf :: Matcher s SEXPTYPE
typeOf = (\(SomeSEXP s :: SEXP s a
s) -> SEXP s a -> SEXPTYPE
forall s (a :: SEXPTYPE). SEXP s a -> SEXPTYPE
H.typeOf SEXP s a
s) (SomeSEXP s -> SEXPTYPE)
-> Matcher s (SomeSEXP s) -> Matcher s SEXPTYPE
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Matcher s (SomeSEXP s)
forall s. Matcher s (SomeSEXP s)
somesexp
getS3Class :: Matcher s [String]
getS3Class :: Matcher s [String]
getS3Class = SEXP s 'String -> [String]
forall s. SEXP s 'String -> [String]
charList (SEXP s 'String -> [String])
-> Matcher s (SEXP s 'String) -> Matcher s [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SSEXPTYPE 'String -> String -> Matcher s (SEXP s 'String)
forall (a :: SEXPTYPE) s.
SSEXPTYPE a -> String -> Matcher s (SEXP s a)
attribute SSEXPTYPE 'String
SString "class"
charList :: SEXP s 'R.String -> [String]
charList :: SEXP s 'String -> [String]
charList (SEXP s 'String -> HExp s 'String
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
H.hexp -> String v :: Vector 'String (SEXP V 'Char)
v) =
(SEXP V 'Char -> String) -> [SEXP V 'Char] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((\(Char s :: Vector 'Char Word8
s) -> Vector 'Char Word8 -> String
SV.toString Vector 'Char Word8
s) (HExp V 'Char -> String)
-> (SEXP V 'Char -> HExp V 'Char) -> SEXP V 'Char -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SEXP V 'Char -> HExp V 'Char
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
H.hexp) ([SEXP V 'Char] -> [String]) -> [SEXP V 'Char] -> [String]
forall a b. (a -> b) -> a -> b
$ Vector 'String (SEXP V 'Char) -> [SEXP V 'Char]
forall (ty :: SEXPTYPE) a. SVECTOR ty a => Vector ty a -> [a]
SV.toList Vector 'String (SEXP V 'Char)
v
charList _ = String -> [String]
forall a. HasCallStack => String -> a
error "Impossible happened."
dim :: Matcher s [Int]
dim :: Matcher s [Int]
dim = SEXP s 'Int -> [Int]
forall s. SEXP s 'Int -> [Int]
go (SEXP s 'Int -> [Int])
-> Matcher s (SEXP s 'Int) -> Matcher s [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SSEXPTYPE 'Int -> String -> Matcher s (SEXP s 'Int)
forall (a :: SEXPTYPE) s.
SSEXPTYPE a -> String -> Matcher s (SEXP s a)
attribute SSEXPTYPE 'Int
SInt "dim"
where
go :: SEXP s 'R.Int -> [Int]
go :: SEXP s 'Int -> [Int]
go (SEXP s 'Int -> HExp s 'Int
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
H.hexp -> Int v :: Vector 'Int Int32
v) = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int) -> [Int32] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector 'Int Int32 -> [Int32]
forall (ty :: SEXPTYPE) a. SVECTOR ty a => Vector ty a -> [a]
SV.toList Vector 'Int Int32
v
go _ = String -> [Int]
forall a. HasCallStack => String -> a
error "Impossible happened."
dimnames :: Matcher s [[String]]
dimnames :: Matcher s [[String]]
dimnames = do
SEXP s 'Vector
s <- SSEXPTYPE 'Vector -> String -> Matcher s (SEXP s 'Vector)
forall (a :: SEXPTYPE) s.
SSEXPTYPE a -> String -> Matcher s (SEXP s a)
attribute SSEXPTYPE 'Vector
SVector "dimnames"
case SEXP s 'Vector -> HExp s 'Vector
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
H.hexp SEXP s 'Vector
s of
Vector _ v :: Vector 'Vector (SomeSEXP V)
v -> [SomeSEXP V]
-> (SomeSEXP V -> Matcher s [String]) -> Matcher s [[String]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Vector 'Vector (SomeSEXP V) -> [SomeSEXP V]
forall (ty :: SEXPTYPE) a. SVECTOR ty a => Vector ty a -> [a]
SV.toList Vector 'Vector (SomeSEXP V)
v) ((SomeSEXP V -> Matcher s [String]) -> Matcher s [[String]])
-> (SomeSEXP V -> Matcher s [String]) -> Matcher s [[String]]
forall a b. (a -> b) -> a -> b
$ \x :: SomeSEXP V
x ->
SomeSEXP s -> Matcher s [String] -> Matcher s [String]
forall s a. SomeSEXP s -> Matcher s a -> Matcher s a
with (SomeSEXP V -> SomeSEXP s
forall s g. SomeSEXP s -> SomeSEXP g
R.unsafeReleaseSome SomeSEXP V
x) Matcher s [String]
forall s. Matcher s [String]
go
where
go :: Matcher s [String]
go = [Matcher s [String]] -> Matcher s [String]
forall s a. [Matcher s a] -> Matcher s a
choice [SEXP s 'String -> [String]
forall s. SEXP s 'String -> [String]
charList (SEXP s 'String -> [String])
-> Matcher s (SEXP s 'String) -> Matcher s [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SSEXPTYPE 'String -> Matcher s (SEXP s 'String)
forall (ty :: SEXPTYPE) s. SSEXPTYPE ty -> Matcher s (SEXP s ty)
sexp SSEXPTYPE 'String
SString, Matcher s ()
forall s. Matcher s ()
null Matcher s () -> Matcher s [String] -> Matcher s [String]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [String] -> Matcher s [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []]
names :: Matcher s [String]
names :: Matcher s [String]
names = do
SEXP s 'String
s <- SSEXPTYPE 'String -> String -> Matcher s (SEXP s 'String)
forall (a :: SEXPTYPE) s.
SSEXPTYPE a -> String -> Matcher s (SEXP s a)
attribute SSEXPTYPE 'String
SString "names"
[String] -> Matcher s [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> Matcher s [String]) -> [String] -> Matcher s [String]
forall a b. (a -> b) -> a -> b
$ SEXP s 'String -> [String]
forall s. SEXP s 'String -> [String]
charList SEXP s 'String
s
rownames :: Matcher s [String]
rownames :: Matcher s [String]
rownames = do
SEXP s 'String
s <- SSEXPTYPE 'String -> String -> Matcher s (SEXP s 'String)
forall (a :: SEXPTYPE) s.
SSEXPTYPE a -> String -> Matcher s (SEXP s a)
attribute SSEXPTYPE 'String
SString "row.names"
[String] -> Matcher s [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> Matcher s [String]) -> [String] -> Matcher s [String]
forall a b. (a -> b) -> a -> b
$ SEXP s 'String -> [String]
forall s. SEXP s 'String -> [String]
charList SEXP s 'String
s
choice :: [Matcher s a] -> Matcher s a
choice :: [Matcher s a] -> Matcher s a
choice = [Matcher s a] -> Matcher s a
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
list
:: Int
-> Matcher s a
-> Matcher s [a]
list :: Int -> Matcher s a -> Matcher s [a]
list 0 _ = [a] -> Matcher s [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
list n :: Int
n p :: Matcher s a
p = [Matcher s [a]] -> Matcher s [a]
forall s a. [Matcher s a] -> Matcher s a
choice
[ Matcher s ()
forall s. Matcher s ()
null Matcher s () -> Matcher s [a] -> Matcher s [a]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [a] -> Matcher s [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
, SSEXPTYPE 'List -> (HExp s 'List -> Matcher s [a]) -> Matcher s [a]
forall (ty :: SEXPTYPE) s a.
SSEXPTYPE ty -> (HExp s ty -> Matcher s a) -> Matcher s a
hexp SSEXPTYPE 'List
SList ((HExp s 'List -> Matcher s [a]) -> Matcher s [a])
-> (HExp s 'List -> Matcher s [a]) -> Matcher s [a]
forall a b. (a -> b) -> a -> b
$ \(List car :: SEXP s a
car cdr :: SEXP s b
cdr _) -> do
a
v <- SomeSEXP s -> Matcher s a -> Matcher s a
forall s a. SomeSEXP s -> Matcher s a -> Matcher s a
with (SEXP s a -> SomeSEXP s
forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP SEXP s a
car) Matcher s a
p
[a]
vs <- SomeSEXP s -> Matcher s [a] -> Matcher s [a]
forall s a. SomeSEXP s -> Matcher s a -> Matcher s a
with (SEXP s b -> SomeSEXP s
forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP SEXP s b
cdr) (Matcher s [a] -> Matcher s [a]) -> Matcher s [a] -> Matcher s [a]
forall a b. (a -> b) -> a -> b
$ Int -> Matcher s a -> Matcher s [a]
forall s a. Int -> Matcher s a -> Matcher s [a]
list (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) Matcher s a
p
[a] -> Matcher s [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
va -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
vs)
]
factor :: Matcher s [String]
factor :: Matcher s [String]
factor = do
[String] -> Matcher s ()
forall s. [String] -> Matcher s ()
s3 ["factor"]
[String]
levels <- SEXP s 'String -> [String]
forall s. SEXP s 'String -> [String]
charList (SEXP s 'String -> [String])
-> Matcher s (SEXP s 'String) -> Matcher s [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SSEXPTYPE 'String -> String -> Matcher s (SEXP s 'String)
forall (a :: SEXPTYPE) s.
SSEXPTYPE a -> String -> Matcher s (SEXP s a)
attribute SSEXPTYPE 'String
SString "levels"
SSEXPTYPE 'Int
-> (HExp s 'Int -> Matcher s [String]) -> Matcher s [String]
forall (ty :: SEXPTYPE) s a.
SSEXPTYPE ty -> (HExp s ty -> Matcher s a) -> Matcher s a
hexp SSEXPTYPE 'Int
R.SInt ((HExp s 'Int -> Matcher s [String]) -> Matcher s [String])
-> (HExp s 'Int -> Matcher s [String]) -> Matcher s [String]
forall a b. (a -> b) -> a -> b
$ \(Int v :: Vector 'Int Int32
v) ->
[String] -> Matcher s [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> Matcher s [String]) -> [String] -> Matcher s [String]
forall a b. (a -> b) -> a -> b
$! (\i :: Int32
i -> [String]
levels [String] -> Int -> String
forall a. [a] -> Int -> a
!! (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)) (Int32 -> String) -> [Int32] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector 'Int Int32 -> [Int32]
forall (ty :: SEXPTYPE) a. SVECTOR ty a => Vector ty a -> [a]
SV.toList Vector 'Int Int32
v