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

module Skylighting.Regex (
                Regex(..)
              , RE(..)
              , 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
import GHC.Generics (Generic)
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail (MonadFail)
#endif
import Regex.KDE

-- | A representation of a regular expression.
data RE = RE{
    RE -> ByteString
reString        :: BS.ByteString
  , RE -> Bool
reCaseSensitive :: Bool
} deriving (Int -> RE -> ShowS
[RE] -> ShowS
RE -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RE] -> ShowS
$cshowList :: [RE] -> ShowS
show :: RE -> String
$cshow :: RE -> String
showsPrec :: Int -> RE -> ShowS
$cshowsPrec :: Int -> RE -> ShowS
Show, ReadPrec [RE]
ReadPrec RE
Int -> ReadS RE
ReadS [RE]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RE]
$creadListPrec :: ReadPrec [RE]
readPrec :: ReadPrec RE
$creadPrec :: ReadPrec RE
readList :: ReadS [RE]
$creadList :: ReadS [RE]
readsPrec :: Int -> ReadS RE
$creadsPrec :: Int -> ReadS RE
Read, Eq RE
RE -> RE -> Bool
RE -> RE -> Ordering
RE -> RE -> RE
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RE -> RE -> RE
$cmin :: RE -> RE -> RE
max :: RE -> RE -> RE
$cmax :: RE -> RE -> RE
>= :: RE -> RE -> Bool
$c>= :: RE -> RE -> Bool
> :: RE -> RE -> Bool
$c> :: RE -> RE -> Bool
<= :: RE -> RE -> Bool
$c<= :: RE -> RE -> Bool
< :: RE -> RE -> Bool
$c< :: RE -> RE -> Bool
compare :: RE -> RE -> Ordering
$ccompare :: RE -> RE -> Ordering
Ord, RE -> RE -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RE -> RE -> Bool
$c/= :: RE -> RE -> Bool
== :: RE -> RE -> Bool
$c== :: RE -> RE -> Bool
Eq, Typeable RE
RE -> DataType
RE -> Constr
(forall b. Data b => b -> b) -> RE -> RE
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RE -> u
forall u. (forall d. Data d => d -> u) -> RE -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> RE -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> RE -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RE -> m RE
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RE -> m RE
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RE
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RE -> c RE
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RE)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RE)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RE -> m RE
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RE -> m RE
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RE -> m RE
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RE -> m RE
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RE -> m RE
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RE -> m RE
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RE -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RE -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> RE -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RE -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> RE -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> RE -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> RE -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> RE -> r
gmapT :: (forall b. Data b => b -> b) -> RE -> RE
$cgmapT :: (forall b. Data b => b -> b) -> RE -> RE
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RE)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RE)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RE)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RE)
dataTypeOf :: RE -> DataType
$cdataTypeOf :: RE -> DataType
toConstr :: RE -> Constr
$ctoConstr :: RE -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RE
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RE
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RE -> c RE
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RE -> c RE
Data, Typeable, forall x. Rep RE x -> RE
forall x. RE -> Rep RE x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RE x -> RE
$cfrom :: forall x. RE -> Rep RE x
Generic)

instance Binary RE

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