{- |
Module      : Unleash.Internal.Predicates
Copyright   : Copyright © FINN.no AS, Inc. All rights reserved.
License     : MIT
Stability   : experimental

Predicate helpers.
-}
module Unleash.Internal.Predicates (
    datePredicate,
    numPredicate,
    semVerPredicate,
) where

import Control.Applicative ((<|>))
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Time (UTCTime, zonedTimeToUTC)
import Data.Time.Format.ISO8601 (iso8601ParseM)
import Data.Time.LocalTime (ZonedTime)
import Data.Versions (SemVer, semver)
import Text.Read (readMaybe)

-- | Evaluate a predicate for UTC times.
datePredicate ::
    -- | Predicate.
    (UTCTime -> UTCTime -> Bool) ->
    -- | First argument to predicate (to be parsed to UTC time).
    Maybe Text ->
    -- | Second argument to predicate (to be parsed to UTC time).
    Maybe Text ->
    -- | Predicate result.
    Bool
datePredicate :: (UTCTime -> UTCTime -> Bool) -> Maybe Text -> Maybe Text -> Bool
datePredicate UTCTime -> UTCTime -> Bool
predicate Maybe Text
mCurrentValue Maybe Text
mConstraintValue = do
    let parseDate :: Text -> Maybe UTCTime
        parseDate :: Text -> Maybe UTCTime
parseDate Text
text =
            (forall (m :: * -> *) t. (MonadFail m, ISO8601 t) => String -> m t
iso8601ParseM @Maybe @UTCTime (String -> Maybe UTCTime) -> String -> Maybe UTCTime
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
text)
                Maybe UTCTime -> Maybe UTCTime -> Maybe UTCTime
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ZonedTime -> UTCTime
zonedTimeToUTC (ZonedTime -> UTCTime) -> Maybe ZonedTime -> Maybe UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (m :: * -> *) t. (MonadFail m, ISO8601 t) => String -> m t
iso8601ParseM @Maybe @ZonedTime (String -> Maybe ZonedTime) -> String -> Maybe ZonedTime
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
text)

    let Maybe UTCTime
mConstraintDate :: Maybe UTCTime = Text -> Maybe UTCTime
parseDate (Text -> Maybe UTCTime) -> Maybe Text -> Maybe UTCTime
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text
mConstraintValue
    let Maybe UTCTime
mProvidedDate :: Maybe UTCTime = Text -> Maybe UTCTime
parseDate (Text -> Maybe UTCTime) -> Maybe Text -> Maybe UTCTime
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text
mCurrentValue

    case (Maybe UTCTime
mProvidedDate, Maybe UTCTime
mConstraintDate) of
        (Just UTCTime
providedDate, Just UTCTime
constraintDate) -> UTCTime -> UTCTime -> Bool
predicate UTCTime
providedDate UTCTime
constraintDate
        (Maybe UTCTime, Maybe UTCTime)
_ -> Bool
False

-- | Evaluate a predicate for numbers.
numPredicate ::
    -- | Predicate.
    (Double -> Double -> Bool) ->
    -- | First argument to predicate (to be parsed to UTC time).
    Maybe Text ->
    -- | Second argument to predicate (to be parsed to UTC time).
    Maybe Text ->
    -- | Predicate result.
    Bool
numPredicate :: (Double -> Double -> Bool) -> Maybe Text -> Maybe Text -> Bool
numPredicate Double -> Double -> Bool
predicate Maybe Text
mCurrentValue Maybe Text
mConstraintValue = do
    let Maybe Double
maybeCurrentValue :: Maybe Double = String -> Maybe Double
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Double)
-> (Text -> String) -> Text -> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> Maybe Double) -> Maybe Text -> Maybe Double
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text
mCurrentValue
    let Maybe Double
maybeConstraintValue :: Maybe Double = String -> Maybe Double
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Double)
-> (Text -> String) -> Text -> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> Maybe Double) -> Maybe Text -> Maybe Double
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text
mConstraintValue

    case (Maybe Double
maybeConstraintValue, Maybe Double
maybeCurrentValue) of
        (Just Double
constraintValue, Just Double
currentValue) -> Double -> Double -> Bool
predicate Double
currentValue Double
constraintValue
        (Maybe Double, Maybe Double)
_ -> Bool
False

-- | Evaluate a predicate for semantic versioning values.
semVerPredicate ::
    -- | Predicate.
    (SemVer -> SemVer -> Bool) ->
    -- | First argument to predicate (to be parsed to a version).
    Maybe Text ->
    -- | Second argument to predicate (to be parsed to a version).
    Maybe Text ->
    -- | Predicate result.
    Bool
semVerPredicate :: (SemVer -> SemVer -> Bool) -> Maybe Text -> Maybe Text -> Bool
semVerPredicate SemVer -> SemVer -> Bool
predicate Maybe Text
mCurrentValue Maybe Text
mConstraintValue = do
    let eitherToMaybe :: Either a a -> Maybe a
eitherToMaybe Either a a
e =
            case Either a a
e of
                Right a
a -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
                Either a a
_ -> Maybe a
forall a. Maybe a
Nothing

    let Maybe SemVer
mConstraintSemVer :: Maybe SemVer = Either ParsingError SemVer -> Maybe SemVer
forall {a} {a}. Either a a -> Maybe a
eitherToMaybe (Either ParsingError SemVer -> Maybe SemVer)
-> (Text -> Either ParsingError SemVer) -> Text -> Maybe SemVer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ParsingError SemVer
semver (Text -> Maybe SemVer) -> Maybe Text -> Maybe SemVer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text
mConstraintValue
    let Maybe SemVer
mProvidedSemVer :: Maybe SemVer = Either ParsingError SemVer -> Maybe SemVer
forall {a} {a}. Either a a -> Maybe a
eitherToMaybe (Either ParsingError SemVer -> Maybe SemVer)
-> (Text -> Either ParsingError SemVer) -> Text -> Maybe SemVer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ParsingError SemVer
semver (Text -> Maybe SemVer) -> Maybe Text -> Maybe SemVer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text
mCurrentValue

    case (Maybe SemVer
mProvidedSemVer, Maybe SemVer
mConstraintSemVer) of
        (Just SemVer
providedSemVer, Just SemVer
constraintSemVer) -> SemVer -> SemVer -> Bool
predicate SemVer
providedSemVer SemVer
constraintSemVer
        (Maybe SemVer, Maybe SemVer)
_ -> Bool
False