module Text.Regex.Do.Type.Convert where

import qualified Data.Text.Encoding as E
import qualified Data.Text as T
import Data.ByteString as B
import Text.Regex.Do.Type.Do_
import Text.Regex.Base.RegexLike as R
import Data.Array as A
import Prelude as P


-- | both Ascii and Utf8
toByteString::String -> ByteString
toByteString :: String -> ByteString
toByteString = Text -> ByteString
E.encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack


-- | both Ascii and Utf8
toString::ByteString -> String
toString :: ByteString -> String
toString = Text -> String
T.unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
E.decodeUtf8



class ToArray a where
    toArray::a -> MatchArray

instance ToArray MatchArray where
    toArray :: MatchArray -> MatchArray
toArray = MatchArray -> MatchArray
forall a. a -> a
id

instance ToArray [PosLen] where
    toArray :: [PosLen] -> MatchArray
toArray [] = PosLen -> [PosLen] -> MatchArray
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (0,0) []
    toArray lpl0 :: [PosLen]
lpl0 = PosLen -> [PosLen] -> MatchArray
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (1, [PosLen] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [PosLen]
lpl0) [PosLen]
lpl0