{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE ViewPatterns         #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

-- ------------------------------------------------------------

{- |
   Copyright  : Copyright (C) 2014- Uwe Schmidt
   License    : MIT

   Maintainer : Uwe Schmidt <uwe@fh-wedel.de>
   Stability  : stable
-}

-- ------------------------------------------------------------

module Text.Regex.XMLSchema.Generic.StringLike
where

import Data.Maybe
import Data.String      (IsString(..))

import qualified Data.Text                  as T
import qualified Data.Text.Lazy             as TL
import qualified Data.ByteString.Char8      as B
import qualified Data.ByteString.Lazy.Char8 as BL

-- ------------------------------------------------------------

-- | /WARNING/: This StringLike class is /not/ intended for use outside this regex library.
-- It provides an abstraction for String's as used inside this library.
-- It allows the library to work with String (list of Char),
-- ByteString.Char8, ByteString.Lazy.Char8,
-- Data.Text and Data.Text.Lazy.
--
-- The class is similar to the StringLike class in the tagsoup package

class (Eq a, IsString a, Show a) => StringLike a where
  emptyS     :: a
  uncons     :: a -> Maybe (Char, a)
  nullS      :: a -> Bool
  headS      :: a -> Char
  takeS      :: Int -> a -> a
  dropS      :: Int -> a -> a
  appendS    :: a -> a -> a
  concatS    :: [a] -> a
  toString   :: a -> String

  nullS      = Maybe (Char, a) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (Char, a) -> Bool) -> (a -> Maybe (Char, a)) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe (Char, a)
forall a. StringLike a => a -> Maybe (Char, a)
uncons
  headS (a -> Maybe (Char, a)
forall a. StringLike a => a -> Maybe (Char, a)
uncons -> Just (Char
c, a
_))
             = Char
c
  headS a
_    = [Char] -> Char
forall a. HasCallStack => [Char] -> a
error [Char]
"headS: empty StringLike"
  concatS    = (a -> a -> a) -> a -> [a] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl a -> a -> a
forall a. StringLike a => a -> a -> a
appendS a
forall a. StringLike a => a
emptyS
  
  {-# INLINE nullS   #-}
  {-# INLINE headS   #-}
  {-# INLINE concatS #-}
  
-- ------------------------------------------------------------

instance StringLike String where
  emptyS :: [Char]
emptyS           = []
  uncons :: [Char] -> Maybe (Char, [Char])
uncons (Char
x : [Char]
xs) = (Char, [Char]) -> Maybe (Char, [Char])
forall a. a -> Maybe a
Just (Char
x, [Char]
xs)
  uncons [Char]
""       = Maybe (Char, [Char])
forall a. Maybe a
Nothing
  nullS :: [Char] -> Bool
nullS           = [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
  headS :: [Char] -> Char
headS           = [Char] -> Char
forall a. [a] -> a
head
  takeS :: Int -> [Char] -> [Char]
takeS           = Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take
  dropS :: Int -> [Char] -> [Char]
dropS           = Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop
  appendS :: [Char] -> [Char] -> [Char]
appendS         = [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
(++)
  concatS :: [[Char]] -> [Char]
concatS         = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  toString :: [Char] -> [Char]
toString        = [Char] -> [Char]
forall a. a -> a
id

  {-# INLINE emptyS     #-}
  {-# INLINE uncons     #-}
  {-# INLINE nullS      #-}
  {-# INLINE takeS      #-}
  {-# INLINE dropS      #-}
  {-# INLINE appendS    #-}
  {-# INLINE concatS    #-}
  {-# INLINE toString   #-}

-- ------------------------------------------------------------

instance StringLike T.Text where
  emptyS :: Text
emptyS     = Text
T.empty
  uncons :: Text -> Maybe (Char, Text)
uncons     = Text -> Maybe (Char, Text)
T.uncons
  nullS :: Text -> Bool
nullS      = Text -> Bool
T.null
  headS :: Text -> Char
headS      = Text -> Char
T.head
  takeS :: Int -> Text -> Text
takeS      = Int -> Text -> Text
T.take
  dropS :: Int -> Text -> Text
dropS      = Int -> Text -> Text
T.drop
  appendS :: Text -> Text -> Text
appendS    = Text -> Text -> Text
T.append
  concatS :: [Text] -> Text
concatS    = [Text] -> Text
T.concat
  toString :: Text -> [Char]
toString   = Text -> [Char]
T.unpack

  {-# INLINE emptyS     #-}
  {-# INLINE uncons     #-}
  {-# INLINE nullS      #-}
  {-# INLINE takeS      #-}
  {-# INLINE dropS      #-}
  {-# INLINE appendS    #-}
  {-# INLINE concatS    #-}
  {-# INLINE toString   #-}

-- ------------------------------------------------------------

instance StringLike TL.Text where
  emptyS :: Text
emptyS     = Text
TL.empty
  uncons :: Text -> Maybe (Char, Text)
uncons     = Text -> Maybe (Char, Text)
TL.uncons
  nullS :: Text -> Bool
nullS      = Text -> Bool
TL.null
  headS :: Text -> Char
headS      = Text -> Char
TL.head
  takeS :: Int -> Text -> Text
takeS      = Int64 -> Text -> Text
TL.take (Int64 -> Text -> Text) -> (Int -> Int64) -> Int -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a. Enum a => Int -> a
toEnum
  dropS :: Int -> Text -> Text
dropS      = Int64 -> Text -> Text
TL.drop (Int64 -> Text -> Text) -> (Int -> Int64) -> Int -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a. Enum a => Int -> a
toEnum
  appendS :: Text -> Text -> Text
appendS    = Text -> Text -> Text
TL.append
  concatS :: [Text] -> Text
concatS    = [Text] -> Text
TL.concat
  toString :: Text -> [Char]
toString   = Text -> [Char]
TL.unpack

  {-# INLINE emptyS     #-}
  {-# INLINE uncons     #-}
  {-# INLINE nullS      #-}
  {-# INLINE takeS      #-}
  {-# INLINE dropS      #-}
  {-# INLINE appendS    #-}
  {-# INLINE concatS    #-}
  {-# INLINE toString   #-}

-- ------------------------------------------------------------

instance StringLike B.ByteString where
  emptyS :: ByteString
emptyS     = ByteString
B.empty
  uncons :: ByteString -> Maybe (Char, ByteString)
uncons     = ByteString -> Maybe (Char, ByteString)
B.uncons
  nullS :: ByteString -> Bool
nullS      = ByteString -> Bool
B.null
  headS :: ByteString -> Char
headS      = ByteString -> Char
B.head
  takeS :: Int -> ByteString -> ByteString
takeS      = Int -> ByteString -> ByteString
B.take
  dropS :: Int -> ByteString -> ByteString
dropS      = Int -> ByteString -> ByteString
B.drop
  appendS :: ByteString -> ByteString -> ByteString
appendS    = ByteString -> ByteString -> ByteString
B.append
  concatS :: [ByteString] -> ByteString
concatS    = [ByteString] -> ByteString
B.concat
  toString :: ByteString -> [Char]
toString   = ByteString -> [Char]
B.unpack

  {-# INLINE emptyS     #-}
  {-# INLINE uncons     #-}
  {-# INLINE nullS      #-}
  {-# INLINE takeS      #-}
  {-# INLINE dropS      #-}
  {-# INLINE appendS    #-}
  {-# INLINE concatS    #-}
  {-# INLINE toString   #-}

-- ------------------------------------------------------------

instance StringLike BL.ByteString where
  emptyS :: ByteString
emptyS     = ByteString
BL.empty
  uncons :: ByteString -> Maybe (Char, ByteString)
uncons     = ByteString -> Maybe (Char, ByteString)
BL.uncons
  nullS :: ByteString -> Bool
nullS      = ByteString -> Bool
BL.null
  headS :: ByteString -> Char
headS      = ByteString -> Char
BL.head
  takeS :: Int -> ByteString -> ByteString
takeS      = Int64 -> ByteString -> ByteString
BL.take (Int64 -> ByteString -> ByteString)
-> (Int -> Int64) -> Int -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a. Enum a => Int -> a
toEnum
  dropS :: Int -> ByteString -> ByteString
dropS      = Int64 -> ByteString -> ByteString
BL.drop (Int64 -> ByteString -> ByteString)
-> (Int -> Int64) -> Int -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a. Enum a => Int -> a
toEnum
  appendS :: ByteString -> ByteString -> ByteString
appendS    = ByteString -> ByteString -> ByteString
BL.append
  concatS :: [ByteString] -> ByteString
concatS    = [ByteString] -> ByteString
BL.concat
  toString :: ByteString -> [Char]
toString   = ByteString -> [Char]
BL.unpack

  {-# INLINE emptyS     #-}
  {-# INLINE uncons     #-}
  {-# INLINE nullS      #-}
  {-# INLINE takeS      #-}
  {-# INLINE dropS      #-}
  {-# INLINE appendS    #-}
  {-# INLINE concatS    #-}
  {-# INLINE toString   #-}

-- ------------------------------------------------------------