{-# 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
(Int -> RE -> ShowS)
-> (RE -> String) -> ([RE] -> ShowS) -> Show RE
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]
(Int -> ReadS RE)
-> ReadS [RE] -> ReadPrec RE -> ReadPrec [RE] -> Read 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
Eq RE
-> (RE -> RE -> Ordering)
-> (RE -> RE -> Bool)
-> (RE -> RE -> Bool)
-> (RE -> RE -> Bool)
-> (RE -> RE -> Bool)
-> (RE -> RE -> RE)
-> (RE -> RE -> RE)
-> Ord 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
$cp1Ord :: Eq RE
Ord, RE -> RE -> Bool
(RE -> RE -> Bool) -> (RE -> RE -> Bool) -> Eq RE
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
DataType
Constr
Typeable RE
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> RE -> c RE)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RE)
-> (RE -> Constr)
-> (RE -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> RE -> RE)
-> (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 u. (forall d. Data d => d -> u) -> RE -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> RE -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RE -> m RE)
-> Data RE
RE -> DataType
RE -> Constr
(forall b. Data b => b -> b) -> RE -> RE
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RE -> c RE
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cRE :: Constr
$tRE :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> RE -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RE -> u
gmapQ :: (forall d. Data d => d -> u) -> RE -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RE -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable RE
Data, Typeable, (forall x. RE -> Rep RE x)
-> (forall x. Rep RE x -> RE) -> Generic RE
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 [ Text
"reString"        Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString -> Text
encodeToText (RE -> ByteString
reString RE
re)
                     , Text
"reCaseSensitive" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= RE -> Bool
reCaseSensitive RE
re ]
instance FromJSON RE where
  parseJSON :: Value -> Parser RE
parseJSON = String -> (Object -> Parser RE) -> Value -> Parser RE
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RE" ((Object -> Parser RE) -> Value -> Parser RE)
-> (Object -> Parser RE) -> Value -> Parser RE
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    ByteString -> Bool -> RE
RE (ByteString -> Bool -> RE)
-> Parser ByteString -> Parser (Bool -> RE)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"reString") Parser Text -> (Text -> Parser ByteString) -> Parser ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser ByteString
forall (m :: * -> *).
(Monad m, MonadFail m) =>
Text -> m ByteString
decodeFromText)
       Parser (Bool -> RE) -> Parser Bool -> Parser RE
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"reCaseSensitive"

-- functions to marshall bytestrings to text

encodeToText :: BS.ByteString -> Text.Text
encodeToText :: ByteString -> Text
encodeToText = ByteString -> Text
TE.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
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 :: Text -> m ByteString
decodeFromText = (String -> m ByteString)
-> (ByteString -> m ByteString)
-> Either String ByteString
-> m ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> m ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String ByteString -> m ByteString)
-> (Text -> Either String ByteString) -> Text -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
Base64.decode (ByteString -> Either String ByteString)
-> (Text -> ByteString) -> Text -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8