{-# OPTIONS_GHC -fglasgow-exts #-}
{-|

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'.  Nothing else is
exported.   These work for all the front ends and backends
interchangably.  These instances are important because they provide
the different results that can be gotten from a match or matchM
operation (often via the @=~@ and @=~~@ operators).  The name is Context
because they 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.

@ 
type MatchArray = Array Int (MatchOffset, MatchLength)
type MatchText source = Array Int (source, (MatchOffset, MatchLength))
@

These are for the first match:

(@ RegexLike a b => RegexContext a b Bool @) :
  Whether there is any match or not

(@ RegexLike a b => RegexContext a b () @) :
  Useful using @=~~@ in a monad, since failure to match is via 'fail'

(@ RegexLike a b => RegexContext a b (MatchOffset,MatchLength) @) :
  This returns the initial index and length of the whole match.
  Starting at (-1) indicates failure to match.

(@ RegexLike a b => RegexContext a b b @) :
  This returns the text of the whole match.
  It will return 'empty' from 'Extract' if there is no match.
  These are defined in other modules, but documented here for convenience.

(@ RegexLike a b => RegexContext a b MatchArray @) :
  Where each sub-part the match starts and its length.
  Starting at (-1) indicates unused.

(@ RegexLike a b => RegexContext a b (Array Int b) @) :
  The text of each sub-part of the match.
  Unused matches are 'empty' (defined via 'Extract')

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

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

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

(@ RegexLike a b => RegexContext a b (MatchResult b) @) :
  The 'MatchResult' structure for the match.

These instances are for all the matches (non-overlapping):

(@ RegexLike a b => RegexContext a b Int @) :
  The number of matches

These instances similar to the single match ones above, but in a List:

(@ RegexLike a b => RegexContext a b [(MatchOffset, MatchLength)] @) :

(@ RegexLike a b => RegexContext a b [b] @) :
  As a policy, I chose [b] to be the list of whole text of each match.

(@ RegexLike a b => RegexContext a b [MatchArray] @) :

(@ RegexLike a b => RegexContext a b [Array Int b] @) :

(@ RegexLike a b => RegexContext a b [MatchText b] @) :

(@ RegexLike a b => RegexContext a b [[b]] @) :
  This is the list of the list of the text of the sub-part of each match.
  Unused matches are 'empty' (defined via 'Extract')

-}

module Text.Regex.Base.Context() where

import Data.Array(Array,(!),elems,listArray)
import Data.Maybe(maybe)
import Text.Regex.Base.RegexLike(RegexLike(..),RegexContext(..)
  ,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 [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)

#if __GLASGOW_HASKELL__
-- overlaps with instance (RegexLike a b) => RegexContext a b (Array Int b)
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)
#endif

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 (Array Int b) where 
  match r s = maybe nullArray id (matchM r s)
  matchM = actOn (\(_,ma,_) -> fmap fst ma)

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))

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 })

-- ** Instances based on matchAll,matchAllText

#if __GLASGOW_HASKELL__
-- overlaps with instance (RegexLike a b) => RegexContext a b [Array Int b]
instance (RegexLike a b) => RegexContext a b [MatchArray] where
  match = matchAll
  matchM = nullFail
#endif

instance (RegexLike a b) => RegexContext a b [MatchText b] where
  match = matchAllText
  matchM = nullFail
           
#if __GLASGOW_HASKELL__
-- overlaps with instance (RegexLike a b) => RegexContext a b [b]
instance (RegexLike a b) => RegexContext a b [(MatchOffset,MatchLength)] where
  match r s = [ ma!0 | ma <- matchAll r s ]
  matchM = nullFail
#endif

instance (RegexLike a b) => RegexContext a b [b] where
  match r s = [ fst (ma!0) | ma <- matchAllText r s ]
  matchM = nullFail

instance (RegexLike a b) => RegexContext a b [Array Int b] where
  match r s = [ fmap fst ma | ma <- matchAllText r s ]
  matchM = nullFail

instance (RegexLike a b) => RegexContext a b [[b]] where
  match r s = [ map fst (elems ma) | ma <- matchAllText r s ]
  matchM = nullFail