    {-# 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 $mRE :: forall {r}. RE -> (ByteString -> Bool -> r) -> ((# #) -> r) -> r
    $bRE :: ByteString -> Bool -> RE
    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 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    10)
        (ShowS -> ShowS) -> ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ String -> ShowS
    showString String
    "RE {reString = "
        ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> ByteString -> ShowS
    forall a. Show a => Int -> a -> ShowS
    showsPrec Int
    11 ByteString
    str
        ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    ", reCaseSensitive = "
        ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Bool -> ShowS
    forall a. Show a => Int -> a -> ShowS
    showsPrec Int
    11 Bool
    caseSensitive
        ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    "}"

    instance Read RE where
      readPrec :: ReadPrec RE
    readPrec = ReadPrec RE -> ReadPrec RE
    forall a. ReadPrec a -> ReadPrec a
    parens (ReadPrec RE -> ReadPrec RE)
    -> (ReadPrec RE -> ReadPrec RE) -> ReadPrec RE -> ReadPrec RE
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> ReadPrec RE -> ReadPrec RE
    forall a. Int -> ReadPrec a -> ReadPrec a
    prec Int
    10 (ReadPrec RE -> ReadPrec RE) -> ReadPrec RE -> ReadPrec RE
    forall a b. (a -> b) -> a -> b
    $ do
        Ident "RE" <- ReadPrec Lexeme
    lexP
        Punc "{" <- lexP
        Ident "reString" <- lexP
        Punc "=" <- lexP
        str <- readPrec
        Punc "," <- lexP
        Ident "reCaseSensitive" <- lexP
        Punc "=" <- lexP
        caseSensitive <- readPrec
        Punc "}" <- lexP
        pure (RE str 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 (ByteString, Bool) -> (ByteString, Bool) -> Bool
    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 (ByteString, Bool) -> (ByteString, Bool) -> Ordering
    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) = (ByteString -> Bool -> RE) -> c (ByteString -> Bool -> RE)
    forall g. g -> c g
    z ByteString -> Bool -> RE
    RE c (ByteString -> Bool -> RE) -> ByteString -> c (Bool -> RE)
    forall d b. Data d => c (d -> b) -> d -> c b
    `k` ByteString
    s c (Bool -> RE) -> Bool -> c RE
    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
    _ = c (Bool -> RE) -> c RE
    forall b r. Data b => c (b -> r) -> c r
    k (c (ByteString -> Bool -> RE) -> c (Bool -> RE)
    forall b r. Data b => c (b -> r) -> c r
    k ((ByteString -> Bool -> RE) -> c (ByteString -> Bool -> RE)
    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) = ByteString -> Put
    forall t. Binary t => t -> Put
    put ByteString
    x Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> Put
    forall t. Binary t => t -> Put
    put Bool
    y
      get :: Get RE
    get = ByteString -> Bool -> RE
    RE (ByteString -> Bool -> RE) -> Get ByteString -> Get (Bool -> RE)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get ByteString
    forall t. Binary t => Get t
    get Get (Bool -> RE) -> Get Bool -> Get RE
    forall a b. Get (a -> b) -> Get a -> Get b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Get Bool
    forall t. Binary t => Get t
    get

    instance ToJSON RE where
      toJSON :: RE -> Value
    toJSON RE
    re = [Pair] -> Value
    object [ Key
    "reString"        Key -> Text -> Pair
    forall v. ToJSON v => Key -> v -> Pair
    forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
    .= ByteString -> Text
    encodeToText (RE -> ByteString
    reString RE
    re)
                         , Key
    "reCaseSensitive" Key -> Bool -> Pair
    forall v. ToJSON v => Key -> v -> Pair
    forall e kv v. (KeyValue e kv, ToJSON v) => Key -> 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 -> Key -> Parser Text
    forall a. FromJSON a => Object -> Key -> Parser a
    .: Key
    "reString") Parser Text -> (Text -> Parser ByteString) -> Parser ByteString
    forall a b. Parser a -> (a -> Parser b) -> Parser b
    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 a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Object
    v Object -> Key -> Parser Bool
    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 (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 :: forall (m :: * -> *).
    (Monad m, MonadFail m) =>
    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 a. String -> m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail ByteString -> m ByteString
    forall a. a -> m a
    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

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