{-|
Module      : 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 ShowS, and is used for results of partial operations
which return either Right something when defined or Left report when there is a problem
(where report 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.
-}

{-# LANGUAGE FlexibleInstances #-} -- needed for instance Show (ShowS)
{-# OPTIONS_GHC -Wno-orphans #-}   -- needed for instance Show (ShowS)

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

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


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

-- | onFail s exp - prepends s at the front of a failure report if exp fails with Left report
-- but does nothing otherwise.
onFail:: String -> Try a -> Try a
onFail :: forall a. String -> Try a -> Try a
onFail String
s = (ShowS -> Try a) -> (a -> Try a) -> Try a -> Try a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ShowS -> Try a
forall a b. a -> Either a b
Left (ShowS -> Try a) -> (ShowS -> ShowS) -> ShowS -> Try a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShowS
forall a. a -> String -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
s <>)) a -> Try a
forall a b. b -> Either a b
Right --either (Left . (pure s .)) Right

-- |failReport s - creates a failure (Left), prepending s for the failure report
failReport :: String -> Try a
failReport :: forall a. String -> Try a
failReport  = ShowS -> Either ShowS a
forall a b. a -> Either a b
Left (ShowS -> Either ShowS a)
-> (String -> ShowS) -> String -> Either ShowS a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall a. Semigroup a => a -> a -> a
(<>)

-- |failReports ss - creates a failure (Left), concatenating ss for the failure report
failReports :: [String] -> Try a
failReports :: forall a. [String] -> Try a
failReports = ShowS -> Either ShowS a
forall a b. a -> Either a b
Left (ShowS -> Either ShowS a)
-> ([String] -> ShowS) -> [String] -> Either ShowS a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ShowS] -> ShowS
forall a. Monoid a => [a] -> a
mconcat ([ShowS] -> ShowS) -> ([String] -> [ShowS]) -> [String] -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShowS) -> [String] -> [ShowS]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> ShowS
forall a. Semigroup a => a -> a -> a
(<>) --failReport . mconcat
     -- Note: failReport . mconcat  concatenates strings
     -- but Left . mconcat . fmap (<>)  composes functions   

-- | nothingFail a s - Converts a Maybe Result (a) into a Try result by treating Nothing as a failure
-- (the String s is used for 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. String -> Try a
failReport String
s) b -> Try b
forall a b. b -> Either a b
Right Maybe b
a

-- |Extract the (Right) result from a Try, raising an error if the Try is Left r.
-- The failure report (from Left r) is converted to a Stirng and passed to error.
runTry:: Try a -> a
runTry :: forall a. Try a -> a
runTry = (ShowS -> a) -> (a -> a) -> Either ShowS a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> (ShowS -> String) -> ShowS -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"")) a -> a
forall a. a -> a
id

-- |ifFail a tr - extracts the (Right) result from tr but returning a if tr is Left _ .
ifFail :: a -> Try a -> a
ifFail :: forall a. a -> Try a -> a
ifFail = a -> Either ShowS 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 ShowS 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 [] (so is NOT a fail)
concatFails:: [Try a] -> Try [a]
concatFails :: forall a. [Try a] -> Try [a]
concatFails [Try a]
ls = case [Try a] -> [ShowS]
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
                 [ShowS]
other -> ShowS -> Try [a]
forall a b. a -> Either a b
Left (ShowS -> Try [a]) -> ShowS -> Try [a]
forall a b. (a -> b) -> a -> b
$ [ShowS] -> ShowS
forall a. Monoid a => [a] -> a
mconcat [ShowS]
other -- concatenates reports 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 ShowS a] -> [a]
forall a b. [Either a b] -> [b]
rights

-- | tryAtLeastOne rs - returns Right with the list of successful results if there are any,
-- but Left with a fail report otherwise.
-- The error report will include the concatenated reports from multiple failures. 
tryAtLeastOne:: [Try a] -> Try [a]
tryAtLeastOne :: forall a. [Try a] -> Try [a]
tryAtLeastOne [] = String -> Try [a]
forall a. String -> Try a
failReport String
"atLeastOne: applied to empty list.\n"
tryAtLeastOne [Try a]
results = case [Try a] -> [a]
forall a. [Try a] -> [a]
ignoreFails [Try a]
results of
                 [] -> 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] -> Try [a]
forall a b. b -> Either a b
Right [a]
other

-- | 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 multiple failures. 
atLeastOne:: [Try a] -> [a]
atLeastOne :: forall a. [Try a] -> [a]
atLeastOne = 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]
tryAtLeastOne

-- |Cheating - a ShowS function is "shown" by applying it to a String
instance Show ShowS where
    show :: ShowS -> String
show ShowS
r = ShowS
forall a. Show a => a -> String
show String
"<function> = (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
r String
"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
" ++)"