{-# LINE 1 "src/Text/Regex/Posix/Wrap.hsc" #-}
{-# OPTIONS_GHC -Wall -fno-warn-unused-imports #-}
module Text.Regex.Posix.Wrap(
Regex,
RegOffset,
RegOffsetT,
(=~),
(=~~),
WrapError,
wrapCompile,
wrapTest,
wrapMatch,
wrapMatchAll,
wrapCount,
unusedRegOffset,
CompOption(CompOption),
compBlank,
compExtended,
compIgnoreCase,
compNoSub,
compNewline,
ExecOption(ExecOption),
execBlank,
execNotBOL,
execNotEOL,
ReturnCode(ReturnCode),
retBadbr,
retBadpat,
retBadrpt,
retEcollate,
retEctype,
retEescape,
retEsubreg,
retEbrack,
retEparen,
retEbrace,
retErange,
retEspace
) where
{-# LINE 95 "src/Text/Regex/Posix/Wrap.hsc" #-}
import Prelude hiding (fail)
import Control.Monad.Fail (MonadFail)
import Control.Monad(liftM)
import Data.Array(Array,listArray)
import Data.Bits(Bits(..))
import Data.Int(Int32,Int64)
import Data.Word(Word32,Word64)
import Foreign(Ptr, FunPtr, nullPtr, newForeignPtr,
addForeignPtrFinalizer, Storable(peekByteOff), allocaArray,
allocaBytes, withForeignPtr,ForeignPtr,plusPtr,peekElemOff)
import Foreign.Marshal.Alloc(mallocBytes)
import Foreign.C(CChar)
{-# LINE 114 "src/Text/Regex/Posix/Wrap.hsc" #-}
import Foreign.C(CSize(CSize),CInt(CInt))
{-# LINE 118 "src/Text/Regex/Posix/Wrap.hsc" #-}
import Foreign.C.String(peekCAString, CString)
import Text.Regex.Base.RegexLike(RegexOptions(..),RegexMaker(..),RegexContext(..),MatchArray)
import qualified Control.Exception(try,IOException)
try :: IO a -> IO (Either Control.Exception.IOException a)
try :: forall a. IO a -> IO (Either IOException a)
try = forall e a. Exception e => IO a -> IO (Either e a)
Control.Exception.try
data CRegex
type RegOffset = Int64
type RegOffsetT = (Int32)
{-# LINE 145 "src/Text/Regex/Posix/Wrap.hsc" #-}
newtype CompOption = CompOption CInt deriving (CompOption -> CompOption -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompOption -> CompOption -> Bool
$c/= :: CompOption -> CompOption -> Bool
== :: CompOption -> CompOption -> Bool
$c== :: CompOption -> CompOption -> Bool
Eq,Int -> CompOption -> ShowS
[CompOption] -> ShowS
CompOption -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompOption] -> ShowS
$cshowList :: [CompOption] -> ShowS
show :: CompOption -> String
$cshow :: CompOption -> String
showsPrec :: Int -> CompOption -> ShowS
$cshowsPrec :: Int -> CompOption -> ShowS
Show,Integer -> CompOption
CompOption -> CompOption
CompOption -> CompOption -> CompOption
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> CompOption
$cfromInteger :: Integer -> CompOption
signum :: CompOption -> CompOption
$csignum :: CompOption -> CompOption
abs :: CompOption -> CompOption
$cabs :: CompOption -> CompOption
negate :: CompOption -> CompOption
$cnegate :: CompOption -> CompOption
* :: CompOption -> CompOption -> CompOption
$c* :: CompOption -> CompOption -> CompOption
- :: CompOption -> CompOption -> CompOption
$c- :: CompOption -> CompOption -> CompOption
+ :: CompOption -> CompOption -> CompOption
$c+ :: CompOption -> CompOption -> CompOption
Num,Eq CompOption
CompOption
Int -> CompOption
CompOption -> Bool
CompOption -> Int
CompOption -> Maybe Int
CompOption -> CompOption
CompOption -> Int -> Bool
CompOption -> Int -> CompOption
CompOption -> CompOption -> CompOption
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: CompOption -> Int
$cpopCount :: CompOption -> Int
rotateR :: CompOption -> Int -> CompOption
$crotateR :: CompOption -> Int -> CompOption
rotateL :: CompOption -> Int -> CompOption
$crotateL :: CompOption -> Int -> CompOption
unsafeShiftR :: CompOption -> Int -> CompOption
$cunsafeShiftR :: CompOption -> Int -> CompOption
shiftR :: CompOption -> Int -> CompOption
$cshiftR :: CompOption -> Int -> CompOption
unsafeShiftL :: CompOption -> Int -> CompOption
$cunsafeShiftL :: CompOption -> Int -> CompOption
shiftL :: CompOption -> Int -> CompOption
$cshiftL :: CompOption -> Int -> CompOption
isSigned :: CompOption -> Bool
$cisSigned :: CompOption -> Bool
bitSize :: CompOption -> Int
$cbitSize :: CompOption -> Int
bitSizeMaybe :: CompOption -> Maybe Int
$cbitSizeMaybe :: CompOption -> Maybe Int
testBit :: CompOption -> Int -> Bool
$ctestBit :: CompOption -> Int -> Bool
complementBit :: CompOption -> Int -> CompOption
$ccomplementBit :: CompOption -> Int -> CompOption
clearBit :: CompOption -> Int -> CompOption
$cclearBit :: CompOption -> Int -> CompOption
setBit :: CompOption -> Int -> CompOption
$csetBit :: CompOption -> Int -> CompOption
bit :: Int -> CompOption
$cbit :: Int -> CompOption
zeroBits :: CompOption
$czeroBits :: CompOption
rotate :: CompOption -> Int -> CompOption
$crotate :: CompOption -> Int -> CompOption
shift :: CompOption -> Int -> CompOption
$cshift :: CompOption -> Int -> CompOption
complement :: CompOption -> CompOption
$ccomplement :: CompOption -> CompOption
xor :: CompOption -> CompOption -> CompOption
$cxor :: CompOption -> CompOption -> CompOption
.|. :: CompOption -> CompOption -> CompOption
$c.|. :: CompOption -> CompOption -> CompOption
.&. :: CompOption -> CompOption -> CompOption
$c.&. :: CompOption -> CompOption -> CompOption
Bits)
newtype ExecOption = ExecOption CInt deriving (ExecOption -> ExecOption -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExecOption -> ExecOption -> Bool
$c/= :: ExecOption -> ExecOption -> Bool
== :: ExecOption -> ExecOption -> Bool
$c== :: ExecOption -> ExecOption -> Bool
Eq,Int -> ExecOption -> ShowS
[ExecOption] -> ShowS
ExecOption -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExecOption] -> ShowS
$cshowList :: [ExecOption] -> ShowS
show :: ExecOption -> String
$cshow :: ExecOption -> String
showsPrec :: Int -> ExecOption -> ShowS
$cshowsPrec :: Int -> ExecOption -> ShowS
Show,Integer -> ExecOption
ExecOption -> ExecOption
ExecOption -> ExecOption -> ExecOption
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> ExecOption
$cfromInteger :: Integer -> ExecOption
signum :: ExecOption -> ExecOption
$csignum :: ExecOption -> ExecOption
abs :: ExecOption -> ExecOption
$cabs :: ExecOption -> ExecOption
negate :: ExecOption -> ExecOption
$cnegate :: ExecOption -> ExecOption
* :: ExecOption -> ExecOption -> ExecOption
$c* :: ExecOption -> ExecOption -> ExecOption
- :: ExecOption -> ExecOption -> ExecOption
$c- :: ExecOption -> ExecOption -> ExecOption
+ :: ExecOption -> ExecOption -> ExecOption
$c+ :: ExecOption -> ExecOption -> ExecOption
Num,Eq ExecOption
ExecOption
Int -> ExecOption
ExecOption -> Bool
ExecOption -> Int
ExecOption -> Maybe Int
ExecOption -> ExecOption
ExecOption -> Int -> Bool
ExecOption -> Int -> ExecOption
ExecOption -> ExecOption -> ExecOption
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: ExecOption -> Int
$cpopCount :: ExecOption -> Int
rotateR :: ExecOption -> Int -> ExecOption
$crotateR :: ExecOption -> Int -> ExecOption
rotateL :: ExecOption -> Int -> ExecOption
$crotateL :: ExecOption -> Int -> ExecOption
unsafeShiftR :: ExecOption -> Int -> ExecOption
$cunsafeShiftR :: ExecOption -> Int -> ExecOption
shiftR :: ExecOption -> Int -> ExecOption
$cshiftR :: ExecOption -> Int -> ExecOption
unsafeShiftL :: ExecOption -> Int -> ExecOption
$cunsafeShiftL :: ExecOption -> Int -> ExecOption
shiftL :: ExecOption -> Int -> ExecOption
$cshiftL :: ExecOption -> Int -> ExecOption
isSigned :: ExecOption -> Bool
$cisSigned :: ExecOption -> Bool
bitSize :: ExecOption -> Int
$cbitSize :: ExecOption -> Int
bitSizeMaybe :: ExecOption -> Maybe Int
$cbitSizeMaybe :: ExecOption -> Maybe Int
testBit :: ExecOption -> Int -> Bool
$ctestBit :: ExecOption -> Int -> Bool
complementBit :: ExecOption -> Int -> ExecOption
$ccomplementBit :: ExecOption -> Int -> ExecOption
clearBit :: ExecOption -> Int -> ExecOption
$cclearBit :: ExecOption -> Int -> ExecOption
setBit :: ExecOption -> Int -> ExecOption
$csetBit :: ExecOption -> Int -> ExecOption
bit :: Int -> ExecOption
$cbit :: Int -> ExecOption
zeroBits :: ExecOption
$czeroBits :: ExecOption
rotate :: ExecOption -> Int -> ExecOption
$crotate :: ExecOption -> Int -> ExecOption
shift :: ExecOption -> Int -> ExecOption
$cshift :: ExecOption -> Int -> ExecOption
complement :: ExecOption -> ExecOption
$ccomplement :: ExecOption -> ExecOption
xor :: ExecOption -> ExecOption -> ExecOption
$cxor :: ExecOption -> ExecOption -> ExecOption
.|. :: ExecOption -> ExecOption -> ExecOption
$c.|. :: ExecOption -> ExecOption -> ExecOption
.&. :: ExecOption -> ExecOption -> ExecOption
$c.&. :: ExecOption -> ExecOption -> ExecOption
Bits)
newtype ReturnCode = ReturnCode CInt deriving (ReturnCode -> ReturnCode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReturnCode -> ReturnCode -> Bool
$c/= :: ReturnCode -> ReturnCode -> Bool
== :: ReturnCode -> ReturnCode -> Bool
$c== :: ReturnCode -> ReturnCode -> Bool
Eq,Int -> ReturnCode -> ShowS
[ReturnCode] -> ShowS
ReturnCode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReturnCode] -> ShowS
$cshowList :: [ReturnCode] -> ShowS
show :: ReturnCode -> String
$cshow :: ReturnCode -> String
showsPrec :: Int -> ReturnCode -> ShowS
$cshowsPrec :: Int -> ReturnCode -> ShowS
Show)
data Regex = Regex (ForeignPtr CRegex) CompOption ExecOption
compBlank :: CompOption
compBlank :: CompOption
compBlank = CInt -> CompOption
CompOption CInt
0
execBlank :: ExecOption
execBlank :: ExecOption
execBlank = CInt -> ExecOption
ExecOption CInt
0
unusedRegOffset :: RegOffset
unusedRegOffset :: RegOffset
unusedRegOffset = (-RegOffset
1)
type WrapError = (ReturnCode,String)
wrapCompile :: CompOption
-> ExecOption
-> CString
-> IO (Either WrapError Regex)
wrapTest :: Regex -> CString
-> IO (Either WrapError Bool)
wrapMatch :: Regex -> CString
-> IO (Either WrapError (Maybe [(RegOffset,RegOffset)]))
wrapMatchAll :: Regex -> CString
-> IO (Either WrapError [MatchArray])
wrapCount :: Regex -> CString
-> IO (Either WrapError Int)
(=~) :: (RegexMaker Regex CompOption ExecOption source,RegexContext Regex source1 target)
=> source1 -> source -> target
(=~~) :: (RegexMaker Regex CompOption ExecOption source,RegexContext Regex source1 target,MonadFail m)
=> source1 -> source -> m target
instance RegexOptions Regex CompOption ExecOption where
blankCompOpt :: CompOption
blankCompOpt = CompOption
compBlank
blankExecOpt :: ExecOption
blankExecOpt = ExecOption
execBlank
defaultCompOpt :: CompOption
defaultCompOpt = CompOption
compExtended forall a. Bits a => a -> a -> a
.|. CompOption
compNewline
defaultExecOpt :: ExecOption
defaultExecOpt = ExecOption
execBlank
setExecOpts :: ExecOption -> Regex -> Regex
setExecOpts ExecOption
e' (Regex ForeignPtr CRegex
r CompOption
c ExecOption
_) = ForeignPtr CRegex -> CompOption -> ExecOption -> Regex
Regex ForeignPtr CRegex
r CompOption
c ExecOption
e'
getExecOpts :: Regex -> ExecOption
getExecOpts (Regex ForeignPtr CRegex
_ CompOption
_ ExecOption
e) = ExecOption
e
=~ :: forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
RegexContext Regex source1 target) =>
source1 -> source -> target
(=~) source1
x source
r = let make :: RegexMaker Regex CompOption ExecOption a => a -> Regex
make :: forall a. RegexMaker Regex CompOption ExecOption a => a -> Regex
make = forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
source -> regex
makeRegex
in forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match (forall a. RegexMaker Regex CompOption ExecOption a => a -> Regex
make source
r) source1
x
=~~ :: forall source source1 target (m :: * -> *).
(RegexMaker Regex CompOption ExecOption source,
RegexContext Regex source1 target, MonadFail m) =>
source1 -> source -> m target
(=~~) source1
x source
r = let make :: RegexMaker Regex CompOption ExecOption a => a -> Regex
make :: forall a. RegexMaker Regex CompOption ExecOption a => a -> Regex
make = forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
source -> regex
makeRegex
in forall regex source target (m :: * -> *).
(RegexContext regex source target, MonadFail m) =>
regex -> source -> m target
matchM (forall a. RegexMaker Regex CompOption ExecOption a => a -> Regex
make source
r) source1
x
type CRegMatch = ()
foreign import ccall unsafe "memset"
c_memset :: Ptr CRegex -> CInt -> CSize -> IO (Ptr CRegex)
foreign import ccall unsafe "&hs_regex_regfree"
c_myregfree :: FunPtr (Ptr CRegex -> IO ())
foreign import ccall unsafe "regex.h regcomp"
c_regcomp :: Ptr CRegex -> CString -> CompOption -> IO ReturnCode
foreign import ccall unsafe "regex.h regexec"
c_regexec :: Ptr CRegex -> CString -> CSize
-> Ptr CRegMatch -> ExecOption -> IO ReturnCode
foreign import ccall unsafe "regex.h regerror"
c_regerror :: ReturnCode -> Ptr CRegex
-> CString -> CSize -> IO CSize
retOk :: ReturnCode
retOk :: ReturnCode
retOk = CInt -> ReturnCode
ReturnCode CInt
0
execNotBOL :: ExecOption
execNotBOL :: ExecOption
execNotBOL = CInt -> ExecOption
ExecOption CInt
1
execNotEOL :: ExecOption
execNotEOL :: ExecOption
execNotEOL = CInt -> ExecOption
ExecOption CInt
2
{-# LINE 314 "src/Text/Regex/Posix/Wrap.hsc" #-}
compExtended :: CompOption
compExtended :: CompOption
compExtended = CInt -> CompOption
CompOption CInt
1
compIgnoreCase :: CompOption
compIgnoreCase :: CompOption
compIgnoreCase = CInt -> CompOption
CompOption CInt
2
compNoSub :: CompOption
compNoSub :: CompOption
compNoSub = CInt -> CompOption
CompOption CInt
8
compNewline :: CompOption
compNewline :: CompOption
compNewline = CInt -> CompOption
CompOption CInt
4
{-# LINE 321 "src/Text/Regex/Posix/Wrap.hsc" #-}
retNoMatch :: ReturnCode
retNoMatch :: ReturnCode
retNoMatch = CInt -> ReturnCode
ReturnCode CInt
1
retBadbr :: ReturnCode
retBadbr :: ReturnCode
retBadbr = CInt -> ReturnCode
ReturnCode CInt
10
retBadpat :: ReturnCode
retBadpat :: ReturnCode
retBadpat = CInt -> ReturnCode
ReturnCode CInt
2
retBadrpt :: ReturnCode
retBadrpt :: ReturnCode
retBadrpt = CInt -> ReturnCode
ReturnCode CInt
13
retEcollate :: ReturnCode
retEcollate :: ReturnCode
retEcollate = CInt -> ReturnCode
ReturnCode CInt
3
retEctype :: ReturnCode
retEctype :: ReturnCode
retEctype = CInt -> ReturnCode
ReturnCode CInt
4
retEescape :: ReturnCode
retEescape :: ReturnCode
retEescape = CInt -> ReturnCode
ReturnCode CInt
5
retEsubreg :: ReturnCode
retEsubreg :: ReturnCode
retEsubreg = CInt -> ReturnCode
ReturnCode CInt
6
retEbrack :: ReturnCode
retEbrack :: ReturnCode
retEbrack = CInt -> ReturnCode
ReturnCode CInt
7
retEparen :: ReturnCode
retEparen :: ReturnCode
retEparen = CInt -> ReturnCode
ReturnCode CInt
8
retEbrace :: ReturnCode
retEbrace :: ReturnCode
retEbrace = CInt -> ReturnCode
ReturnCode CInt
9
retErange :: ReturnCode
retErange :: ReturnCode
retErange = CInt -> ReturnCode
ReturnCode CInt
11
retEspace :: ReturnCode
isNewline :: Ptr CChar -> Int -> IO Bool
retEspace :: ReturnCode
retEspace = ReturnCode 12
{-# LINE 339 "src/Text/Regex/Posix/Wrap.hsc" #-}
nullTest :: Ptr a -> String -> IO (Either WrapError b) -> IO (Either WrapError b)
{-# INLINE nullTest #-}
nullTest ptr msg io = do
if nullPtr == ptr
then return (Left (retOk,"Ptr parameter was nullPtr in Text.Regex.TRE.Wrap."++msg))
else io
isNewline,isNull :: Ptr CChar -> Int -> IO Bool
isNewline cstr pos = liftM (newline ==) (peekElemOff cstr pos)
where newline = toEnum 10
isNull cstr pos = liftM (nullChar ==) (peekElemOff cstr pos)
where nullChar = toEnum 0
wrapError :: ReturnCode -> Ptr CRegex -> IO (Either WrapError b)
wrapError :: forall b. ReturnCode -> Ptr CRegex -> IO (Either WrapError b)
wrapError ReturnCode
errCode Ptr CRegex
regex_ptr = do
CSize
errBufSize <- ReturnCode -> Ptr CRegex -> Ptr CChar -> CSize -> IO CSize
c_regerror ReturnCode
errCode Ptr CRegex
regex_ptr forall a. Ptr a
nullPtr CSize
0
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray (forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
errBufSize) forall a b. (a -> b) -> a -> b
$ \Ptr CChar
errBuf -> do
forall a b.
Ptr a
-> String -> IO (Either WrapError b) -> IO (Either WrapError b)
nullTest Ptr CChar
errBuf String
"wrapError errBuf" forall a b. (a -> b) -> a -> b
$ do
CSize
_ <- ReturnCode -> Ptr CRegex -> Ptr CChar -> CSize -> IO CSize
c_regerror ReturnCode
errCode Ptr CRegex
regex_ptr Ptr CChar
errBuf CSize
errBufSize
String
msg <- Ptr CChar -> IO String
peekCAString Ptr CChar
errBuf :: IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (ReturnCode
errCode, String
msg))
wrapCompile :: CompOption
-> ExecOption -> Ptr CChar -> IO (Either WrapError Regex)
wrapCompile CompOption
flags ExecOption
e Ptr CChar
pattern = do
forall a b.
Ptr a
-> String -> IO (Either WrapError b) -> IO (Either WrapError b)
nullTest Ptr CChar
pattern String
"wrapCompile pattern" forall a b. (a -> b) -> a -> b
$ do
Either IOException (Ptr CRegex)
e_regex_ptr <- forall a. IO a -> IO (Either IOException a)
try forall a b. (a -> b) -> a -> b
$ forall a. Int -> IO (Ptr a)
mallocBytes (Int
64)
{-# LINE 375 "src/Text/Regex/Posix/Wrap.hsc" #-}
case e_regex_ptr of
Left ioerror -> return (Left (retOk,"Text.Regex.Posix.Wrap.wrapCompile: IOError from mallocBytes(regex_t) : "++show ioerror))
Right raw_regex_ptr -> do
zero_regex_ptr <- c_memset raw_regex_ptr 0 (64)
{-# LINE 379 "src/Text/Regex/Posix/Wrap.hsc" #-}
regex_fptr <- newForeignPtr c_myregfree zero_regex_ptr
withForeignPtr regex_fptr $ \regex_ptr -> do
errCode <- c_regcomp regex_ptr pattern flags
if (errCode == retOk)
then return . Right $ Regex regex_fptr flags e
else wrapError errCode regex_ptr
wrapTest :: Regex -> Ptr CChar -> IO (Either WrapError Bool)
wrapTest (Regex ForeignPtr CRegex
regex_fptr CompOption
_ ExecOption
flags) Ptr CChar
cstr = do
forall a b.
Ptr a
-> String -> IO (Either WrapError b) -> IO (Either WrapError b)
nullTest Ptr CChar
cstr String
"wrapTest" forall a b. (a -> b) -> a -> b
$ do
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CRegex
regex_fptr forall a b. (a -> b) -> a -> b
$ \Ptr CRegex
regex_ptr -> do
ReturnCode
r <- Ptr CRegex
-> Ptr CChar -> CSize -> Ptr () -> ExecOption -> IO ReturnCode
c_regexec Ptr CRegex
regex_ptr Ptr CChar
cstr CSize
0 forall a. Ptr a
nullPtr ExecOption
flags
if ReturnCode
r forall a. Eq a => a -> a -> Bool
== ReturnCode
retOk
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right Bool
True)
else if ReturnCode
r forall a. Eq a => a -> a -> Bool
== ReturnCode
retNoMatch
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right Bool
False)
else forall b. ReturnCode -> Ptr CRegex -> IO (Either WrapError b)
wrapError ReturnCode
r Ptr CRegex
regex_ptr
wrapMatch :: Regex
-> Ptr CChar
-> IO (Either WrapError (Maybe [(RegOffset, RegOffset)]))
wrapMatch regex :: Regex
regex@(Regex ForeignPtr CRegex
regex_fptr CompOption
compileOptions ExecOption
flags) Ptr CChar
cstr = do
forall a b.
Ptr a
-> String -> IO (Either WrapError b) -> IO (Either WrapError b)
nullTest Ptr CChar
cstr String
"wrapMatch cstr" forall a b. (a -> b) -> a -> b
$ do
if (CompOption
0 forall a. Eq a => a -> a -> Bool
/= CompOption
compNoSub forall a. Bits a => a -> a -> a
.&. CompOption
compileOptions)
then do
Either WrapError Bool
r <- Regex -> Ptr CChar -> IO (Either WrapError Bool)
wrapTest Regex
regex Ptr CChar
cstr
case Either WrapError Bool
r of
Right Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (forall a. a -> Maybe a
Just []))
Right Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right forall a. Maybe a
Nothing)
Left WrapError
err -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left WrapError
err)
else do
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CRegex
regex_fptr forall a b. (a -> b) -> a -> b
$ \Ptr CRegex
regex_ptr -> do
CSize
nsub <- ((\Ptr CRegex
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CRegex
hsc_ptr Int
48)) Ptr CRegex
regex_ptr :: IO CSize
{-# LINE 410 "src/Text/Regex/Posix/Wrap.hsc" #-}
let nsub_int,nsub_bytes :: Int
nsub_int :: Int
nsub_int = forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
nsub
nsub_bytes :: Int
nsub_bytes = ((Int
1 forall a. Num a => a -> a -> a
+ Int
nsub_int) forall a. Num a => a -> a -> a
* (Int
8))
{-# LINE 413 "src/Text/Regex/Posix/Wrap.hsc" #-}
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
nsub_bytes forall a b. (a -> b) -> a -> b
$ \Ptr ()
p_match -> do
forall a b.
Ptr a
-> String -> IO (Either WrapError b) -> IO (Either WrapError b)
nullTest Ptr ()
p_match String
"wrapMatch allocaBytes" forall a b. (a -> b) -> a -> b
$ do
Ptr CRegex
-> Ptr CChar
-> CSize
-> Ptr ()
-> ExecOption
-> IO (Either WrapError (Maybe [(RegOffset, RegOffset)]))
doMatch Ptr CRegex
regex_ptr Ptr CChar
cstr CSize
nsub Ptr ()
p_match ExecOption
flags
doMatch :: Ptr CRegex -> CString -> CSize -> Ptr CRegMatch -> ExecOption
-> IO (Either WrapError (Maybe [(RegOffset,RegOffset)]))
{-# INLINE doMatch #-}
doMatch :: Ptr CRegex
-> Ptr CChar
-> CSize
-> Ptr ()
-> ExecOption
-> IO (Either WrapError (Maybe [(RegOffset, RegOffset)]))
doMatch Ptr CRegex
regex_ptr Ptr CChar
cstr CSize
nsub Ptr ()
p_match ExecOption
flags = do
ReturnCode
r <- Ptr CRegex
-> Ptr CChar -> CSize -> Ptr () -> ExecOption -> IO ReturnCode
c_regexec Ptr CRegex
regex_ptr Ptr CChar
cstr (CSize
1 forall a. Num a => a -> a -> a
+ CSize
nsub) Ptr ()
p_match ExecOption
flags
if ReturnCode
r forall a. Eq a => a -> a -> Bool
== ReturnCode
retOk
then do
[(RegOffset, RegOffset)]
regions <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Ptr () -> IO (RegOffset, RegOffset)
getOffsets forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take (Int
1forall a. Num a => a -> a -> a
+forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
nsub)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a) -> a -> [a]
iterate (forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8)) forall a b. (a -> b) -> a -> b
$ Ptr ()
p_match
{-# LINE 430 "src/Text/Regex/Posix/Wrap.hsc" #-}
return (Right (Just regions))
else if ReturnCode
r forall a. Eq a => a -> a -> Bool
== ReturnCode
retNoMatch
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right forall a. Maybe a
Nothing)
else forall b. ReturnCode -> Ptr CRegex -> IO (Either WrapError b)
wrapError ReturnCode
r Ptr CRegex
regex_ptr
where
getOffsets :: Ptr CRegMatch -> IO (RegOffset,RegOffset)
{-# INLINE getOffsets #-}
getOffsets :: Ptr () -> IO (RegOffset, RegOffset)
getOffsets Ptr ()
pmatch' = do
Int32
start <- ((\Ptr ()
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ()
hsc_ptr Int
0)) Ptr ()
pmatch' :: IO (Int32)
{-# LINE 439 "src/Text/Regex/Posix/Wrap.hsc" #-}
end <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) pmatch' :: IO (Int32)
{-# LINE 440 "src/Text/Regex/Posix/Wrap.hsc" #-}
return (fromIntegral start,fromIntegral end)
wrapMatchAll :: Regex -> Ptr CChar -> IO (Either WrapError [MatchArray])
wrapMatchAll regex :: Regex
regex@(Regex ForeignPtr CRegex
regex_fptr CompOption
compileOptions ExecOption
flags) Ptr CChar
cstr = do
forall a b.
Ptr a
-> String -> IO (Either WrapError b) -> IO (Either WrapError b)
nullTest Ptr CChar
cstr String
"wrapMatchAll cstr" forall a b. (a -> b) -> a -> b
$ do
if (CompOption
0 forall a. Eq a => a -> a -> Bool
/= CompOption
compNoSub forall a. Bits a => a -> a -> a
.&. CompOption
compileOptions)
then do
Either WrapError Bool
r <- Regex -> Ptr CChar -> IO (Either WrapError Bool)
wrapTest Regex
regex Ptr CChar
cstr
case Either WrapError Bool
r of
Right Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right [(Int -> [(RegOffset, RegOffset)] -> MatchArray
toMA Int
0 [])])
Right Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right [])
Left WrapError
err -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left WrapError
err)
else do
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CRegex
regex_fptr forall a b. (a -> b) -> a -> b
$ \Ptr CRegex
regex_ptr -> do
CSize
nsub <- ((\Ptr CRegex
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CRegex
hsc_ptr Int
48)) Ptr CRegex
regex_ptr :: IO CSize
{-# LINE 454 "src/Text/Regex/Posix/Wrap.hsc" #-}
let nsub_int,nsub_bytes :: Int
nsub_int :: Int
nsub_int = forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
nsub
nsub_bytes :: Int
nsub_bytes = ((Int
1 forall a. Num a => a -> a -> a
+ Int
nsub_int) forall a. Num a => a -> a -> a
* (Int
8))
{-# LINE 457 "src/Text/Regex/Posix/Wrap.hsc" #-}
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
nsub_bytes forall a b. (a -> b) -> a -> b
$ \Ptr ()
p_match -> do
forall a b.
Ptr a
-> String -> IO (Either WrapError b) -> IO (Either WrapError b)
nullTest Ptr ()
p_match String
"wrapMatchAll p_match" forall a b. (a -> b) -> a -> b
$ do
let flagsBOL :: ExecOption
flagsBOL = (forall a. Bits a => a -> a
complement ExecOption
execNotBOL) forall a. Bits a => a -> a -> a
.&. ExecOption
flags
flagsMIDDLE :: ExecOption
flagsMIDDLE = ExecOption
execNotBOL forall a. Bits a => a -> a -> a
.|. ExecOption
flags
atBOL :: Int -> IO (Either WrapError (Maybe [(RegOffset, RegOffset)]))
atBOL Int
pos = Ptr CRegex
-> Ptr CChar
-> CSize
-> Ptr ()
-> ExecOption
-> IO (Either WrapError (Maybe [(RegOffset, RegOffset)]))
doMatch Ptr CRegex
regex_ptr (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr CChar
cstr Int
pos) CSize
nsub Ptr ()
p_match ExecOption
flagsBOL
atMIDDLE :: Int -> IO (Either WrapError (Maybe [(RegOffset, RegOffset)]))
atMIDDLE Int
pos = Ptr CRegex
-> Ptr CChar
-> CSize
-> Ptr ()
-> ExecOption
-> IO (Either WrapError (Maybe [(RegOffset, RegOffset)]))
doMatch Ptr CRegex
regex_ptr (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr CChar
cstr Int
pos) CSize
nsub Ptr ()
p_match ExecOption
flagsMIDDLE
loop :: ([MatchArray] -> b)
-> Int -> (RegOffset, RegOffset) -> IO (Either WrapError b)
loop [MatchArray] -> b
acc Int
old (RegOffset
s,RegOffset
e) | [MatchArray] -> b
acc seq :: forall a b. a -> b -> b
`seq` Int
old seq :: forall a b. a -> b -> b
`seq` Bool
False = forall a. HasCallStack => a
undefined
| RegOffset
s forall a. Eq a => a -> a -> Bool
== RegOffset
e = do
let pos :: Int
pos = Int
old forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral RegOffset
e
Bool
atEnd <- Ptr CChar -> Int -> IO Bool
isNull Ptr CChar
cstr Int
pos
if Bool
atEnd then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right ([MatchArray] -> b
acc []))
else ([MatchArray] -> b)
-> Int -> (RegOffset, RegOffset) -> IO (Either WrapError b)
loop [MatchArray] -> b
acc Int
old (RegOffset
s,forall a. Enum a => a -> a
succ RegOffset
e)
| Bool
otherwise = do
let pos :: Int
pos = Int
old forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral RegOffset
e
Bool
prev'newline <- Ptr CChar -> Int -> IO Bool
isNewline Ptr CChar
cstr (forall a. Enum a => a -> a
pred Int
pos)
Either WrapError (Maybe [(RegOffset, RegOffset)])
result <- if Bool
prev'newline then Int -> IO (Either WrapError (Maybe [(RegOffset, RegOffset)]))
atBOL Int
pos else Int -> IO (Either WrapError (Maybe [(RegOffset, RegOffset)]))
atMIDDLE Int
pos
case Either WrapError (Maybe [(RegOffset, RegOffset)])
result of
Right Maybe [(RegOffset, RegOffset)]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right ([MatchArray] -> b
acc []))
Right (Just parts :: [(RegOffset, RegOffset)]
parts@((RegOffset, RegOffset)
whole:[(RegOffset, RegOffset)]
_)) -> let ma :: MatchArray
ma = Int -> [(RegOffset, RegOffset)] -> MatchArray
toMA Int
pos [(RegOffset, RegOffset)]
parts
in ([MatchArray] -> b)
-> Int -> (RegOffset, RegOffset) -> IO (Either WrapError b)
loop ([MatchArray] -> b
accforall b c a. (b -> c) -> (a -> b) -> a -> c
.(MatchArray
maforall a. a -> [a] -> [a]
:)) Int
pos (RegOffset, RegOffset)
whole
Left WrapError
err -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left WrapError
err)
Right (Just []) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right ([MatchArray] -> b
acc [(Int -> [(RegOffset, RegOffset)] -> MatchArray
toMA Int
pos [])]))
Either WrapError (Maybe [(RegOffset, RegOffset)])
result <- Ptr CRegex
-> Ptr CChar
-> CSize
-> Ptr ()
-> ExecOption
-> IO (Either WrapError (Maybe [(RegOffset, RegOffset)]))
doMatch Ptr CRegex
regex_ptr Ptr CChar
cstr CSize
nsub Ptr ()
p_match ExecOption
flags
case Either WrapError (Maybe [(RegOffset, RegOffset)])
result of
Right Maybe [(RegOffset, RegOffset)]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right [])
Right (Just parts :: [(RegOffset, RegOffset)]
parts@((RegOffset, RegOffset)
whole:[(RegOffset, RegOffset)]
_)) -> let ma :: MatchArray
ma = Int -> [(RegOffset, RegOffset)] -> MatchArray
toMA Int
0 [(RegOffset, RegOffset)]
parts
in forall {b}.
([MatchArray] -> b)
-> Int -> (RegOffset, RegOffset) -> IO (Either WrapError b)
loop (MatchArray
maforall a. a -> [a] -> [a]
:) Int
0 (RegOffset, RegOffset)
whole
Left WrapError
err -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left WrapError
err)
Right (Just []) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right [(Int -> [(RegOffset, RegOffset)] -> MatchArray
toMA Int
0 [])])
where
toMA :: Int -> [(RegOffset,RegOffset)] -> Array Int (Int,Int)
toMA :: Int -> [(RegOffset, RegOffset)] -> MatchArray
toMA Int
pos [] = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
0) [(Int
pos,Int
0)]
toMA Int
pos [(RegOffset, RegOffset)]
parts = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,forall a. Enum a => a -> a
pred (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(RegOffset, RegOffset)]
parts))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(RegOffset
s,RegOffset
e)-> if RegOffset
sforall a. Ord a => a -> a -> Bool
>=RegOffset
0 then (Int
posforall a. Num a => a -> a -> a
+forall a b. (Integral a, Num b) => a -> b
fromIntegral RegOffset
s, forall a b. (Integral a, Num b) => a -> b
fromIntegral (RegOffset
eforall a. Num a => a -> a -> a
-RegOffset
s)) else (-Int
1,Int
0))
forall a b. (a -> b) -> a -> b
$ [(RegOffset, RegOffset)]
parts
wrapCount :: Regex -> Ptr CChar -> IO (Either WrapError Int)
wrapCount regex :: Regex
regex@(Regex ForeignPtr CRegex
regex_fptr CompOption
compileOptions ExecOption
flags) Ptr CChar
cstr = do
forall a b.
Ptr a
-> String -> IO (Either WrapError b) -> IO (Either WrapError b)
nullTest Ptr CChar
cstr String
"wrapCount cstr" forall a b. (a -> b) -> a -> b
$ do
if (CompOption
0 forall a. Eq a => a -> a -> Bool
/= CompOption
compNoSub forall a. Bits a => a -> a -> a
.&. CompOption
compileOptions)
then do
Either WrapError Bool
r <- Regex -> Ptr CChar -> IO (Either WrapError Bool)
wrapTest Regex
regex Ptr CChar
cstr
case Either WrapError Bool
r of
Right Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right Int
1)
Right Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right Int
0)
Left WrapError
err -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left WrapError
err)
else do
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CRegex
regex_fptr forall a b. (a -> b) -> a -> b
$ \Ptr CRegex
regex_ptr -> do
let nsub_bytes :: Int
nsub_bytes = ((Int
8))
{-# LINE 507 "src/Text/Regex/Posix/Wrap.hsc" #-}
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
nsub_bytes forall a b. (a -> b) -> a -> b
$ \Ptr ()
p_match -> do
forall a b.
Ptr a
-> String -> IO (Either WrapError b) -> IO (Either WrapError b)
nullTest Ptr ()
p_match String
"wrapCount p_match" forall a b. (a -> b) -> a -> b
$ do
let flagsBOL :: ExecOption
flagsBOL = (forall a. Bits a => a -> a
complement ExecOption
execNotBOL) forall a. Bits a => a -> a -> a
.&. ExecOption
flags
flagsMIDDLE :: ExecOption
flagsMIDDLE = ExecOption
execNotBOL forall a. Bits a => a -> a -> a
.|. ExecOption
flags
atBOL :: Int -> IO (Either WrapError (Maybe [(RegOffset, RegOffset)]))
atBOL Int
pos = Ptr CRegex
-> Ptr CChar
-> CSize
-> Ptr ()
-> ExecOption
-> IO (Either WrapError (Maybe [(RegOffset, RegOffset)]))
doMatch Ptr CRegex
regex_ptr (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr CChar
cstr Int
pos) CSize
0 Ptr ()
p_match ExecOption
flagsBOL
atMIDDLE :: Int -> IO (Either WrapError (Maybe [(RegOffset, RegOffset)]))
atMIDDLE Int
pos = Ptr CRegex
-> Ptr CChar
-> CSize
-> Ptr ()
-> ExecOption
-> IO (Either WrapError (Maybe [(RegOffset, RegOffset)]))
doMatch Ptr CRegex
regex_ptr (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr CChar
cstr Int
pos) CSize
0 Ptr ()
p_match ExecOption
flagsMIDDLE
loop :: t -> Int -> (RegOffset, RegOffset) -> IO (Either WrapError t)
loop t
acc Int
old (RegOffset
s,RegOffset
e) | t
acc seq :: forall a b. a -> b -> b
`seq` Int
old seq :: forall a b. a -> b -> b
`seq` Bool
False = forall a. HasCallStack => a
undefined
| RegOffset
s forall a. Eq a => a -> a -> Bool
== RegOffset
e = do
let pos :: Int
pos = Int
old forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral RegOffset
e
Bool
atEnd <- Ptr CChar -> Int -> IO Bool
isNull Ptr CChar
cstr Int
pos
if Bool
atEnd then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right t
acc)
else t -> Int -> (RegOffset, RegOffset) -> IO (Either WrapError t)
loop t
acc Int
old (RegOffset
s,forall a. Enum a => a -> a
succ RegOffset
e)
| Bool
otherwise = do
let pos :: Int
pos = Int
old forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral RegOffset
e
Bool
prev'newline <- Ptr CChar -> Int -> IO Bool
isNewline Ptr CChar
cstr (forall a. Enum a => a -> a
pred Int
pos)
Either WrapError (Maybe [(RegOffset, RegOffset)])
result <- if Bool
prev'newline then Int -> IO (Either WrapError (Maybe [(RegOffset, RegOffset)]))
atBOL Int
pos else Int -> IO (Either WrapError (Maybe [(RegOffset, RegOffset)]))
atMIDDLE Int
pos
case Either WrapError (Maybe [(RegOffset, RegOffset)])
result of
Right Maybe [(RegOffset, RegOffset)]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right t
acc)
Right (Just ((RegOffset, RegOffset)
whole:[(RegOffset, RegOffset)]
_)) -> t -> Int -> (RegOffset, RegOffset) -> IO (Either WrapError t)
loop (forall a. Enum a => a -> a
succ t
acc) Int
pos (RegOffset, RegOffset)
whole
Left WrapError
err -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left WrapError
err)
Right (Just []) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right t
acc)
Either WrapError (Maybe [(RegOffset, RegOffset)])
result <- Ptr CRegex
-> Ptr CChar
-> CSize
-> Ptr ()
-> ExecOption
-> IO (Either WrapError (Maybe [(RegOffset, RegOffset)]))
doMatch Ptr CRegex
regex_ptr Ptr CChar
cstr CSize
0 Ptr ()
p_match ExecOption
flags
case Either WrapError (Maybe [(RegOffset, RegOffset)])
result of
Right Maybe [(RegOffset, RegOffset)]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right Int
0)
Right (Just ((RegOffset, RegOffset)
whole:[(RegOffset, RegOffset)]
_)) -> forall {t}.
Enum t =>
t -> Int -> (RegOffset, RegOffset) -> IO (Either WrapError t)
loop Int
1 Int
0 (RegOffset, RegOffset)
whole
Left WrapError
err -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left WrapError
err)
Right (Just []) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right Int
0)