module Funcons.Exceptions where
import Funcons.Types
import Funcons.Printer
import Data.List (intercalate)
import Data.Text (unpack)
type IException = (Funcons, Funcons, IE)
data IE = SortErr String
| Err String
| PartialOp String
| Internal String
| NoRule [IException]
| NoMoreBranches [IException]
| SideCondFail String
| InsufficientInput Name
| InsufficientInputConsumed Name
| PatternMismatch String
| StepOnValue [Values]
showIException :: IException -> String
showIException :: IException -> String
showIException (Funcons
f0,Funcons
f,ie :: IE
ie@(NoRule [IException]
_)) = IE -> String
forall a. Show a => a -> String
show IE
ie
showIException (Funcons
f0,Funcons
f,ie :: IE
ie@(NoMoreBranches [IException]
_)) = IE -> String
forall a. Show a => a -> String
show IE
ie
showIException (Funcons
f0,Funcons
f,IE
ie) = String
"Internal Exception: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ IE -> String
forall a. Show a => a -> String
show IE
ie String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" on \n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Funcons -> String
showFuncons Funcons
f
instance Show IE where
show :: IE -> String
show (SortErr String
err) = String
"dynamic sort check (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
show (NoRule []) = String
"no more rules to try"
show (NoRule [IException]
errs) = [String] -> Funcons -> String
mkRulesErr ((Integer -> IException -> String)
-> [Integer] -> [IException] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Integer -> IException -> String
forall a p a b. Show a => p -> (a, b, a) -> String
mkRuleErr [Integer
1..] [IException]
errs) Funcons
f
where (Funcons
_,Funcons
f,IE
_) = [IException] -> IException
forall a. [a] -> a
head [IException]
errs
show (Err String
err) = String
"exception (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
show (Internal String
err) = String
"exception (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
show (SideCondFail String
str) = String
str
show (PatternMismatch String
str) = String
str
show (InsufficientInput Name
nm) = String
"insufficient supply for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
unpack Name
nm
show (InsufficientInputConsumed Name
nm) = String
"insufficient input consumed for entity " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
unpack Name
nm
show (PartialOp String
str) = String
"partial operation"
show (NoMoreBranches []) = String
"no more branches to try"
show (NoMoreBranches [IException]
errs) = [String] -> Funcons -> String
mkRulesErr ((Integer -> IException -> String)
-> [Integer] -> [IException] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Integer -> IException -> String
forall a p a b. Show a => p -> (a, b, a) -> String
mkRuleErr [Integer
1..] [IException]
errs) Funcons
f
where (Funcons
_,Funcons
f,IE
_) = [IException] -> IException
forall a. [a] -> a
head [IException]
errs
show (StepOnValue [Values]
v) = String
"attempting to step a value: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Values] -> String
showValuesSeq [Values]
v
mkRuleErr :: p -> (a, b, a) -> String
mkRuleErr p
i (a
_,b
_,a
ie) = a -> String
forall a. Show a => a -> String
show a
ie
mkRulesErr :: [String] -> Funcons -> String
mkRulesErr [String]
strs Funcons
f = String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Funcons -> String
showFuncons Funcons
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String]
strs)
failsRule :: IException -> Bool
failsRule :: IException -> Bool
failsRule (Funcons
_,Funcons
_,SideCondFail String
_) = Bool
True
failsRule (Funcons
_,Funcons
_,PatternMismatch String
_) = Bool
True
failsRule (Funcons
_,Funcons
_,SortErr String
_) = Bool
True
failsRule (Funcons
_,Funcons
_,PartialOp String
_) = Bool
True
failsRule (Funcons
_,Funcons
_,StepOnValue [Values]
_) = Bool
True
failsRule (Funcons
_,Funcons
_,NoMoreBranches [IException]
_) = Bool
True
failsRule (Funcons
_,Funcons
_,NoRule [IException]
_) = Bool
True
failsRule IException
_ = Bool
False