    {-# OPTIONS_GHC -fno-warn-orphans #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Text.Regex.Posix.Sequence
    -- Copyright   :  (c) Chris Kuklewicz 2006
    -- License     :  BSD-style (see the file LICENSE)
    --
    -- Maintainer  :  libraries@haskell.org, textregexlazy@personal.mightyreason.com
    -- Stability   :  experimental
    -- Portability :  non-portable (regex-base needs MPTC+FD)
    --
    -- This provides 'String' instances for 'RegexMaker' and 'RegexLike' based
    -- on "Text.Regex.Posix.Wrap", and a ('RegexContext' 'Regex' 'String' 'String')
    -- instance.
    --
    -- To use these instance, you would normally import
    -- "Text.Regex.Posix".  You only need to import this module to use
    -- the medium level API of the compile, regexec, and execute
    -- functions.  All of these report error by returning Left values
    -- instead of undefined or error or fail.
    --
    -----------------------------------------------------------------------------

    module Text.Regex.Posix.Sequence(
      -- ** Types
      Regex,
      MatchOffset,
      MatchLength,
      ReturnCode,
      WrapError,
      -- ** Miscellaneous
      unusedOffset,
      -- ** Medium level API functions
      compile,
      regexec,
      execute,
      -- ** Compilation options
      CompOption(CompOption),
      compBlank,
      compExtended,   -- use extended regex syntax
      compIgnoreCase, -- ignore case when matching
      compNoSub,      -- no substring matching needed
      compNewline,    -- '.' doesn't match newline

      ExecOption(ExecOption),
      execBlank,
      execNotBOL,     -- not at begining of line
      execNotEOL     -- not at end of line
      ) where

    import Data.Array(listArray, Array)
    import System.IO.Unsafe(unsafePerformIO)
    import Text.Regex.Base.RegexLike(RegexContext(..),RegexMaker(..),RegexLike(..),MatchOffset,MatchLength,Extract(..))
    import Text.Regex.Posix.Wrap
    import Text.Regex.Base.Impl(polymatch,polymatchM)
    import Data.Sequence as S hiding (length)
    import qualified Data.Sequence as S (length)
    import Foreign.C.String
    import Foreign.Marshal.Array
    import Foreign.Marshal.Alloc
    import Foreign.Storable

    instance RegexContext Regex (Seq Char) (Seq Char) where
      match = polymatch
      matchM = polymatchM

    unusedOffset :: Int
    unusedOffset = fromIntegral unusedRegOffset

    unwrap :: (Show e) => Either e v -> IO v
    unwrap x = case x of Left err -> fail ("Text.Regex.Posix.Sequence died: "++ show err)
                         Right v -> return v

    instance RegexMaker Regex CompOption ExecOption (Seq Char) where
      makeRegexOpts c e pattern = unsafePerformIO $
        (compile c e pattern >>= unwrap)
      makeRegexOptsM c e pattern = either (fail.show) return $ unsafePerformIO $
        (compile c e pattern)

    instance RegexLike Regex (Seq Char) where
      matchTest regex str = unsafePerformIO $ do
        withSeq str (wrapTest regex) >>= unwrap
      matchOnce regex str = unsafePerformIO $
        execute regex str >>= unwrap
      matchAll regex str = unsafePerformIO $
        withSeq str (wrapMatchAll regex) >>= unwrap
      matchCount regex str = unsafePerformIO $
        withSeq str (wrapCount regex) >>= unwrap

    -- compile
    compile  :: CompOption -- ^ Flags (summed together)
             -> ExecOption -- ^ Flags (summed together)
             -> (Seq Char)     -- ^ The regular expression to compile (ASCII only, no null bytes)
             -> IO (Either WrapError Regex) -- ^ Returns: the compiled regular expression
    compile flags e pattern =  withSeq pattern (wrapCompile flags e)

    -- -----------------------------------------------------------------------------
    -- regexec

    -- | 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' (array of offset length pairs)
                    -- @
    execute regex str = do
      maybeStartEnd <- withSeq str (wrapMatch regex)
      case maybeStartEnd of
        Right Nothing -> return (Right Nothing)
    --  Right (Just []) ->  fail "got [] back!" -- return wierd array instead
        Right (Just parts) ->
          return . Right . Just . listArray (0,pred (length parts))
           . map (\(s,e)->(fromIntegral s, fromIntegral (e-s)))
           $ parts
        Left err -> return (Left err)

    -- -----------------------------------------------------------------------------
    -- regexec

    -- | Matches a regular expression against a string
    regexec :: Regex      -- ^ Compiled regular expression
            -> (Seq Char)     -- ^ (Seq Char) to match against
            -> IO (Either WrapError (Maybe ((Seq Char), (Seq Char), (Seq Char), [(Seq Char)])))
                    -- ^ Returns: 'Nothing' if the regex did not match the
                    -- string, or:
                    --
                    -- @
                    --   'Just' (everything before match,
                    --         matched portion,
                    --         everything after match,
                    --         subexpression matches)
                    -- @
    regexec regex str = do
      let getSub :: (RegOffset,RegOffset) -> (Seq Char)
          getSub (start,stop) | start == unusedRegOffset = S.empty
                              | otherwise =
            extract (fromEnum start,fromEnum $ stop-start) $ str
          matchedParts :: [(RegOffset,RegOffset)] -> ((Seq Char), (Seq Char), (Seq Char), [(Seq Char)])
          matchedParts [] = (str,S.empty,S.empty,[]) -- no information
          matchedParts (matchedStartStop@(start,stop):subStartStop) =
            (before (fromEnum start) str
            ,getSub matchedStartStop
            ,after (fromEnum stop) str
            ,map getSub subStartStop)
      maybeStartEnd <- withSeq str (wrapMatch regex)
      case maybeStartEnd of
        Right Nothing -> return (Right Nothing)
        Right (Just parts) -> return . Right . Just . matchedParts $ parts
        Left err -> return (Left err)

    withSeq :: Seq Char -> (CString -> IO a) -> IO a
    withSeq s f =
      let -- Ensure null at end of s
          s' = case viewr s of                 -- bang !s
                 EmptyR -> singleton '\0'
                 _ :> '\0' -> s
                 _ -> s |> '\0'
          pokes p a = case viewl a of         -- bang pokes !p !a
                        EmptyL -> return ()
                        c :< a' -> poke p (castCharToCChar c) >> pokes (advancePtr p 1) a'
      in allocaBytes (S.length s') (\ptr -> pokes ptr s' >> f ptr)