{-# 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
{ forall s a.
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 :: forall a. a -> Matcher s a
return a
x = forall s a.
(forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r)
-> Matcher s a
Matcher forall a b. (a -> b) -> a -> b
$ \SomeSEXP s
_ a -> r
f MatcherError s -> r
_ -> a -> r
f a
x
Matcher forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r
f >>= :: forall a b. Matcher s a -> (a -> Matcher s b) -> Matcher s b
>>= a -> Matcher s b
k = forall s a.
(forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r)
-> Matcher s a
Matcher forall a b. (a -> b) -> a -> b
$ \SomeSEXP s
s b -> r
ok MatcherError s -> r
err -> forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r
f SomeSEXP s
s (\a
o -> 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 :: forall a. String -> Matcher s a
fail String
s = forall s a.
(forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r)
-> Matcher s a
Matcher forall a b. (a -> b) -> a -> b
$ \SomeSEXP s
_ a -> r
_ MatcherError s -> r
err -> MatcherError s -> r
err forall a b. (a -> b) -> a -> b
$ forall s. String -> MatcherError s
MatcherError String
s
instance Applicative (Matcher s) where
pure :: forall a. a -> Matcher s a
pure = forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: forall a 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 :: forall a b. (a -> b) -> Matcher s a -> Matcher s b
fmap = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance Alternative (Matcher s) where
empty :: forall a. Matcher s a
empty = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"empty"
Matcher s a
f <|> :: forall a. Matcher s a -> Matcher s a -> Matcher s a
<|> Matcher s a
g = forall s a.
(forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r)
-> Matcher s a
Matcher forall a b. (a -> b) -> a -> b
$ \SomeSEXP s
s a -> r
ok MatcherError s -> r
err ->
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 (\MatcherError s
e' -> 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Monoid a => a -> a -> a
mappend MatcherError s
e')))
instance Sem.Semigroup (MatcherError s) where
MatcherError s
a <> :: MatcherError s -> MatcherError s -> MatcherError s
<> MatcherError String
"empty" = MatcherError s
a
MatcherError s
_ <> MatcherError s
a = MatcherError s
a
instance Monoid (MatcherError s) where
mempty :: MatcherError s
mempty = forall s. String -> MatcherError s
MatcherError String
"empty"
mappend :: MatcherError s -> MatcherError s -> MatcherError s
mappend = 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
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 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 :: forall (m :: * -> *) a s.
(MonadR m, NFData a) =>
Matcher s a -> SomeSEXP s -> m (Either (MatcherError s) a)
matchOnly Matcher s a
p SomeSEXP s
s =
forall s a.
Matcher s a
-> forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r
runMatcher Matcher s a
p SomeSEXP s
s (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NFData a => a -> a
force forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NFData a => a -> a
force forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left)
somesexp :: Matcher s (SomeSEXP s)
somesexp :: forall s. Matcher s (SomeSEXP s)
somesexp = forall s a.
(forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r)
-> Matcher s a
Matcher forall a b. (a -> b) -> a -> b
$ \SomeSEXP s
s SomeSEXP s -> r
ok MatcherError s -> r
_ -> SomeSEXP s -> r
ok SomeSEXP s
s
sexp :: SSEXPTYPE ty -> Matcher s (SEXP s ty)
sexp :: forall (ty :: SEXPTYPE) s. SSEXPTYPE ty -> Matcher s (SEXP s ty)
sexp SSEXPTYPE ty
p = forall s a.
(forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r)
-> Matcher s a
Matcher forall a b. (a -> b) -> a -> b
$ \(SomeSEXP SEXP s a
s) SEXP s ty -> r
ok MatcherError s -> r
err ->
if forall k (a :: k). SingKind k => Sing a -> Demote k
fromSing SSEXPTYPE ty
p forall a. Eq a => a -> a -> Bool
== forall s (a :: SEXPTYPE). SEXP s a -> SEXPTYPE
H.typeOf SEXP s a
s
then SEXP s ty -> r
ok (forall s (a :: SEXPTYPE) (b :: SEXPTYPE). SEXP s a -> SEXP s b
R.unsafeCoerce SEXP s a
s)
else MatcherError s -> r
err forall a b. (a -> b) -> a -> b
$ forall s. SomeSEXP s -> SEXPTYPE -> SEXPTYPE -> MatcherError s
TypeMissmatch (forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP SEXP s a
s) (forall s (a :: SEXPTYPE). SEXP s a -> SEXPTYPE
R.typeOf SEXP s a
s) (forall k (a :: k). SingKind k => Sing a -> Demote k
fromSing SSEXPTYPE ty
p)
with :: SomeSEXP s -> Matcher s a -> Matcher s a
with :: forall s a. SomeSEXP s -> Matcher s a -> Matcher s a
with SomeSEXP s
s Matcher s a
p = forall s a.
(forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r)
-> Matcher s a
Matcher forall a b. (a -> b) -> a -> b
$ \SomeSEXP s
_ a -> r
ok MatcherError s -> r
err -> 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 :: forall s. Matcher s ()
null = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (ty :: SEXPTYPE) s. SSEXPTYPE ty -> Matcher s (SEXP s ty)
sexp SSEXPTYPE 'Nil
SNil
s4 :: Matcher s ()
s4 :: forall s. Matcher s ()
s4 = forall s a.
(forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r)
-> Matcher s a
Matcher forall a b. (a -> b) -> a -> b
$ \(SomeSEXP SEXP s a
s) () -> r
ok MatcherError s -> r
err ->
if forall s (ty :: SEXPTYPE). SEXP s ty -> Bool
R.isS4 SEXP s a
s
then () -> r
ok ()
else MatcherError s -> r
err (forall s. SomeSEXP s -> SEXPTYPE -> SEXPTYPE -> MatcherError s
TypeMissmatch (forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP SEXP s a
s) (forall s (a :: SEXPTYPE). SEXP s a -> SEXPTYPE
R.typeOf SEXP s a
s) SEXPTYPE
R.S4)
s3 :: [String] -> Matcher s ()
s3 :: forall s. [String] -> Matcher s ()
s3 [String]
ns = forall s. Matcher s [String]
getS3Class forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String]
ns forall a. Eq a => a -> a -> Bool
==)
guardType :: R.SEXPTYPE -> Matcher s ()
guardType :: forall s. SEXPTYPE -> Matcher s ()
guardType SEXPTYPE
s = forall s. Matcher s SEXPTYPE
typeOf forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SEXPTYPE
s forall a. Eq a => a -> a -> Bool
==)
someAttribute :: String -> Matcher s (SomeSEXP s)
someAttribute :: forall s. String -> Matcher s (SomeSEXP s)
someAttribute String
n = forall s a.
(forall r. SomeSEXP s -> (a -> r) -> (MatcherError s -> r) -> r)
-> Matcher s a
Matcher forall a b. (a -> b) -> a -> b
$ \(SomeSEXP SEXP s a
s) SomeSEXP s -> r
ok MatcherError s -> r
err ->
let result :: SEXP s Any
result = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
SEXP V 'Symbol
c <- forall a. String -> (CString -> IO a) -> IO a
withCString String
n CString -> IO (SEXP V 'Symbol)
R.install
forall a. a -> IO a
evaluate forall a b. (a -> b) -> a -> b
$ 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 forall s (a :: SEXPTYPE). SEXP s a -> SEXPTYPE
R.typeOf SEXP s Any
result of
SEXPTYPE
R.Nil -> MatcherError s -> r
err (forall s. SomeSEXP s -> String -> MatcherError s
NoSuchAttribute (forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP SEXP s a
s) String
n)
SEXPTYPE
_ -> SomeSEXP s -> r
ok (forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP SEXP s Any
result)
attribute :: SSEXPTYPE a -> String -> Matcher s (SEXP s a)
attribute :: forall (a :: SEXPTYPE) s.
SSEXPTYPE a -> String -> Matcher s (SEXP s a)
attribute SSEXPTYPE a
p String
s = do
(SomeSEXP SEXP s a
z) <- forall s. String -> Matcher s (SomeSEXP s)
someAttribute String
s
if forall k (a :: k). SingKind k => Sing a -> Demote k
fromSing SSEXPTYPE a
p forall a. Eq a => a -> a -> Bool
== forall s (a :: SEXPTYPE). SEXP s a -> SEXPTYPE
H.typeOf SEXP s a
z
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s (a :: SEXPTYPE) (b :: SEXPTYPE). SEXP s a -> SEXP s b
R.unsafeCoerce SEXP s a
z
else forall (f :: * -> *) a. Alternative f => f a
empty
attributes :: Matcher s (Maybe a) -> Matcher s [(String, a)]
attributes :: forall s a. Matcher s (Maybe a) -> Matcher s [(String, a)]
attributes Matcher s (Maybe a)
p = do
SomeSEXP SEXP s a
s <- forall s. Matcher s (SomeSEXP s)
somesexp
let sa :: SomeSEXP s
sa = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (a :: SEXPTYPE) (b :: SEXPTYPE). SEXP s a -> IO (SEXP s b)
R.getAttributes SEXP s a
s
forall s a. SomeSEXP s -> Matcher s a -> Matcher s a
with SomeSEXP s
sa forall a b. (a -> b) -> a -> b
$ forall s a. [Matcher s a] -> Matcher s a
choice
[ forall s. Matcher s ()
null forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
, do Maybe [String]
mns <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall s. Matcher s [String]
names
case Maybe [String]
mns of
Maybe [String]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
Just [String]
ns -> do
[Maybe a]
ps <- forall s a. Int -> Matcher s a -> Matcher s [a]
list (forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ns) Matcher s (Maybe a)
p
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(String
x,Maybe a
y) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
x,) Maybe a
y) forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [String]
ns [Maybe a]
ps
, forall (f :: * -> *) a. Applicative f => a -> f a
pure []
]
lookupAttribute :: String -> Matcher s (Maybe (SomeSEXP s))
lookupAttribute :: forall s. String -> Matcher s (Maybe (SomeSEXP s))
lookupAttribute String
s = (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. String -> Matcher s (SomeSEXP s)
someAttribute String
s) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
hexp :: SSEXPTYPE ty -> (HExp s ty -> Matcher s a) -> Matcher s a
hexp :: forall (ty :: SEXPTYPE) s a.
SSEXPTYPE ty -> (HExp s ty -> Matcher s a) -> Matcher s a
hexp SSEXPTYPE ty
ty HExp s ty -> Matcher s a
f = HExp s ty -> Matcher s a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
H.hexp forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (ty :: SEXPTYPE) s. SSEXPTYPE ty -> Matcher s (SEXP s ty)
sexp SSEXPTYPE ty
ty
typeOf :: Matcher s R.SEXPTYPE
typeOf :: forall s. Matcher s SEXPTYPE
typeOf = (\(SomeSEXP SEXP s a
s) -> forall s (a :: SEXPTYPE). SEXP s a -> SEXPTYPE
H.typeOf SEXP s a
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Matcher s (SomeSEXP s)
somesexp
getS3Class :: Matcher s [String]
getS3Class :: forall s. Matcher s [String]
getS3Class = forall s. SEXP s 'String -> [String]
charList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (a :: SEXPTYPE) s.
SSEXPTYPE a -> String -> Matcher s (SEXP s a)
attribute SSEXPTYPE 'String
SString String
"class"
charList :: SEXP s 'R.String -> [String]
charList :: forall s. SEXP s 'String -> [String]
charList (forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
H.hexp -> String Vector 'String (SEXP V 'Char)
v) =
forall a b. (a -> b) -> [a] -> [b]
map ((\(Char Vector 'Char Word8
s) -> Vector 'Char Word8 -> String
SV.toString Vector 'Char Word8
s) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
H.hexp) forall a b. (a -> b) -> a -> b
$ forall (ty :: SEXPTYPE) a. SVECTOR ty a => Vector ty a -> [a]
SV.toList Vector 'String (SEXP V 'Char)
v
dim :: Matcher s [Int]
dim :: forall s. Matcher s [Int]
dim = forall s. SEXP s 'Int -> [Int]
go forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (a :: SEXPTYPE) s.
SSEXPTYPE a -> String -> Matcher s (SEXP s a)
attribute SSEXPTYPE 'Int
SInt String
"dim"
where
go :: SEXP s 'R.Int -> [Int]
go :: forall s. SEXP s 'Int -> [Int]
go (forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
H.hexp -> Int Vector 'Int Int32
v) = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (ty :: SEXPTYPE) a. SVECTOR ty a => Vector ty a -> [a]
SV.toList Vector 'Int Int32
v
dimnames :: Matcher s [[String]]
dimnames :: forall s. Matcher s [[String]]
dimnames = do
SEXP s 'Vector
s <- forall (a :: SEXPTYPE) s.
SSEXPTYPE a -> String -> Matcher s (SEXP s a)
attribute SSEXPTYPE 'Vector
SVector String
"dimnames"
case forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
H.hexp SEXP s 'Vector
s of
Vector Int32
_ Vector 'Vector (SomeSEXP V)
v -> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (forall (ty :: SEXPTYPE) a. SVECTOR ty a => Vector ty a -> [a]
SV.toList Vector 'Vector (SomeSEXP V)
v) forall a b. (a -> b) -> a -> b
$ \SomeSEXP V
x ->
forall s a. SomeSEXP s -> Matcher s a -> Matcher s a
with (forall s g. SomeSEXP s -> SomeSEXP g
R.unsafeReleaseSome SomeSEXP V
x) forall s. Matcher s [String]
go
where
go :: Matcher s [String]
go = forall s a. [Matcher s a] -> Matcher s a
choice [forall s. SEXP s 'String -> [String]
charList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (ty :: SEXPTYPE) s. SSEXPTYPE ty -> Matcher s (SEXP s ty)
sexp SSEXPTYPE 'String
SString, forall s. Matcher s ()
null forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure []]
names :: Matcher s [String]
names :: forall s. Matcher s [String]
names = do
SEXP s 'String
s <- forall (a :: SEXPTYPE) s.
SSEXPTYPE a -> String -> Matcher s (SEXP s a)
attribute SSEXPTYPE 'String
SString String
"names"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s. SEXP s 'String -> [String]
charList SEXP s 'String
s
rownames :: Matcher s [String]
rownames :: forall s. Matcher s [String]
rownames = do
SEXP s 'String
s <- forall (a :: SEXPTYPE) s.
SSEXPTYPE a -> String -> Matcher s (SEXP s a)
attribute SSEXPTYPE 'String
SString String
"row.names"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s. SEXP s 'String -> [String]
charList SEXP s 'String
s
choice :: [Matcher s a] -> Matcher s a
choice :: forall s a. [Matcher s a] -> Matcher s a
choice = forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
list
:: Int
-> Matcher s a
-> Matcher s [a]
list :: forall s a. Int -> Matcher s a -> Matcher s [a]
list Int
0 Matcher s a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return []
list Int
n Matcher s a
p = forall s a. [Matcher s a] -> Matcher s a
choice
[ forall s. Matcher s ()
null forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
, forall (ty :: SEXPTYPE) s a.
SSEXPTYPE ty -> (HExp s ty -> Matcher s a) -> Matcher s a
hexp SSEXPTYPE 'List
SList forall a b. (a -> b) -> a -> b
$ \(List SEXP s a1
car SEXP s b1
cdr SEXP s c
_) -> do
a
v <- forall s a. SomeSEXP s -> Matcher s a -> Matcher s a
with (forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP SEXP s a1
car) Matcher s a
p
[a]
vs <- forall s a. SomeSEXP s -> Matcher s a -> Matcher s a
with (forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP SEXP s b1
cdr) forall a b. (a -> b) -> a -> b
$ forall s a. Int -> Matcher s a -> Matcher s [a]
list (Int
nforall a. Num a => a -> a -> a
-Int
1) Matcher s a
p
forall (m :: * -> *) a. Monad m => a -> m a
return (a
vforall a. a -> [a] -> [a]
:[a]
vs)
]
factor :: Matcher s [String]
factor :: forall s. Matcher s [String]
factor = do
forall s. [String] -> Matcher s ()
s3 [String
"factor"]
[String]
levels <- forall s. SEXP s 'String -> [String]
charList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (a :: SEXPTYPE) s.
SSEXPTYPE a -> String -> Matcher s (SEXP s a)
attribute SSEXPTYPE 'String
SString String
"levels"
forall (ty :: SEXPTYPE) s a.
SSEXPTYPE ty -> (HExp s ty -> Matcher s a) -> Matcher s a
hexp SSEXPTYPE 'Int
R.SInt forall a b. (a -> b) -> a -> b
$ \(Int Vector 'Int Int32
v) ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (\Int32
i -> [String]
levels forall a. [a] -> Int -> a
!! (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i forall a. Num a => a -> a -> a
- Int
1)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (ty :: SEXPTYPE) a. SVECTOR ty a => Vector ty a -> [a]
SV.toList Vector 'Int Int32
v