unleash-client-haskell-core-0.8.9: src/Unleash/Internal/Predicates.hs

{- |
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 predicate mCurrentValue mConstraintValue = do
    let parseDate :: Text -> Maybe UTCTime
        parseDate text =
            (iso8601ParseM @Maybe @UTCTime $ Text.unpack text)
                <|> zonedTimeToUTC <$> (iso8601ParseM @Maybe @ZonedTime $ Text.unpack text)

    let mConstraintDate :: Maybe UTCTime = parseDate =<< mConstraintValue
    let mProvidedDate :: Maybe UTCTime = parseDate =<< mCurrentValue

    case (mProvidedDate, mConstraintDate) of
        (Just providedDate, Just constraintDate) -> predicate providedDate constraintDate
        _ -> 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 predicate mCurrentValue mConstraintValue = do
    let maybeCurrentValue :: Maybe Double = readMaybe . Text.unpack =<< mCurrentValue
    let maybeConstraintValue :: Maybe Double = readMaybe . Text.unpack =<< mConstraintValue

    case (maybeConstraintValue, maybeCurrentValue) of
        (Just constraintValue, Just currentValue) -> predicate currentValue constraintValue
        _ -> 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 predicate mCurrentValue mConstraintValue = do
    let eitherToMaybe e =
            case e of
                Right a -> Just a
                _ -> Nothing

    let mConstraintSemVer :: Maybe SemVer = eitherToMaybe . semver =<< mConstraintValue
    let mProvidedSemVer :: Maybe SemVer = eitherToMaybe . semver =<< mCurrentValue

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