    {-# LANGUAGE RankNTypes, ViewPatterns #-}
    -- | @since 1.0
    module Test.Tasty.Patterns.Eval (Path, eval, withFields, asB) where

    import Prelude hiding (Ordering(..))
    import Control.Monad ((<=<))
    import Control.Monad.Trans.Class (lift)
    import Control.Monad.Trans.Reader (ReaderT, runReaderT, ask)
    import qualified Data.Sequence as Seq
    import Data.Foldable
    import Data.List (findIndex, intercalate, isInfixOf, isPrefixOf, tails)
    import Data.Maybe
    import Data.Char
    import Test.Tasty.Patterns.Types
    #if !MIN_VERSION_base(4,9,0)
    import Control.Applicative
    import Data.Traversable
    #endif

    -- | @since 1.2
    type Path = Seq.Seq String

    data Value
      = VN !Int
      | VS !Bool String
        -- ^ The 'Bool' is 'True' if the source of the string
        -- allows it to be numeric
      | Uninitialized
      deriving Int -> Value -> ShowS
    [Value] -> ShowS
    Value -> String
    (Int -> Value -> ShowS)
    -> (Value -> String) -> ([Value] -> ShowS) -> Show Value
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Value -> ShowS
    showsPrec :: Int -> Value -> ShowS
    $cshow :: Value -> String
    show :: Value -> String
    $cshowList :: [Value] -> ShowS
    showList :: [Value] -> ShowS
    Show

    type M = ReaderT Path (Either String)

    throwError :: String -> M a
    throwError :: forall a. String -> M a
    throwError String
    s = Either String a -> ReaderT Path (Either String) a
    forall (m :: * -> *) a. Monad m => m a -> ReaderT Path m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (Either String a -> ReaderT Path (Either String) a)
    -> Either String a -> ReaderT Path (Either String) a
    forall a b. (a -> b) -> a -> b
    $ String -> Either String a
    forall a b. a -> Either a b
    Left String
    s

    asS :: Value -> M String
    asS :: Value -> M String
    asS Value
    v = String -> M String
    forall a. a -> ReaderT Path (Either String) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> M String) -> String -> M String
    forall a b. (a -> b) -> a -> b
    $
      case Value
    v of
        VN Int
    n -> Int -> String
    forall a. Show a => a -> String
    show Int
    n
        VS Bool
    _ String
    s -> String
    s
        Value
    Uninitialized -> String
    ""

    -- readMaybe was not in base-4.3 yet
    parseN :: String -> Maybe Int
    parseN :: String -> Maybe Int
    parseN String
    s =
      case String -> [(Int, String)]
    forall a. Read a => String -> a
    read String
    s of
        [(Int
    n, String
    "")] -> Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    n
        [(Int, String)]
    _ -> Maybe Int
    forall a. Maybe a
    Nothing

    asN :: Value -> M Int
    asN :: Value -> M Int
    asN Value
    v =
      case Value
    v of
        VN Int
    n -> Int -> M Int
    forall a. a -> ReaderT Path (Either String) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    n
        VS Bool
    True String
    s ->
          case String -> Maybe Int
    parseN String
    s of
            Just Int
    n -> Int -> M Int
    forall a. a -> ReaderT Path (Either String) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    n
            Maybe Int
    Nothing -> String -> M Int
    forall a. String -> M a
    throwError (String -> M Int) -> String -> M Int
    forall a b. (a -> b) -> a -> b
    $ String
    "Not a number: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    forall a. Show a => a -> String
    show String
    s
        VS Bool
    False String
    s -> String -> M Int
    forall a. String -> M a
    throwError (String -> M Int) -> String -> M Int
    forall a b. (a -> b) -> a -> b
    $ String
    "String is not numeric: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    forall a. Show a => a -> String
    show String
    s
        Value
    Uninitialized -> Int -> M Int
    forall a. a -> ReaderT Path (Either String) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    0

    isN :: Value -> Bool
    isN :: Value -> Bool
    isN Value
    v =
      case Value
    v of
        VN Int
    _ -> Bool
    True
        Value
    _ -> Bool
    False

    isNumeric :: Value -> Bool
    isNumeric :: Value -> Bool
    isNumeric Value
    v =
      case Value
    v of
        VS Bool
    b String
    s -> Bool
    b Bool -> Bool -> Bool
    && Maybe Int -> Bool
    forall a. Maybe a -> Bool
    isJust (String -> Maybe Int
    parseN String
    s)
        Value
    _ -> Bool
    True

    -- | @since 1.0
    asB :: Value -> M Bool
    asB :: Value -> M Bool
    asB Value
    v = Bool -> M Bool
    forall a. a -> ReaderT Path (Either String) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> M Bool) -> Bool -> M Bool
    forall a b. (a -> b) -> a -> b
    $
      case Value
    v of
        VN Int
    0 -> Bool
    False
        VS Bool
    _ String
    "" -> Bool
    False
        Value
    _ -> Bool
    True

    fromB :: Bool -> Value
    fromB :: Bool -> Value
    fromB = Int -> Value
    VN (Int -> Value) -> (Bool -> Int) -> Bool -> Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> Int
    forall a. Enum a => a -> Int
    fromEnum

    -- | Evaluate an awk expression.
    --
    -- @since 1.0
    eval :: Expr -> M Value
    eval :: Expr -> M Value
    eval Expr
    e0 =
      case Expr
    e0 of
        IntLit Int
    n -> Value -> M Value
    forall a. a -> ReaderT Path (Either String) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Value -> M Value) -> Value -> M Value
    forall a b. (a -> b) -> a -> b
    $ Int -> Value
    VN Int
    n
        StringLit String
    s -> Value -> M Value
    forall a. a -> ReaderT Path (Either String) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Value -> M Value) -> Value -> M Value
    forall a b. (a -> b) -> a -> b
    $ Bool -> String -> Value
    VS Bool
    False String
    s
        Expr
    NF -> Int -> Value
    VN (Int -> Value) -> (Path -> Int) -> Path -> Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Int -> Int
    forall a. Num a => a -> a -> a
    subtract Int
    1 (Int -> Int) -> (Path -> Int) -> Path -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Path -> Int
    forall a. Seq a -> Int
    Seq.length (Path -> Value) -> ReaderT Path (Either String) Path -> M Value
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ReaderT Path (Either String) Path
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
        Add Expr
    e1 Expr
    e2 -> (Int -> Int -> Int) -> Expr -> Expr -> M Value
    binNumOp Int -> Int -> Int
    forall a. Num a => a -> a -> a
    (+) Expr
    e1 Expr
    e2
        Sub Expr
    e1 Expr
    e2 -> (Int -> Int -> Int) -> Expr -> Expr -> M Value
    binNumOp (-) Expr
    e1 Expr
    e2
        Neg Expr
    e1 -> Int -> Value
    VN (Int -> Value) -> (Int -> Int) -> Int -> Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Int
    forall a. Num a => a -> a
    negate (Int -> Value) -> M Int -> M Value
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Value -> M Int
    asN (Value -> M Int) -> M Value -> M Int
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Expr -> M Value
    eval Expr
    e1)
        Not Expr
    e1 -> Bool -> Value
    fromB (Bool -> Value) -> (Bool -> Bool) -> Bool -> Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> Bool
    not (Bool -> Value) -> M Bool -> M Value
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Value -> M Bool
    asB (Value -> M Bool) -> M Value -> M Bool
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Expr -> M Value
    eval Expr
    e1)
        And Expr
    e1 Expr
    e2 -> (Bool -> Bool -> Bool) -> Expr -> Expr -> M Value
    binLglOp Bool -> Bool -> Bool
    (&&) Expr
    e1 Expr
    e2
        Or Expr
    e1 Expr
    e2  -> (Bool -> Bool -> Bool) -> Expr -> Expr -> M Value
    binLglOp Bool -> Bool -> Bool
    (||) Expr
    e1 Expr
    e2
        LT Expr
    e1 Expr
    e2 -> (forall a. Ord a => a -> a -> Bool) -> Expr -> Expr -> M Value
    binCmpOp a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    (<)  Expr
    e1 Expr
    e2
        LE Expr
    e1 Expr
    e2 -> (forall a. Ord a => a -> a -> Bool) -> Expr -> Expr -> M Value
    binCmpOp a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    (<=) Expr
    e1 Expr
    e2
        GT Expr
    e1 Expr
    e2 -> (forall a. Ord a => a -> a -> Bool) -> Expr -> Expr -> M Value
    binCmpOp a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    (>)  Expr
    e1 Expr
    e2
        GE Expr
    e1 Expr
    e2 -> (forall a. Ord a => a -> a -> Bool) -> Expr -> Expr -> M Value
    binCmpOp a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    (>=) Expr
    e1 Expr
    e2
        EQ Expr
    e1 Expr
    e2 -> (forall a. Ord a => a -> a -> Bool) -> Expr -> Expr -> M Value
    binCmpOp a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    (==) Expr
    e1 Expr
    e2
        NE Expr
    e1 Expr
    e2 -> (forall a. Ord a => a -> a -> Bool) -> Expr -> Expr -> M Value
    binCmpOp a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    (/=) Expr
    e1 Expr
    e2
        Concat Expr
    e1 Expr
    e2 -> Bool -> String -> Value
    VS Bool
    False (String -> Value) -> M String -> M Value
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (String -> ShowS
    forall a. [a] -> [a] -> [a]
    (++) (String -> ShowS) -> M String -> ReaderT Path (Either String) ShowS
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Value -> M String
    asS (Value -> M String) -> M Value -> M String
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Expr -> M Value
    eval Expr
    e1) ReaderT Path (Either String) ShowS -> M String -> M String
    forall a b.
    ReaderT Path (Either String) (a -> b)
    -> ReaderT Path (Either String) a -> ReaderT Path (Either String) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (Value -> M String
    asS (Value -> M String) -> M Value -> M String
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Expr -> M Value
    eval Expr
    e2))
        If Expr
    cond Expr
    e1 Expr
    e2 -> do
          condV <- Value -> M Bool
    asB (Value -> M Bool) -> M Value -> M Bool
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Expr -> M Value
    eval Expr
    cond
          if condV then eval e1 else eval e2
        Field Expr
    e1 -> do
          n <- Value -> M Int
    asN (Value -> M Int) -> M Value -> M Int
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Expr -> M Value
    eval Expr
    e1
          fields <- ask
          return $ if n > Seq.length fields - 1
            then Uninitialized
            else VS True $ Seq.index fields n
        ERE String
    pat -> do
          str <- Path -> Int -> String
    forall a. Seq a -> Int -> a
    Seq.index (Path -> Int -> String)
    -> ReaderT Path (Either String) Path
    -> ReaderT Path (Either String) (Int -> String)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ReaderT Path (Either String) Path
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask ReaderT Path (Either String) (Int -> String) -> M Int -> M String
    forall a b.
    ReaderT Path (Either String) (a -> b)
    -> ReaderT Path (Either String) a -> ReaderT Path (Either String) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Int -> M Int
    forall a. a -> ReaderT Path (Either String) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Int
    0
          return . fromB $ match pat str
        Match Expr
    e1 String
    pat -> do
          str <- Value -> M String
    asS (Value -> M String) -> M Value -> M String
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Expr -> M Value
    eval Expr
    e1
          return . fromB $ match pat str
        NoMatch Expr
    e1 String
    pat -> do
          str <- Value -> M String
    asS (Value -> M String) -> M Value -> M String
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Expr -> M Value
    eval Expr
    e1
          return . fromB . not $ match pat str
        ToUpperFn Expr
    e1 ->
          Bool -> String -> Value
    VS Bool
    True (String -> Value) -> ShowS -> String -> Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Char) -> ShowS
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toUpper (String -> Value) -> M String -> M Value
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Value -> M String
    asS (Value -> M String) -> M Value -> M String
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Expr -> M Value
    eval Expr
    e1)
        ToLowerFn Expr
    e1 ->
          Bool -> String -> Value
    VS Bool
    True (String -> Value) -> ShowS -> String -> Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Char) -> ShowS
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower (String -> Value) -> M String -> M Value
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Value -> M String
    asS (Value -> M String) -> M Value -> M String
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Expr -> M Value
    eval Expr
    e1)
        SubstrFn Expr
    e1 Expr
    e2 Maybe Expr
    mb_e3 -> do
          s <- Value -> M String
    asS (Value -> M String) -> M Value -> M String
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Expr -> M Value
    eval Expr
    e1
          m <- asN =<< eval e2
          mb_n <- traverse (asN <=< eval) mb_e3
          return $ VS True $
            maybe id take mb_n . drop (m-1) $ s
        LengthFn (Expr -> Maybe Expr -> Expr
    forall a. a -> Maybe a -> a
    fromMaybe (Expr -> Expr
    Field (Int -> Expr
    IntLit Int
    0)) ->  Expr
    e1) ->
          Int -> Value
    VN (Int -> Value) -> (String -> Int) -> String -> Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (String -> Value) -> M String -> M Value
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Value -> M String
    asS (Value -> M String) -> M Value -> M String
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Expr -> M Value
    eval Expr
    e1)
        MatchFn Expr
    e1 String
    pat -> do
          s <- Value -> M String
    asS (Value -> M String) -> M Value -> M String
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Expr -> M Value
    eval Expr
    e1
          return . VN . maybe 0 (+1) . findIndex (pat `isPrefixOf`) $ tails s

      where
        binNumOp :: (Int -> Int -> Int) -> Expr -> Expr -> M Value
    binNumOp Int -> Int -> Int
    op Expr
    e1 Expr
    e2 = Int -> Value
    VN (Int -> Value) -> M Int -> M Value
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Int -> Int -> Int
    op (Int -> Int -> Int)
    -> M Int -> ReaderT Path (Either String) (Int -> Int)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Value -> M Int
    asN (Value -> M Int) -> M Value -> M Int
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Expr -> M Value
    eval Expr
    e1) ReaderT Path (Either String) (Int -> Int) -> M Int -> M Int
    forall a b.
    ReaderT Path (Either String) (a -> b)
    -> ReaderT Path (Either String) a -> ReaderT Path (Either String) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (Value -> M Int
    asN (Value -> M Int) -> M Value -> M Int
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Expr -> M Value
    eval Expr
    e2))
        binLglOp :: (Bool -> Bool -> Bool) -> Expr -> Expr -> M Value
    binLglOp Bool -> Bool -> Bool
    op Expr
    e1 Expr
    e2 = Bool -> Value
    fromB (Bool -> Value) -> M Bool -> M Value
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Bool -> Bool -> Bool
    op (Bool -> Bool -> Bool)
    -> M Bool -> ReaderT Path (Either String) (Bool -> Bool)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Value -> M Bool
    asB (Value -> M Bool) -> M Value -> M Bool
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Expr -> M Value
    eval Expr
    e1) ReaderT Path (Either String) (Bool -> Bool) -> M Bool -> M Bool
    forall a b.
    ReaderT Path (Either String) (a -> b)
    -> ReaderT Path (Either String) a -> ReaderT Path (Either String) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (Value -> M Bool
    asB (Value -> M Bool) -> M Value -> M Bool
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Expr -> M Value
    eval Expr
    e2))
        binCmpOp :: (forall a . Ord a => a -> a -> Bool) -> Expr -> Expr -> M Value
        binCmpOp :: (forall a. Ord a => a -> a -> Bool) -> Expr -> Expr -> M Value
    binCmpOp forall a. Ord a => a -> a -> Bool
    op Expr
    e1 Expr
    e2 = do
          v1 <- Expr -> M Value
    eval Expr
    e1
          v2 <- eval e2
          let
            compareAsNumbers =
              Value -> Bool
    isN Value
    v1 Bool -> Bool -> Bool
    && Value -> Bool
    isNumeric Value
    v2 Bool -> Bool -> Bool
    ||
              Value -> Bool
    isN Value
    v2 Bool -> Bool -> Bool
    && Value -> Bool
    isNumeric Value
    v1
          if compareAsNumbers
            then fromB <$> (op <$> asN v1 <*> asN v2)
            else fromB <$> (op <$> asS v1 <*> asS v2)

    match
      :: String -- ^ pattern
      -> String -- ^ string
      -> Bool
    match :: String -> String -> Bool
    match String
    pat String
    str = String
    pat String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isInfixOf` String
    str

    -- | Run the @M@ monad with a given list of fields
    --
    -- The field list should not include @$0@; it's calculated automatically.
    --
    -- @since 1.0
    withFields :: Seq.Seq String -> M a -> Either String a
    withFields :: forall a. Path -> M a -> Either String a
    withFields Path
    fields M a
    a = M a -> Path -> Either String a
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT M a
    a (String
    whole String -> Path -> Path
    forall a. a -> Seq a -> Seq a
    Seq.<| Path
    fields)
      where whole :: String
    whole = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "." ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ Path -> [String]
    forall a. Seq a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList Path
    fields