module Data.JSONPath.ExecutionResult where data ExecutionResult a = ResultList [a] | ResultValue a | ResultError String instance Functor ExecutionResult where fmap :: (a -> b) -> ExecutionResult a -> ExecutionResult b fmap a -> b f (ResultList [a] xs) = [b] -> ExecutionResult b forall a. [a] -> ExecutionResult a ResultList ([b] -> ExecutionResult b) -> [b] -> ExecutionResult b forall a b. (a -> b) -> a -> b $ (a -> b) -> [a] -> [b] forall a b. (a -> b) -> [a] -> [b] Prelude.map a -> b f [a] xs fmap a -> b f (ResultValue a x) = b -> ExecutionResult b forall a. a -> ExecutionResult a ResultValue (b -> ExecutionResult b) -> b -> ExecutionResult b forall a b. (a -> b) -> a -> b $ a -> b f a x fmap a -> b f (ResultError String err) = String -> ExecutionResult b forall a. String -> ExecutionResult a ResultError String err instance Applicative ExecutionResult where pure :: a -> ExecutionResult a pure = a -> ExecutionResult a forall a. a -> ExecutionResult a ResultValue <*> :: ExecutionResult (a -> b) -> ExecutionResult a -> ExecutionResult b (<*>) (ResultList [a -> b] fs) (ResultList [a] xs) = [b] -> ExecutionResult b forall a. [a] -> ExecutionResult a ResultList ([b] -> ExecutionResult b) -> [b] -> ExecutionResult b forall a b. (a -> b) -> a -> b $ [a -> b] fs [a -> b] -> [a] -> [b] forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> [a] xs (<*>) (ResultList [a -> b] fs) (ResultValue a x) = [b] -> ExecutionResult b forall a. [a] -> ExecutionResult a ResultList ([b] -> ExecutionResult b) -> [b] -> ExecutionResult b forall a b. (a -> b) -> a -> b $ ((a -> b) -> b) -> [a -> b] -> [b] forall a b. (a -> b) -> [a] -> [b] Prelude.map (\a -> b f -> a -> b f a x) [a -> b] fs (<*>) (ResultValue a -> b f) (ResultList [a] xs) = [b] -> ExecutionResult b forall a. [a] -> ExecutionResult a ResultList ([b] -> ExecutionResult b) -> [b] -> ExecutionResult b forall a b. (a -> b) -> a -> b $ (a -> b) -> [a] -> [b] forall a b. (a -> b) -> [a] -> [b] Prelude.map a -> b f [a] xs (<*>) (ResultValue a -> b f) (ResultValue a x) = b -> ExecutionResult b forall a. a -> ExecutionResult a ResultValue (b -> ExecutionResult b) -> b -> ExecutionResult b forall a b. (a -> b) -> a -> b $ a -> b f a x (<*>) (ResultError String e) ExecutionResult a _ = String -> ExecutionResult b forall a. String -> ExecutionResult a ResultError String e (<*>) ExecutionResult (a -> b) _ (ResultError String e) = String -> ExecutionResult b forall a. String -> ExecutionResult a ResultError String e instance Monad ExecutionResult where >>= :: ExecutionResult a -> (a -> ExecutionResult b) -> ExecutionResult b (>>=) (ResultValue a x) a -> ExecutionResult b f = a -> ExecutionResult b f a x (>>=) (ResultList [a] xs) a -> ExecutionResult b f = [ExecutionResult b] -> ExecutionResult b forall a. [ExecutionResult a] -> ExecutionResult a concatResults ([ExecutionResult b] -> ExecutionResult b) -> [ExecutionResult b] -> ExecutionResult b forall a b. (a -> b) -> a -> b $ (a -> ExecutionResult b) -> [a] -> [ExecutionResult b] forall a b. (a -> b) -> [a] -> [b] Prelude.map a -> ExecutionResult b f [a] xs (>>=) (ResultError String e) a -> ExecutionResult b f = String -> ExecutionResult b forall a. String -> ExecutionResult a ResultError String e concatResults :: [ExecutionResult a] -> ExecutionResult a concatResults :: [ExecutionResult a] -> ExecutionResult a concatResults [] = [a] -> ExecutionResult a forall a. [a] -> ExecutionResult a ResultList [] concatResults (ResultList [a] xs:[ExecutionResult a] rs) = case [ExecutionResult a] -> ExecutionResult a forall a. [ExecutionResult a] -> ExecutionResult a concatResults [ExecutionResult a] rs of ResultList [a] ys -> [a] -> ExecutionResult a forall a. [a] -> ExecutionResult a ResultList ([a] xs [a] -> [a] -> [a] forall a. [a] -> [a] -> [a] ++ [a] ys) ResultValue a y -> [a] -> ExecutionResult a forall a. [a] -> ExecutionResult a ResultList (a ya -> [a] -> [a] forall a. a -> [a] -> [a] :[a] xs) ExecutionResult a e -> ExecutionResult a e concatResults (ResultValue a x:[]) = a -> ExecutionResult a forall a. a -> ExecutionResult a ResultValue a x concatResults (ResultValue a x:[ExecutionResult a] rs) = case [ExecutionResult a] -> ExecutionResult a forall a. [ExecutionResult a] -> ExecutionResult a concatResults [ExecutionResult a] rs of ResultList [a] ys -> [a] -> ExecutionResult a forall a. [a] -> ExecutionResult a ResultList (a xa -> [a] -> [a] forall a. a -> [a] -> [a] :[a] ys) ResultValue a y -> [a] -> ExecutionResult a forall a. [a] -> ExecutionResult a ResultList [a x,a y] ExecutionResult a e -> ExecutionResult a e concatResults (ExecutionResult a e:[ExecutionResult a] _) = ExecutionResult a e appendResults :: ExecutionResult a -> ExecutionResult a -> ExecutionResult a appendResults :: ExecutionResult a -> ExecutionResult a -> ExecutionResult a appendResults (ResultValue a x) (ResultValue a y) = [a] -> ExecutionResult a forall a. [a] -> ExecutionResult a ResultList [a x,a y] appendResults (ResultValue a x) (ResultList [a] ys) = [a] -> ExecutionResult a forall a. [a] -> ExecutionResult a ResultList ([a] -> ExecutionResult a) -> [a] -> ExecutionResult a forall a b. (a -> b) -> a -> b $ a xa -> [a] -> [a] forall a. a -> [a] -> [a] :[a] ys appendResults (ResultList [a] xs) (ResultValue a y) = [a] -> ExecutionResult a forall a. [a] -> ExecutionResult a ResultList ([a] -> ExecutionResult a) -> [a] -> ExecutionResult a forall a b. (a -> b) -> a -> b $ a ya -> [a] -> [a] forall a. a -> [a] -> [a] :[a] xs appendResults (ResultList [a] xs) (ResultList [a] ys) = [a] -> ExecutionResult a forall a. [a] -> ExecutionResult a ResultList ([a] -> ExecutionResult a) -> [a] -> ExecutionResult a forall a b. (a -> b) -> a -> b $ [a] xs [a] -> [a] -> [a] forall a. [a] -> [a] -> [a] ++ [a] ys appendResults ExecutionResult a _ ExecutionResult a e = ExecutionResult a e maybeToResult :: String -> Maybe a ->ExecutionResult a maybeToResult :: String -> Maybe a -> ExecutionResult a maybeToResult String _ (Just a x) = a -> ExecutionResult a forall a. a -> ExecutionResult a ResultValue a x maybeToResult String err Maybe a _ = String -> ExecutionResult a forall a. String -> ExecutionResult a ResultError String err resultToEither :: ExecutionResult a -> Either String [a] resultToEither :: ExecutionResult a -> Either String [a] resultToEither (ResultList [a] xs) = [a] -> Either String [a] forall (m :: * -> *) a. Monad m => a -> m a return [a] xs resultToEither (ResultValue a x) = [a] -> Either String [a] forall (m :: * -> *) a. Monad m => a -> m a return [a x] resultToEither (ResultError String e) = String -> Either String [a] forall a b. a -> Either a b Left String e excludeErrors :: [ExecutionResult a] -> [a] excludeErrors :: [ExecutionResult a] -> [a] excludeErrors [] = [] excludeErrors (ResultError String _:[ExecutionResult a] rs) = [ExecutionResult a] -> [a] forall a. [ExecutionResult a] -> [a] excludeErrors [ExecutionResult a] rs excludeErrors (ResultList [a] xs:[ExecutionResult a] rs) = [a] xs [a] -> [a] -> [a] forall a. [a] -> [a] -> [a] ++ [ExecutionResult a] -> [a] forall a. [ExecutionResult a] -> [a] excludeErrors [ExecutionResult a] rs excludeErrors (ResultValue a x:[ExecutionResult a] rs) = a xa -> [a] -> [a] forall a. a -> [a] -> [a] :([ExecutionResult a] -> [a] forall a. [ExecutionResult a] -> [a] excludeErrors [ExecutionResult a] rs)