-- |
-- This module contains the Relapse string expressions.

module Data.Katydid.Relapse.Exprs.Strings
  ( mkHasPrefixExpr
  , hasPrefixExpr
  , mkHasSuffixExpr
  , hasSuffixExpr
  , mkRegexExpr
  , regexExpr
  , mkToLowerExpr
  , toLowerExpr
  , mkToUpperExpr
  , toUpperExpr
  )
where

import           Text.Regex.TDFA                ( (=~) )
import           Data.Text                      ( Text
                                                , isPrefixOf
                                                , isSuffixOf
                                                , toLower
                                                , toUpper
                                                , unpack
                                                )

import           Data.Katydid.Relapse.Expr

-- |
-- mkHasPrefixExpr dynamically creates a hasPrefix expression.
mkHasPrefixExpr :: [AnyExpr] -> Either String AnyExpr
mkHasPrefixExpr es = do
  (e1, e2) <- assertArgs2 "hasPrefix" es
  s1       <- assertString e1
  s2       <- assertString e2
  return $ mkBoolExpr $ hasPrefixExpr s1 s2

-- |
-- hasPrefixExpr creates a hasPrefix expression that returns true if the second is a prefix of the first.
hasPrefixExpr :: Expr Text -> Expr Text -> Expr Bool
hasPrefixExpr e1 e2 = trimBool Expr
  { desc = mkDesc "hasPrefix" [desc e1, desc e2]
  , eval = \v -> isPrefixOf <$> eval e2 v <*> eval e1 v
  }

-- |
-- mkHasSuffixExpr dynamically creates a hasSuffix expression.
mkHasSuffixExpr :: [AnyExpr] -> Either String AnyExpr
mkHasSuffixExpr es = do
  (e1, e2) <- assertArgs2 "hasSuffix" es
  s1       <- assertString e1
  s2       <- assertString e2
  return $ mkBoolExpr $ hasSuffixExpr s1 s2

-- |
-- hasSuffixExpr creates a hasSuffix expression that returns true if the second is a suffix of the first.
hasSuffixExpr :: Expr Text -> Expr Text -> Expr Bool
hasSuffixExpr e1 e2 = trimBool Expr
  { desc = mkDesc "hasSuffix" [desc e1, desc e2]
  , eval = \v -> isSuffixOf <$> eval e2 v <*> eval e1 v
  }

-- |
-- mkRegexExpr dynamically creates a regex expression.
mkRegexExpr :: [AnyExpr] -> Either String AnyExpr
mkRegexExpr es = do
  (e1, e2) <- assertArgs2 "regex" es
  e        <- assertString e1
  s        <- assertString e2
  return $ mkBoolExpr $ regexExpr e s

-- |
-- regexExpr creates a regex expression that returns true if the first expression matches the second string. 
regexExpr :: Expr Text -> Expr Text -> Expr Bool
regexExpr e s = trimBool Expr
  { desc = mkDesc "regex" [desc e, desc s]
  , eval = \v -> do
    s1 <- eval s v
    e1 <- eval e v
    return $ (=~) (unpack s1) (unpack e1)
  }

-- |
-- mkToLowerExpr dynamically creates a toLower expression.
mkToLowerExpr :: [AnyExpr] -> Either String AnyExpr
mkToLowerExpr es = do
  e <- assertArgs1 "toLower" es
  s <- assertString e
  return $ mkStringExpr $ toLowerExpr s

-- |
-- toLowerExpr creates a toLower expression that converts the input string to a lowercase string.
toLowerExpr :: Expr Text -> Expr Text
toLowerExpr e = trimString Expr
  { desc = mkDesc "toLower" [desc e]
  , eval = \v -> toLower <$> eval e v
  }

-- |
-- mkToUpperExpr dynamically creates a toUpper expression.
mkToUpperExpr :: [AnyExpr] -> Either String AnyExpr
mkToUpperExpr es = do
  e <- assertArgs1 "toUpper" es
  s <- assertString e
  return $ mkStringExpr $ toUpperExpr s

-- |
-- toUpperExpr creates a toUpper expression that converts the input string to an uppercase string.
toUpperExpr :: Expr Text -> Expr Text
toUpperExpr e = trimString Expr
  { desc = mkDesc "toUpper" [desc e]
  , eval = \v -> toUpper <$> eval e v
  }