{-# LANGUAGE CPP                 #-}
{-# LANGUAGE DeriveDataTypeable  #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Skylighting.Regex (
                Regex(..)
              , RE
              , pattern RE, reCaseSensitive, reString
              , compileRE
              , compileRegex
              , matchRegex
              , testRegex
              , isWordChar
              ) where

import Data.Aeson
import Data.Binary (Binary(..))
import qualified Data.ByteString.Base64 as Base64
import qualified Data.ByteString.Char8 as BS
import Data.Data
import qualified Data.Text as Text
import qualified Data.Text.Encoding as TE
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail (MonadFail)
#endif
import Regex.KDE

import Text.Read hiding (get)

-- | A representation of a regular expression.
data RE = RE'{
    RE -> ByteString
_reString        :: BS.ByteString
  , RE -> Bool
_reCaseSensitive :: Bool
  , RE -> Either String Regex
_reCompiled      :: Either String Regex
} deriving Typeable

-- We define a smart constructor which also holds the compiled regex, to avoid
-- recompiling each time we tokenize.

{-# COMPLETE RE #-}
pattern RE :: BS.ByteString -> Bool  -> RE
pattern $bRE :: ByteString -> Bool -> RE
$mRE :: forall {r}. RE -> (ByteString -> Bool -> r) -> ((# #) -> r) -> r
RE {RE -> ByteString
reString, RE -> Bool
reCaseSensitive} <- RE' reString reCaseSensitive _ where
  RE ByteString
str Bool
caseSensitive = ByteString -> Bool -> Either String Regex -> RE
RE' ByteString
str Bool
caseSensitive (Bool -> ByteString -> Either String Regex
compileRegex Bool
caseSensitive ByteString
str)

-- Unfortunately this means we need to derive all the instances ourselves.

instance Show RE where
  showsPrec :: Int -> RE -> ShowS
showsPrec Int
d (RE ByteString
str Bool
caseSensitive) = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) 
    forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"RE {reString = " 
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 ByteString
str
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", reCaseSensitive = "
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Bool
caseSensitive
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"}"

instance Read RE where
  readPrec :: ReadPrec RE
readPrec = forall a. ReadPrec a -> ReadPrec a
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 forall a b. (a -> b) -> a -> b
$ do
    Ident String
"RE" <- ReadPrec Lexeme
lexP
    Punc String
"{" <- ReadPrec Lexeme
lexP
    Ident String
"reString" <- ReadPrec Lexeme
lexP
    Punc String
"=" <- ReadPrec Lexeme
lexP
    ByteString
str <- forall a. Read a => ReadPrec a
readPrec
    Punc String
"," <- ReadPrec Lexeme
lexP
    Ident String
"reCaseSensitive" <- ReadPrec Lexeme
lexP
    Punc String
"=" <- ReadPrec Lexeme
lexP
    Bool
caseSensitive <- forall a. Read a => ReadPrec a
readPrec
    Punc String
"}" <- ReadPrec Lexeme
lexP
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Bool -> RE
RE ByteString
str Bool
caseSensitive)

toComparisonKey :: RE -> (BS.ByteString, Bool)
toComparisonKey :: RE -> (ByteString, Bool)
toComparisonKey (RE ByteString
x Bool
y) = (ByteString
x, Bool
y)

instance Eq RE where
  RE
x == :: RE -> RE -> Bool
== RE
y = RE -> (ByteString, Bool)
toComparisonKey RE
x forall a. Eq a => a -> a -> Bool
== RE -> (ByteString, Bool)
toComparisonKey RE
y

instance Ord RE where
  RE
x compare :: RE -> RE -> Ordering
`compare` RE
y = RE -> (ByteString, Bool)
toComparisonKey RE
x forall a. Ord a => a -> a -> Ordering
`compare` RE -> (ByteString, Bool)
toComparisonKey RE
y

conRE :: Constr
conRE :: Constr
conRE = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
tyRE String
"RE" [] Fixity
Prefix
tyRE :: DataType
tyRE :: DataType
tyRE   = String -> [Constr] -> DataType
mkDataType String
"Skylighting.Regex.RE" [Constr
conRE]

instance Data RE where
  gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RE -> c RE
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
k forall g. g -> c g
z (RE ByteString
s Bool
c) = forall g. g -> c g
z ByteString -> Bool -> RE
RE forall d b. Data d => c (d -> b) -> d -> c b
`k` ByteString
s forall d b. Data d => c (d -> b) -> d -> c b
`k` Bool
c
  gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RE
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
_ = forall b r. Data b => c (b -> r) -> c r
k (forall b r. Data b => c (b -> r) -> c r
k (forall r. r -> c r
z ByteString -> Bool -> RE
RE))
  toConstr :: RE -> Constr
toConstr RE
_ = Constr
conRE
  dataTypeOf :: RE -> DataType
dataTypeOf RE
_ = DataType
tyRE

instance Binary RE where
  put :: RE -> Put
put (RE ByteString
x Bool
y) = forall t. Binary t => t -> Put
put ByteString
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Bool
y
  get :: Get RE
get = ByteString -> Bool -> RE
RE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get

instance ToJSON RE where
  toJSON :: RE -> Value
toJSON RE
re = [Pair] -> Value
object [ Key
"reString"        forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ByteString -> Text
encodeToText (RE -> ByteString
reString RE
re)
                     , Key
"reCaseSensitive" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RE -> Bool
reCaseSensitive RE
re ]
instance FromJSON RE where
  parseJSON :: Value -> Parser RE
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RE" forall a b. (a -> b) -> a -> b
$ \Object
v ->
    ByteString -> Bool -> RE
RE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"reString") forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
(Monad m, MonadFail m) =>
Text -> m ByteString
decodeFromText)
       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"reCaseSensitive"

-- functions to marshall bytestrings to text

encodeToText :: BS.ByteString -> Text.Text
encodeToText :: ByteString -> Text
encodeToText = ByteString -> Text
TE.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base64.encode

decodeFromText :: (Monad m, MonadFail m) => Text.Text -> m BS.ByteString
decodeFromText :: forall (m :: * -> *).
(Monad m, MonadFail m) =>
Text -> m ByteString
decodeFromText = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
Base64.decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8

compileRE :: RE -> Either String Regex
compileRE :: RE -> Either String Regex
compileRE = RE -> Either String Regex
_reCompiled