{-# OPTIONS_GHC -fno-warn-orphans #-}
{-|
This exports instances of the high level API and the medium level
API of 'compile','execute', and 'regexec'.
-}
{- Copyright   :  (c) Chris Kuklewicz 2007 -}
module Text.Regex.PCRE.Sequence(
  -- ** Types
  Regex,
  MatchOffset,
  MatchLength,
  CompOption(CompOption),
  ExecOption(ExecOption),
  ReturnCode,
  WrapError,
  -- ** Miscellaneous
  unusedOffset,
  getVersion,
  -- ** Medium level API functions
  compile,
  execute,
  regexec,
  -- ** Constants for CompOption
  compBlank,
  compAnchored,
  compAutoCallout,
  compCaseless,
  compDollarEndOnly,
  compDotAll,
  compExtended,
  compExtra,
  compFirstLine,
  compMultiline,
  compNoAutoCapture,
  compUngreedy,
  compUTF8,
  compNoUTF8Check,
  -- ** Constants for ExecOption
  execBlank,
  execAnchored,
  execNotBOL,
  execNotEOL,
  execNotEmpty,
  execNoUTF8Check,
  execPartial
  ) where

import Prelude
  ( Bool(False)
  , Char
  , Either(Left,Right), either
  , IO, (>>), (>>=), return
  , Int, (-), fromIntegral, pred
  , Maybe(Nothing,Just)
  , Show(show)
  , String
  , ($), (.), seq, undefined
  , (==), otherwise
  , (++), length, map
  )
import Control.Monad.Fail (MonadFail(fail))

import Text.Regex.PCRE.Wrap -- all
--import Foreign.C.String(withCStringLen,withCString)
import Data.Array(Array,listArray)
import System.IO.Unsafe(unsafePerformIO)
import Text.Regex.Base.RegexLike(RegexMaker(..),RegexLike(..),RegexContext(..),MatchLength,MatchOffset,Extract(..))
import Text.Regex.Base.Impl(polymatch,polymatchM)
import Data.Sequence as S
    ( Seq,
      empty,
      singleton,
      viewl,
      viewr,
      (|>),
      ViewL((:<), EmptyL),
      ViewR((:>), EmptyR) )
import qualified Data.Sequence as S (length)
import Foreign.C.String ( castCharToCChar, CString, CStringLen )
import Foreign.Marshal.Array ( advancePtr )
import Foreign.Marshal.Alloc ( allocaBytes )
import Foreign.Storable ( Storable(poke) )

instance RegexContext Regex (Seq Char) (Seq Char) where
  match :: Regex -> Seq Char -> Seq Char
match = Regex -> Seq Char -> Seq Char
forall a b. RegexLike a b => a -> b -> b
polymatch
  matchM :: forall (m :: * -> *).
MonadFail m =>
Regex -> Seq Char -> m (Seq Char)
matchM = Regex -> Seq Char -> m (Seq Char)
forall a b (m :: * -> *).
(RegexLike a b, MonadFail m) =>
a -> b -> m b
polymatchM

unwrap :: (Show e) => Either e v -> IO v
unwrap :: forall e v. Show e => Either e v -> IO v
unwrap Either e v
x = case Either e v
x of Left e
err -> String -> IO v
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Text.Regex.PCRE.Sequence died: "String -> String -> String
forall a. [a] -> [a] -> [a]
++ e -> String
forall a. Show a => a -> String
show e
err)
                     Right v
v -> v -> IO v
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return v
v

instance RegexMaker Regex CompOption ExecOption (Seq Char) where
  makeRegexOpts :: CompOption -> ExecOption -> Seq Char -> Regex
makeRegexOpts CompOption
c ExecOption
e Seq Char
pattern = IO Regex -> Regex
forall a. IO a -> a
unsafePerformIO (IO Regex -> Regex) -> IO Regex -> Regex
forall a b. (a -> b) -> a -> b
$
    CompOption
-> ExecOption -> Seq Char -> IO (Either (Int, String) Regex)
compile CompOption
c ExecOption
e Seq Char
pattern IO (Either (Int, String) Regex)
-> (Either (Int, String) Regex -> IO Regex) -> IO Regex
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Int, String) Regex -> IO Regex
forall e v. Show e => Either e v -> IO v
unwrap
  makeRegexOptsM :: forall (m :: * -> *).
MonadFail m =>
CompOption -> ExecOption -> Seq Char -> m Regex
makeRegexOptsM CompOption
c ExecOption
e Seq Char
pattern = ((Int, String) -> m Regex)
-> (Regex -> m Regex) -> Either (Int, String) Regex -> m Regex
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> m Regex
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail(String -> m Regex)
-> ((Int, String) -> String) -> (Int, String) -> m Regex
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int, String) -> String
forall a. Show a => a -> String
show) Regex -> m Regex
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Int, String) Regex -> m Regex)
-> Either (Int, String) Regex -> m Regex
forall a b. (a -> b) -> a -> b
$ IO (Either (Int, String) Regex) -> Either (Int, String) Regex
forall a. IO a -> a
unsafePerformIO (IO (Either (Int, String) Regex) -> Either (Int, String) Regex)
-> IO (Either (Int, String) Regex) -> Either (Int, String) Regex
forall a b. (a -> b) -> a -> b
$
    CompOption
-> ExecOption -> Seq Char -> IO (Either (Int, String) Regex)
compile CompOption
c ExecOption
e Seq Char
pattern

instance RegexLike Regex (Seq Char) where
  matchTest :: Regex -> Seq Char -> Bool
matchTest Regex
regex Seq Char
str = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
    Seq Char
-> (CStringLen -> IO (Either WrapError Bool))
-> IO (Either WrapError Bool)
forall a. Seq Char -> (CStringLen -> IO a) -> IO a
withSeq Seq Char
str (Int -> Regex -> CStringLen -> IO (Either WrapError Bool)
wrapTest Int
0 Regex
regex) IO (Either WrapError Bool)
-> (Either WrapError Bool -> IO Bool) -> IO Bool
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either WrapError Bool -> IO Bool
forall e v. Show e => Either e v -> IO v
unwrap
  matchOnce :: Regex -> Seq Char -> Maybe MatchArray
matchOnce Regex
regex Seq Char
str = IO (Maybe MatchArray) -> Maybe MatchArray
forall a. IO a -> a
unsafePerformIO (IO (Maybe MatchArray) -> Maybe MatchArray)
-> IO (Maybe MatchArray) -> Maybe MatchArray
forall a b. (a -> b) -> a -> b
$
    Regex -> Seq Char -> IO (Either WrapError (Maybe MatchArray))
execute Regex
regex Seq Char
str IO (Either WrapError (Maybe MatchArray))
-> (Either WrapError (Maybe MatchArray) -> IO (Maybe MatchArray))
-> IO (Maybe MatchArray)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either WrapError (Maybe MatchArray) -> IO (Maybe MatchArray)
forall e v. Show e => Either e v -> IO v
unwrap
  matchAll :: Regex -> Seq Char -> [MatchArray]
matchAll Regex
regex Seq Char
str = IO [MatchArray] -> [MatchArray]
forall a. IO a -> a
unsafePerformIO (IO [MatchArray] -> [MatchArray])
-> IO [MatchArray] -> [MatchArray]
forall a b. (a -> b) -> a -> b
$
    Seq Char
-> (CStringLen -> IO (Either WrapError [MatchArray]))
-> IO (Either WrapError [MatchArray])
forall a. Seq Char -> (CStringLen -> IO a) -> IO a
withSeq Seq Char
str (Regex -> CStringLen -> IO (Either WrapError [MatchArray])
wrapMatchAll Regex
regex) IO (Either WrapError [MatchArray])
-> (Either WrapError [MatchArray] -> IO [MatchArray])
-> IO [MatchArray]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either WrapError [MatchArray] -> IO [MatchArray]
forall e v. Show e => Either e v -> IO v
unwrap
  matchCount :: Regex -> Seq Char -> Int
matchCount Regex
regex Seq Char
str = IO Int -> Int
forall a. IO a -> a
unsafePerformIO (IO Int -> Int) -> IO Int -> Int
forall a b. (a -> b) -> a -> b
$
    Seq Char
-> (CStringLen -> IO (Either WrapError Int))
-> IO (Either WrapError Int)
forall a. Seq Char -> (CStringLen -> IO a) -> IO a
withSeq Seq Char
str (Regex -> CStringLen -> IO (Either WrapError Int)
wrapCount Regex
regex) IO (Either WrapError Int)
-> (Either WrapError Int -> IO Int) -> IO Int
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either WrapError Int -> IO Int
forall e v. Show e => Either e v -> IO v
unwrap

-- | Compiles a regular expression
compile :: CompOption -- ^ Flags (summed together)
        -> ExecOption -- ^ Flags (summed together)
        -> (Seq Char)     -- ^ The regular expression to compile
        -> IO (Either (MatchOffset,String) Regex) -- ^ Returns: an error string and offset or the compiled regular expression
compile :: CompOption
-> ExecOption -> Seq Char -> IO (Either (Int, String) Regex)
compile CompOption
c ExecOption
e Seq Char
pattern = Seq Char
-> (CString -> IO (Either (Int, String) Regex))
-> IO (Either (Int, String) Regex)
forall a. Seq Char -> (CString -> IO a) -> IO a
withSeq0 Seq Char
pattern (CompOption
-> ExecOption -> CString -> IO (Either (Int, String) Regex)
wrapCompile CompOption
c ExecOption
e)

-- | Matches a regular expression against a string
execute :: Regex      -- ^ Compiled regular expression
        -> (Seq Char)     -- ^ (Seq Char) to match against
        -> IO (Either WrapError (Maybe (Array Int (MatchOffset,MatchLength))))
                -- ^ Returns: 'Nothing' if the regex did not match the
                -- string, or:
                --   'Just' an array of (offset,length) pairs where index 0 is whole match, and the rest are the captured subexpressions.
execute :: Regex -> Seq Char -> IO (Either WrapError (Maybe MatchArray))
execute Regex
regex Seq Char
str = do
  maybeStartEnd <- Seq Char
-> (CStringLen -> IO (Either WrapError (Maybe [(Int, Int)])))
-> IO (Either WrapError (Maybe [(Int, Int)]))
forall a. Seq Char -> (CStringLen -> IO a) -> IO a
withSeq Seq Char
str (Int
-> Regex
-> CStringLen
-> IO (Either WrapError (Maybe [(Int, Int)]))
wrapMatch Int
0 Regex
regex)
  case maybeStartEnd of
    Right Maybe [(Int, Int)]
Nothing -> Either WrapError (Maybe MatchArray)
-> IO (Either WrapError (Maybe MatchArray))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe MatchArray -> Either WrapError (Maybe MatchArray)
forall a b. b -> Either a b
Right Maybe MatchArray
forall a. Maybe a
Nothing)
--  Right (Just []) -> fail "got [] back!" -- should never happen
    Right (Just [(Int, Int)]
parts) ->
      Either WrapError (Maybe MatchArray)
-> IO (Either WrapError (Maybe MatchArray))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either WrapError (Maybe MatchArray)
 -> IO (Either WrapError (Maybe MatchArray)))
-> ([(Int, Int)] -> Either WrapError (Maybe MatchArray))
-> [(Int, Int)]
-> IO (Either WrapError (Maybe MatchArray))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe MatchArray -> Either WrapError (Maybe MatchArray)
forall a b. b -> Either a b
Right (Maybe MatchArray -> Either WrapError (Maybe MatchArray))
-> ([(Int, Int)] -> Maybe MatchArray)
-> [(Int, Int)]
-> Either WrapError (Maybe MatchArray)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchArray -> Maybe MatchArray
forall a. a -> Maybe a
Just (MatchArray -> Maybe MatchArray)
-> ([(Int, Int)] -> MatchArray) -> [(Int, Int)] -> Maybe MatchArray
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> [(Int, Int)] -> MatchArray
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int -> Int
forall a. Enum a => a -> a
pred ([(Int, Int)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Int)]
parts))
      ([(Int, Int)] -> MatchArray)
-> ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> MatchArray
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> (Int, Int)) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
s,Int
e)->(Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s, Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
s))) ([(Int, Int)] -> IO (Either WrapError (Maybe MatchArray)))
-> [(Int, Int)] -> IO (Either WrapError (Maybe MatchArray))
forall a b. (a -> b) -> a -> b
$ [(Int, Int)]
parts
    Left WrapError
err -> Either WrapError (Maybe MatchArray)
-> IO (Either WrapError (Maybe MatchArray))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (WrapError -> Either WrapError (Maybe MatchArray)
forall a b. a -> Either a b
Left WrapError
err)

-- | execute match and extract substrings rather than just offsets
regexec  :: Regex      -- ^ compiled regular expression
         -> (Seq Char)     -- ^ string to match
         -> IO (Either WrapError (Maybe ((Seq Char), (Seq Char),(Seq Char), [(Seq Char)])))
                      -- ^ Returns: Nothing if no match, else
                      --   (text before match, text after match, array of matches with 0 being the whole match)
regexec :: Regex
-> Seq Char
-> IO
     (Either
        WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char])))
regexec Regex
regex Seq Char
str = do
  let getSub :: (Int, Int) -> Seq Char
getSub (Int
start,Int
stop) | Int
start Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
unusedOffset = Seq Char
forall a. Seq a
S.empty
                          | Bool
otherwise = (Int, Int) -> Seq Char -> Seq Char
forall source. Extract source => (Int, Int) -> source -> source
extract (Int
start,Int
stopInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
start) Seq Char
str
      matchedParts :: [(Int, Int)] -> (Seq Char, Seq Char, Seq Char, [Seq Char])
matchedParts [] = (Seq Char
forall a. Seq a
S.empty,Seq Char
forall a. Seq a
S.empty,Seq Char
str,[]) -- no information
      matchedParts (matchedStartStop :: (Int, Int)
matchedStartStop@(Int
start,Int
stop):[(Int, Int)]
subStartStop) =
        (Int -> Seq Char -> Seq Char
forall source. Extract source => Int -> source -> source
before Int
start Seq Char
str
        ,(Int, Int) -> Seq Char
getSub (Int, Int)
matchedStartStop
        ,Int -> Seq Char -> Seq Char
forall source. Extract source => Int -> source -> source
after Int
stop Seq Char
str
        ,((Int, Int) -> Seq Char) -> [(Int, Int)] -> [Seq Char]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Seq Char
getSub [(Int, Int)]
subStartStop)
  maybeStartEnd <- Seq Char
-> (CStringLen -> IO (Either WrapError (Maybe [(Int, Int)])))
-> IO (Either WrapError (Maybe [(Int, Int)]))
forall a. Seq Char -> (CStringLen -> IO a) -> IO a
withSeq Seq Char
str (Int
-> Regex
-> CStringLen
-> IO (Either WrapError (Maybe [(Int, Int)]))
wrapMatch Int
0 Regex
regex)
  case maybeStartEnd of
    Right Maybe [(Int, Int)]
Nothing -> Either WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char]))
-> IO
     (Either
        WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char])))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char])
-> Either
     WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char]))
forall a b. b -> Either a b
Right Maybe (Seq Char, Seq Char, Seq Char, [Seq Char])
forall a. Maybe a
Nothing)
--  Right (Just []) -> fail "got [] back!" -- should never happen
    Right (Just [(Int, Int)]
parts) -> Either WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char]))
-> IO
     (Either
        WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char])))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
   WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char]))
 -> IO
      (Either
         WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char]))))
-> ([(Int, Int)]
    -> Either
         WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char])))
-> [(Int, Int)]
-> IO
     (Either
        WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char])))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Seq Char, Seq Char, Seq Char, [Seq Char])
-> Either
     WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char]))
forall a b. b -> Either a b
Right (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char])
 -> Either
      WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char])))
-> ([(Int, Int)]
    -> Maybe (Seq Char, Seq Char, Seq Char, [Seq Char]))
-> [(Int, Int)]
-> Either
     WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq Char, Seq Char, Seq Char, [Seq Char])
-> Maybe (Seq Char, Seq Char, Seq Char, [Seq Char])
forall a. a -> Maybe a
Just ((Seq Char, Seq Char, Seq Char, [Seq Char])
 -> Maybe (Seq Char, Seq Char, Seq Char, [Seq Char]))
-> ([(Int, Int)] -> (Seq Char, Seq Char, Seq Char, [Seq Char]))
-> [(Int, Int)]
-> Maybe (Seq Char, Seq Char, Seq Char, [Seq Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Int)] -> (Seq Char, Seq Char, Seq Char, [Seq Char])
matchedParts ([(Int, Int)]
 -> IO
      (Either
         WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char]))))
-> [(Int, Int)]
-> IO
     (Either
        WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char])))
forall a b. (a -> b) -> a -> b
$ [(Int, Int)]
parts
    Left WrapError
err -> Either WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char]))
-> IO
     (Either
        WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char])))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (WrapError
-> Either
     WrapError (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char]))
forall a b. a -> Either a b
Left WrapError
err)

withSeq :: Seq Char -> (CStringLen -> IO a) -> IO a
withSeq :: forall a. Seq Char -> (CStringLen -> IO a) -> IO a
withSeq Seq Char
s CStringLen -> IO a
f =
  let -- Ensure null at end of s
      len :: Int
len = Seq Char -> Int
forall a. Seq a -> Int
S.length Seq Char
s
      pokes :: CString -> Seq Char -> IO ()
pokes CString
p Seq Char
a | CString -> Bool -> Bool
forall a b. a -> b -> b
seq CString
p (Seq Char -> Bool -> Bool
forall a b. a -> b -> b
seq Seq Char
a Bool
False) = IO ()
forall a. HasCallStack => a
undefined
                | Bool
otherwise =
        case Seq Char -> ViewL Char
forall a. Seq a -> ViewL a
viewl Seq Char
a of
          ViewL Char
EmptyL -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Char
c :< Seq Char
a' -> CString -> CChar -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke CString
p (Char -> CChar
castCharToCChar Char
c) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CString -> Seq Char -> IO ()
pokes (CString -> Int -> CString
forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr CString
p Int
1) Seq Char
a'
  in Int -> (CString -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Seq Char -> Int
forall a. Seq a -> Int
S.length Seq Char
s) (\CString
ptr -> CString -> Seq Char -> IO ()
pokes CString
ptr Seq Char
s IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CStringLen -> IO a
f (CString
ptr,Int
len))

withSeq0 :: Seq Char -> (CString -> IO a) -> IO a
withSeq0 :: forall a. Seq Char -> (CString -> IO a) -> IO a
withSeq0 Seq Char
s CString -> IO a
f =
  let -- Ensure null at end of s
      s' :: Seq Char
s' = case Seq Char -> ViewR Char
forall a. Seq a -> ViewR a
viewr Seq Char
s of                -- bang !s'
             ViewR Char
EmptyR -> Char -> Seq Char
forall a. a -> Seq a
singleton Char
'\0'
             Seq Char
_ :> Char
'\0' -> Seq Char
s
             ViewR Char
_ -> Seq Char
s Seq Char -> Char -> Seq Char
forall a. Seq a -> a -> Seq a
|> Char
'\0'
      pokes :: CString -> Seq Char -> IO ()
pokes CString
p Seq Char
a | CString -> Bool -> Bool
forall a b. a -> b -> b
seq CString
p (Seq Char -> Bool -> Bool
forall a b. a -> b -> b
seq Seq Char
a Bool
False) = IO ()
forall a. HasCallStack => a
undefined
                | Bool
otherwise =
        case Seq Char -> ViewL Char
forall a. Seq a -> ViewL a
viewl Seq Char
a of         -- bang pokes !p !a
          ViewL Char
EmptyL -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Char
c :< Seq Char
a' -> CString -> CChar -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke CString
p (Char -> CChar
castCharToCChar Char
c) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CString -> Seq Char -> IO ()
pokes (CString -> Int -> CString
forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr CString
p Int
1) Seq Char
a'
  in Int -> (CString -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Seq Char -> Int
forall a. Seq a -> Int
S.length Seq Char
s') (\CString
ptr -> CString -> Seq Char -> IO ()
pokes CString
ptr Seq Char
s' IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CString -> IO a
f CString
ptr)