    {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
    {-# OPTIONS_GHC -fno-warn-orphans #-}
    {-|

    Module      :  Text.Regex.Base.Context
    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 (MPTC+FD)

    This is a module of instances of 'RegexContext' (defined in
    Text.Regex.Base.RegexLike).  Nothing else is exported.  This is
    usually imported via the Text.Regex.Base convenience package which
    itself is re-exported from newer Text.Regex.XXX modules provided by
    the different regex-xxx backends.

    These instances work for all the supported types and backends
    interchangably.  These instances provide the different results that
    can be gotten from a match or matchM operation (often via the @=~@ and
    @=~~@ operators with combine @makeRegex@ with @match@ and @matchM@
    respectively).  This module name is Context because they operators are
    context dependent: use them in a context that expects an Int and you
    get a count of matches, use them in a Bool context and get True if
    there is a match, etc.

    @RegexContext a b c@ takes a regular expression suppied in a type 'a'
    generated by 'RegexMaker' and a target text supplied in type 'b' to a
    result type 'c' using the 'match' class function.  The 'matchM' class
    function works like 'match' unless there is no match found, in which
    case it calls 'fail' in the (arbitrary) monad context.

    There are a few type synonyms from RegexLike that are used here:

    @
    -- | 0 based index from start of source, or (-1) for unused
    type MatchOffset = Int
    -- | non-negative length of a match
    type MatchLength = Int
    type MatchArray = Array Int (MatchOffset, MatchLength)
    type MatchText source = Array Int (source, (MatchOffset, MatchLength))
    @

    There are also a few newtypes that used to prevent any possible
    overlap of types, which were not needed for GHC's late overlap
    detection but are needed for use in Hugs.

    @
    newtype AllSubmatches f b = AllSubmatches {getAllSubmatches :: (f b)}
    newtype AllTextSubmatches f b = AllTextSubmatches {getAllTextSubmatches :: (f b)}
    newtype AllMatches f b = AllMatches {getAllMatches :: (f b)}
    newtype AllTextMatches f b = AllTextMatches {getAllTextMatches :: (f b) }
    @

    The newtypes' @f@ parameters are the containers, usually @[]@ or
    @Array Int@, (where the arrays all have lower bound 0).

    The two *Submatches newtypes return only information on the first
    match.  The other two newtypes return information on all the
    non-overlapping matches.  The two *Text* newtypes are used to mark
    result types that contain the same type as the target text.

    Where provided, noncaptured submatches will have a @MatchOffset@ of
    (-1) and non-negative otherwise.  The semantics of submatches depend
    on the backend and its compile and execution options.  Where provided,
    @MatchLength@ will always be non-negative.  Arrays with no elements
    are returned with bounds of (1,0).  Arrays with elements will have a
    lower bound of 0.

    XXX THIS HADDOCK DOCUMENTATION IS OUT OF DATE XXX

    These are for finding the first match in the target text:

    @ RegexContext a b Bool @ :
      Whether there is any match or not.

    @ RegexContext a b () @ :
      Useful as a guard with @matchM@ or @=~~@ in a monad, since failure to match calls 'fail'.

    @ RegexContext a b b @ :
      This returns the text of the whole match.
      It will return 'empty' from the 'Extract' type class if there is no match.
      These are defined in each backend module, but documented here for convenience.

    @ RegexContext a b (MatchOffset,MatchLength) @ :
      This returns the initial index and length of the whole match.
      MatchLength will always be non-negative, and 0 for a failed match.

    @ RegexContext a b (MatchResult b) @ : The
      'MatchResult' structure with details for the match.  This is the
      structure copied from the old @JRegex@ pacakge.

    @ RegexContext a b (b, b, b) @ :
      The text before the match, the text of the match, the text after the match

    @ RegexContext a b (b, MatchText b, b) @ :
      The text before the match, the details of the match, and the text after the match

    @ RegexContext a b (b, b, b, [b]) @ :
      The text before the match, the text of the match, the text after the
      match, and a list of the text of the 1st and higher sub-parts of the
      match.  This is the same return value as used in the old
      @Text.Regex@ API.

    Two containers of the submatch offset information:

    @ RegexContext a b MatchArray @ :
      Array of @(MatchOffset,MatchLength)@ for all the sub matches.
      The whole match is at the intial 0th index.
      Noncaptured submatches will have a @MatchOffset@ of (-1)
      The array will have no elements and bounds (1,0) if there is no match.

    @ RegexContext a b (AllSubmatches [] (MatchOffset,MatchLength) @ :
      List of @(MatchOffset,MatchLength)@
      The whole match is the first element, the rest are the submatches (if any) in order.
      The list is empty if there is no match.

    Two containers of the submatch text and offset information:

    @ RegexContext a b (AllTextSubmatches (Array Int) (b, (MatchOffset, MatchLength))) @

    @ RegexContext a b (AllTextSubmatches [] (b, (MatchOffset, MatchLength)))  @

    Two containers of the submatch text information:

    @ RegexContext a b (AllTextSubmatches [] b) @

    @ RegexContext a b (AllTextSubmatches (Array Int) b) @

    These instances are for all the matches (non-overlapping).  Note that
    backends are supposed to supply 'RegexLike' instances for which the
    default 'matchAll' and 'matchAllText' stop searching after returning
    any successful but empty match.

    @ RegexContext a b Int @ :
      The number of matches, non-negative.

    Two containers for locations of all matches:

    @ RegexContext a b (AllMatches [] (MatchOffset, MatchLength)) @

    @ RegexContext a b (AllMatches (Array Int) (MatchOffset,MatchLength)) @

    Two containers for the locations of all matches and their submatches:

    @ RegexContext a b [MatchArray] @ :

    @ RegexContext a b (AllMatches (Array Int) MatchArray) @

    Two containers for the text and locations of all matches and their submatches:

    @ RegexContext a b [MatchText b] @

    @ RegexContext a b (AllTextMatches (Array Int) (MatchText b)) @

    Two containers for text of all matches:
    @ RegexContext a b (AllTextMatches [] b) @

    @ RegexContext a b (AllTextMatches (Array Int) b) @

    Four containers for text of all matches and their submatches:

    @ RegexContext a b [[b]] @

    @ RegexContext a b (AllTextMatches (Array Int) [b]) @

    @ RegexContext a b (AllTextMatches [] (Array Int b)) @

    @ RegexContext a b (AllTextMatches (Array Int) (Array Int b)) @

    Unused matches are 'empty' (defined via 'Extract')

    -}

    module Text.Regex.Base.Context() where

    import Control.Monad(liftM)
    import Data.Array(Array,(!),elems,listArray)
    --  import Data.Maybe(maybe)
    import Text.Regex.Base.RegexLike(RegexLike(..),RegexContext(..)
      ,AllSubmatches(..),AllTextSubmatches(..),AllMatches(..),AllTextMatches(..)
      ,MatchResult(..),Extract(empty),MatchOffset,MatchLength,MatchArray,MatchText)

    {-
    -- Get the ByteString type for mood/doom
    import Data.ByteString(ByteString)
    -- Get the Regex types for the mood/doom workaround
    import qualified Text.Regex.Lib.WrapPosix as R1(Regex)
    import qualified Text.Regex.Lib.WrapPCRE as R2(Regex)
    import qualified Text.Regex.Lib.WrapLazy as R3(Regex)
    import qualified Text.Regex.Lib.WrapDFAEngine as R4(Regex)
    -- Get the RegexLike instances
    import Text.Regex.Lib.StringPosix()
    import Text.Regex.Lib.StringPCRE()
    import Text.Regex.Lib.StringLazy()
    import Text.Regex.Lib.StringDFAEngine()
    import Text.Regex.Lib.ByteStringPosix()
    import Text.Regex.Lib.ByteStringPCRE()
    import Text.Regex.Lib.ByteStringLazy()
    import Text.Regex.Lib.ByteStringDFAEngine()
    -}
    {-

    mood :: (RegexLike a b) => a -> b -> b
    {-# INLINE mood #-}
    mood r s = case matchOnceText r s of
        Nothing -> empty
        Just (_,ma,_) -> fst (ma!0)

    doom :: (RegexLike a b,Monad m) => a -> b -> m b
    {-# INLINE doom #-}
    doom =  actOn (\(_,ma,_)->fst (ma!0))

    {- These run afoul of various restrictions if I say
       "instance RegexContext a b b where"
       so I am listing these cases explicitly
    -}

    instance RegexContext R1.Regex String String where match = mood; matchM = doom
    instance RegexContext R2.Regex String String where match = mood; matchM = doom
    instance RegexContext R3.Regex String String where match = mood; matchM = doom
    instance RegexContext R4.Regex String String where match = mood; matchM = doom
    instance RegexContext R1.Regex ByteString ByteString where match = mood; matchM = doom
    instance RegexContext R2.Regex ByteString ByteString where match = mood; matchM = doom
    instance RegexContext R3.Regex ByteString ByteString where match = mood; matchM = doom
    instance RegexContext R4.Regex ByteString ByteString where match = mood; matchM = doom
    -}

    nullArray :: Array Int a
    {-# INLINE nullArray #-}
    nullArray = listArray (1,0) []

    nullFail :: (RegexContext regex source (AllMatches [] target),Monad m) => regex -> source -> m (AllMatches [] target)
    {-# INLINE nullFail #-}
    nullFail r s = case match r s of
                     (AllMatches []) -> regexFailed
                     xs -> return xs

    nullFailText :: (RegexContext regex source (AllTextMatches [] target),Monad m) => regex -> source -> m (AllTextMatches [] target)
    {-# INLINE nullFailText #-}
    nullFailText r s = case match r s of
                         (AllTextMatches []) -> regexFailed
                         xs -> return xs

    nullFail' :: (RegexContext regex source ([] target),Monad m) => regex -> source -> m ([] target)
    {-# INLINE nullFail' #-}
    nullFail' r s = case match r s of
                     ([]) -> regexFailed
                     xs -> return xs

    regexFailed :: (Monad m) => m b
    {-# INLINE regexFailed #-}
    regexFailed =  fail $ "regex failed to match"

    actOn :: (RegexLike r s,Monad m) => ((s,MatchText s,s)->t) -> r -> s -> m t
    {-# INLINE actOn #-}
    actOn f r s = case matchOnceText r s of
        Nothing -> regexFailed
        Just preMApost -> return (f preMApost)

    -- ** Instances based on matchTest ()

    instance (RegexLike a b) => RegexContext a b Bool where
      match = matchTest
      matchM r s = case match r s of
                     False -> regexFailed
                     True -> return True

    instance (RegexLike a b) => RegexContext a b () where
      match _ _ = ()
      matchM r s = case matchTest r s of
                     False -> regexFailed
                     True -> return ()

    -- ** Instance based on matchCount

    instance (RegexLike a b) => RegexContext a b Int where
      match = matchCount
      matchM r s = case match r s of
                     0 -> regexFailed
                     x -> return x

    -- ** Instances based on matchOnce,matchOnceText

    instance (RegexLike a b) => RegexContext a b (MatchOffset,MatchLength) where
      match r s = maybe (-1,0) (!0) (matchOnce r s)
      matchM r s = maybe regexFailed (return.(!0)) (matchOnce r s)

    instance (RegexLike a b) => RegexContext a b (MatchResult b) where
      match r s = maybe (MR {mrBefore = s,mrMatch = empty,mrAfter = empty
                            ,mrSubs = nullArray,mrSubList = []}) id (matchM r s)
      matchM = actOn (\(pre,ma,post) ->
         let ((whole,_):subs) = elems ma
         in MR { mrBefore = pre
               , mrMatch = whole
               , mrAfter = post
               , mrSubs = fmap fst ma
               , mrSubList = map fst subs })

    instance (RegexLike a b) => RegexContext a b (b,MatchText b,b) where
      match r s = maybe (s,nullArray,empty) id (matchOnceText r s)
      matchM r s = maybe regexFailed return (matchOnceText r s)

    instance (RegexLike a b) => RegexContext a b (b,b,b) where
      match r s = maybe (s,empty,empty) id (matchM r s)
      matchM = actOn (\(pre,ma,post) -> let ((whole,_):_) = elems ma
                                        in (pre,whole,post))

    instance (RegexLike a b) => RegexContext a b (b,b,b,[b]) where
      match r s = maybe (s,empty,empty,[]) id (matchM r s)
      matchM = actOn (\(pre,ma,post) -> let ((whole,_):subs) = elems ma
                                        in (pre,whole,post,map fst subs))

    -- now AllSubmatches wrapper
    instance (RegexLike a b) => RegexContext a b MatchArray where
      match r s = maybe nullArray id (matchOnce r s)
      matchM r s = maybe regexFailed return (matchOnce r s)
    instance (RegexLike a b) => RegexContext a b (AllSubmatches [] (MatchOffset,MatchLength)) where
      match r s = maybe (AllSubmatches []) id (matchM r s)
      matchM r s = case matchOnce r s of
                     Nothing -> regexFailed
                     Just ma -> return (AllSubmatches (elems ma))

    -- essentially AllSubmatches applied to (MatchText b)
    instance (RegexLike a b) => RegexContext a b (AllTextSubmatches (Array Int) (b, (MatchOffset, MatchLength))) where
      match r s = maybe (AllTextSubmatches nullArray) id (matchM r s)
      matchM r s = actOn (\(_,ma,_) -> AllTextSubmatches ma) r s
    instance (RegexLike a b) => RegexContext a b (AllTextSubmatches [] (b, (MatchOffset, MatchLength))) where
      match r s = maybe (AllTextSubmatches []) id (matchM r s)
      matchM r s = actOn (\(_,ma,_) -> AllTextSubmatches (elems ma)) r s

    instance (RegexLike a b) => RegexContext a b (AllTextSubmatches [] b) where
      match r s = maybe (AllTextSubmatches []) id (matchM r s)
      matchM r s = liftM AllTextSubmatches $ actOn (\(_,ma,_) -> map fst . elems $ ma) r s
    instance (RegexLike a b) => RegexContext a b (AllTextSubmatches (Array Int) b) where
      match r s = maybe (AllTextSubmatches nullArray) id (matchM r s)
      matchM r s = liftM AllTextSubmatches $ actOn (\(_,ma,_) -> fmap fst ma) r s

    -- ** Instances based on matchAll,matchAllText

    instance (RegexLike a b) => RegexContext a b (AllMatches [] (MatchOffset,MatchLength)) where
      match r s = AllMatches [ ma!0 | ma <- matchAll r s ]
      matchM r s = nullFail r s
    instance (RegexLike a b) => RegexContext a b (AllMatches (Array Int) (MatchOffset,MatchLength)) where
      match r s = maybe (AllMatches nullArray) id (matchM r s)
      matchM r s = case match r s of
                     (AllMatches []) -> regexFailed
                     (AllMatches pairs) -> return . AllMatches . listArray (0,pred $ length pairs) $ pairs

    -- No AllMatches wrapper
    instance (RegexLike a b) => RegexContext a b [MatchArray] where
      match = matchAll
      matchM = nullFail'
    instance (RegexLike a b) => RegexContext a b (AllMatches (Array Int) MatchArray) where
      match r s = maybe (AllMatches nullArray) id (matchM r s)
      matchM r s = case match r s of
                     [] -> regexFailed
                     mas -> return . AllMatches . listArray (0,pred $ length mas) $ mas

    -- No AllTextMatches wrapper
    instance (RegexLike a b) => RegexContext a b [MatchText b] where
      match = matchAllText
      matchM = nullFail'
    instance (RegexLike a b) => RegexContext a b (AllTextMatches (Array Int) (MatchText b)) where
      match r s = maybe (AllTextMatches nullArray) id (matchM r s)
      matchM r s = case match r s of
                     ([]) -> regexFailed
                     (mts) -> return . AllTextMatches . listArray (0,pred $ length mts) $ mts

    instance (RegexLike a b) => RegexContext a b (AllTextMatches [] b) where
      match r s = AllTextMatches [ fst (ma!0) | ma <- matchAllText r s ]
      matchM r s = nullFailText r s
    instance (RegexLike a b) => RegexContext a b (AllTextMatches (Array Int) b) where
      match r s = maybe (AllTextMatches nullArray) id (matchM r s)
      matchM r s = case match r s of
                     (AllTextMatches []) -> regexFailed
                     (AllTextMatches bs) -> return . AllTextMatches . listArray (0,pred $ length bs) $ bs

    -- No AllTextMatches wrapper
    instance (RegexLike a b) => RegexContext a b [[b]] where
      match r s = [ map fst (elems ma) | ma <- matchAllText r s ]
      matchM r s = nullFail' r s
    instance (RegexLike a b) => RegexContext a b (AllTextMatches (Array Int) [b]) where
      match r s = maybe (AllTextMatches nullArray) id (matchM r s)
      matchM r s = case match r s of
                     ([]) -> regexFailed
                     (ls) -> return . AllTextMatches . listArray (0,pred $ length ls) $ ls
    instance (RegexLike a b) => RegexContext a b (AllTextMatches [] (Array Int b)) where
      match r s = AllTextMatches [ fmap fst ma | ma <- matchAllText r s ]
      matchM r s = nullFailText r s
    instance (RegexLike a b) => RegexContext a b (AllTextMatches (Array Int) (Array Int b)) where
      match r s = maybe (AllTextMatches nullArray) id (matchM r s)
      matchM r s = case match r s of
                     (AllTextMatches []) -> regexFailed
                     (AllTextMatches as) -> return . AllTextMatches . listArray (0,pred $ length as) $ as