module Text.Regex.Do.Type.Extract where

import Text.Regex.Base.RegexLike as R hiding (empty)
import Prelude as P
import Data.ByteString as B
import Data.Text as T hiding (empty)
import Text.Regex.Do.Type.Do


{- | see String, ByteString instances for implementation examples

    see "Text.Regex.Base.RegexLike" for 'Extract' detail        -}
class Extract a => Extract' a where
   concat'::[a] -> a
   len'::a -> Int


instance Extract' String where
   concat' :: [String] -> String
concat' = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
P.concat
   len' :: String -> Int
len' = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length


instance Extract' B.ByteString where
   concat' :: [ByteString] -> ByteString
concat' = [ByteString] -> ByteString
B.concat
   len' :: ByteString -> Int
len' = ByteString -> Int
B.length


instance Extract' Text where
    concat' :: [Text] -> Text
concat' = [Text] -> Text
T.concat
    len' :: Text -> Int
len' = Text -> Int
T.length


prefix::Extract a => PosLen -> a -> a
prefix :: PosLen -> a -> a
prefix pl0 :: PosLen
pl0 = Int -> a -> a
forall source. Extract source => Int -> source -> source
before (Int -> a -> a) -> Int -> a -> a
forall a b. (a -> b) -> a -> b
$ PosLen -> Int
forall a b. (a, b) -> a
fst PosLen
pl0

suffix::Extract a => PosLen -> a -> a
suffix :: PosLen -> a -> a
suffix pl0 :: PosLen
pl0 = Int -> a -> a
forall source. Extract source => Int -> source -> source
after (Int
pos1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len1)
  where pos1 :: Int
pos1 = PosLen -> Int
forall a b. (a, b) -> a
fst PosLen
pl0
        len1 :: Int
len1 = PosLen -> Int
forall a b. (a, b) -> b
snd PosLen
pl0