{-|
Module      : Tgraph.Try
Description : Result types for partial functions
Copyright   : (c) Chris Reade, 2021
License     : BSD-style
Maintainer  : chrisreade@mac.com
Stability   : experimental

Try is a synonym for Either String, which is used for results of partial operations
which return either Right something when defined or Left string when there is a problem
(where string is a failure report).
This is to allow computation to continue in failure cases without necessarily raising an error.
This module contains functions associated with Try results.
-}

module Tgraph.Try
  ( -- * Try - result types with failure reporting (for partial operations).
  Try
  , onFail
  , nothingFail
  , runTry
  , ifFail
  , isFail
  , concatFails
  , ignoreFails
  , atLeastOne
  , noFails
  ) where

import Data.Either(fromRight, lefts, rights, isLeft)


-- | Try is a synonym for Either String.  Used for results of partial functions
-- which return either Right something when defined or Left string when there is a problem
-- where string is a failure report.
-- Note: Either String (and hence Try) is a monad, and this is used frequently for combining  partial operations.
type Try a = Either String a

-- | onFail s exp - inserts s at the front of failure report if exp fails with Left report
onFail:: String -> Try a -> Try a
onFail :: forall a. String -> Try a -> Try a
onFail String
s = (String -> Try a) -> (a -> Try a) -> Try a -> Try a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Try a
forall a b. a -> Either a b
Left (String -> Try a) -> (String -> String) -> String -> Try a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
sString -> String -> String
forall a. [a] -> [a] -> [a]
++)) a -> Try a
forall a b. b -> Either a b
Right

-- | Converts a Maybe Result into a Try result by treating Nothing as a failure
-- (the string s is the failure report on failure).
-- Usually used as infix (exp `nothingFail` s)
nothingFail :: Maybe b -> String -> Try b
nothingFail :: forall b. Maybe b -> String -> Try b
nothingFail Maybe b
a String
s = Try b -> (b -> Try b) -> Maybe b -> Try b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Try b
forall a b. a -> Either a b
Left String
s) b -> Try b
forall a b. b -> Either a b
Right Maybe b
a

-- |Extract the (Right) result from a Try, producing an error if the Try is Left s.
-- The failure report is passed to error for an error report.
runTry:: Try a -> a
runTry :: forall a. Try a -> a
runTry = (String -> a) -> (a -> a) -> Either String a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> a
forall a. HasCallStack => String -> a
error a -> a
forall a. a -> a
id

-- |ifFail a tr - extracts the (Right) result from tr but returning a if tr is Left s.
ifFail :: a -> Try a -> a
ifFail :: forall a. a -> Try a -> a
ifFail = a -> Either String a -> a
forall b a. b -> Either a b -> b
fromRight 

-- |a try result is a failure if it is a Left
isFail:: Try a -> Bool
isFail :: forall a. Try a -> Bool
isFail = Either String a -> Bool
forall a b. Either a b -> Bool
isLeft
   
-- |Combines a list of Trys into a single Try with failure overriding success.
-- It concatenates all failure reports if there are any and returns a single Left r.
-- Otherwise it produces Right rs where rs is the list of all (successful) results.
-- In particular, concatFails [] = Right []
concatFails:: [Try a] -> Try [a]
concatFails :: forall a. [Try a] -> Try [a]
concatFails [Try a]
ls = case [Try a] -> [String]
forall a b. [Either a b] -> [a]
lefts [Try a]
ls of
                 [] -> [a] -> Try [a]
forall a b. b -> Either a b
Right ([a] -> Try [a]) -> [a] -> Try [a]
forall a b. (a -> b) -> a -> b
$ [Try a] -> [a]
forall a b. [Either a b] -> [b]
rights [Try a]
ls
                 [String]
other -> String -> Try [a]
forall a b. a -> Either a b
Left (String -> Try [a]) -> String -> Try [a]
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String]
other -- concatenates strings for single report

-- |Combines a list of Trys into a list of the successes, ignoring any failures.
-- In particular, ignoreFails [] = []
ignoreFails:: [Try a] -> [a]
ignoreFails :: forall a. [Try a] -> [a]
ignoreFails = [Either String a] -> [a]
forall a b. [Either a b] -> [b]
rights

-- | atLeastOne rs - returns the list of successful results if there are any, but fails with an error otherwise.
-- The error report will include the concatenated reports from the failures. 
atLeastOne:: [Try a] -> [a]
atLeastOne :: forall a. [Try a] -> [a]
atLeastOne [] = String -> [a]
forall a. HasCallStack => String -> a
error String
"atLeastOne: applied to empty list.\n"
atLeastOne [Try a]
results = case [Try a] -> [a]
forall a. [Try a] -> [a]
ignoreFails [Try a]
results of
                 [] -> Try [a] -> [a]
forall a. Try a -> a
runTry (Try [a] -> [a]) -> Try [a] -> [a]
forall a b. (a -> b) -> a -> b
$ String -> Try [a] -> Try [a]
forall a. String -> Try a -> Try a
onFail String
"atLeastOne: no successful results.\n" (Try [a] -> Try [a]) -> Try [a] -> Try [a]
forall a b. (a -> b) -> a -> b
$ [Try a] -> Try [a]
forall a. [Try a] -> Try [a]
concatFails [Try a]
results
                 [a]
other -> [a]
other 

-- | noFails rs - returns the list of successes when all cases succeed, but fails with
-- an error and a concatenated failure report of all failures if there is at least one failure.
-- In particular, noFails [] = []
noFails:: [Try a] -> [a]
noFails :: forall a. [Try a] -> [a]
noFails = Try [a] -> [a]
forall a. Try a -> a
runTry (Try [a] -> [a]) -> ([Try a] -> Try [a]) -> [Try a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Try a] -> Try [a]
forall a. [Try a] -> Try [a]
concatFails