{-# LANGUAGE OverloadedLists #-}

-- |

-- Module      : JsonLogic.IO.Operation.Misc

-- Description : JsonLogic misc IO operations

-- Copyright   : (c) Marien Matser, Gerard van Schie, Jelle Teeuwissen, 2022

-- License     : MIT

-- Maintainer  : jelleteeuwissen@hotmail.nl

-- Stability   : experimental

module JsonLogic.IO.Operation.Misc (miscOperations, trace, log) where

import Control.Monad.Except
import JsonLogic.IO.Mapping
import JsonLogic.IO.Type
import JsonLogic.Json
import qualified JsonLogic.Operation as O
import Prelude hiding (log)

-- | Groups of operations on similar data.

miscOperations :: Operations
miscOperations :: Operations
miscOperations = [Operation
Item Operations
trace, Operation
Item Operations
log]

-- | Misc operations.

trace, log :: Operation
trace :: Operation
trace = Operation IO -> Operation
toOperation Operation IO
forall (m :: * -> *). Monad m => Operation m
O.trace
log :: Operation
log = ([Char]
"log", Function Json
evaluateLog)

evaluateLog :: Function Json
evaluateLog :: Function Json
evaluateLog SubEvaluator
evaluator Json
args Json
vars = ExceptT Exception IO Json -> IO (Either Exception Json)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Exception IO Json -> IO (Either Exception Json))
-> ExceptT Exception IO Json -> IO (Either Exception Json)
forall a b. (a -> b) -> a -> b
$ do
  Json
res <- IO (Either Exception Json) -> ExceptT Exception IO Json
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either Exception Json) -> ExceptT Exception IO Json)
-> IO (Either Exception Json) -> ExceptT Exception IO Json
forall a b. (a -> b) -> a -> b
$ SubEvaluator
evaluator Json
args Json
vars
  let val :: Json
val = case Json
res of
        JsonArray (Json
item : [Json]
_) -> Json
item
        Json
oth -> Json
oth
  IO () -> ExceptT Exception IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT Exception IO ())
-> IO () -> ExceptT Exception IO ()
forall a b. (a -> b) -> a -> b
$ Json -> IO ()
forall a. Show a => a -> IO ()
print Json
val
  Json -> ExceptT Exception IO Json
forall (m :: * -> *) a. Monad m => a -> m a
return Json
val