{-# OPTIONS_GHC -Wno-orphans #-}
module Control.CollectErrors.PreludeInstances where

import Prelude

import Text.Printf ( printf )

import Control.CollectErrors.Type
    ( CollectErrors(CollectErrors), CanBeErrors, lift, lift2 )


instance (CanBeErrors es, Eq v) => Eq (CollectErrors es v) where
  == :: CollectErrors es v -> CollectErrors es v -> Bool
(==) = String
-> (v -> v -> Bool)
-> CollectErrors es v
-> CollectErrors es v
-> Bool
forall es t1 t2 t.
CanBeErrors es =>
String
-> (t1 -> t2 -> t)
-> CollectErrors es t1
-> CollectErrors es t2
-> t
liftGotValues2 String
"(==)" v -> v -> Bool
forall a. Eq a => a -> a -> Bool
(==)

instance (CanBeErrors es, Ord v) => Ord (CollectErrors es v) where
  compare :: CollectErrors es v -> CollectErrors es v -> Ordering
compare = String
-> (v -> v -> Ordering)
-> CollectErrors es v
-> CollectErrors es v
-> Ordering
forall es t1 t2 t.
CanBeErrors es =>
String
-> (t1 -> t2 -> t)
-> CollectErrors es t1
-> CollectErrors es t2
-> t
liftGotValues2 String
"compare" v -> v -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
  < :: CollectErrors es v -> CollectErrors es v -> Bool
(<) = String
-> (v -> v -> Bool)
-> CollectErrors es v
-> CollectErrors es v
-> Bool
forall es t1 t2 t.
CanBeErrors es =>
String
-> (t1 -> t2 -> t)
-> CollectErrors es t1
-> CollectErrors es t2
-> t
liftGotValues2 String
"(<)" v -> v -> Bool
forall a. Ord a => a -> a -> Bool
(<)
  <= :: CollectErrors es v -> CollectErrors es v -> Bool
(<=) = String
-> (v -> v -> Bool)
-> CollectErrors es v
-> CollectErrors es v
-> Bool
forall es t1 t2 t.
CanBeErrors es =>
String
-> (t1 -> t2 -> t)
-> CollectErrors es t1
-> CollectErrors es t2
-> t
liftGotValues2 String
"(<=)" v -> v -> Bool
forall a. Ord a => a -> a -> Bool
(<=)
  > :: CollectErrors es v -> CollectErrors es v -> Bool
(>) = String
-> (v -> v -> Bool)
-> CollectErrors es v
-> CollectErrors es v
-> Bool
forall es t1 t2 t.
CanBeErrors es =>
String
-> (t1 -> t2 -> t)
-> CollectErrors es t1
-> CollectErrors es t2
-> t
liftGotValues2 String
"(>)" v -> v -> Bool
forall a. Ord a => a -> a -> Bool
(>)
  >= :: CollectErrors es v -> CollectErrors es v -> Bool
(>=) = String
-> (v -> v -> Bool)
-> CollectErrors es v
-> CollectErrors es v
-> Bool
forall es t1 t2 t.
CanBeErrors es =>
String
-> (t1 -> t2 -> t)
-> CollectErrors es t1
-> CollectErrors es t2
-> t
liftGotValues2 String
"(>=)" v -> v -> Bool
forall a. Ord a => a -> a -> Bool
(>=)
  max :: CollectErrors es v -> CollectErrors es v -> CollectErrors es v
max = (v -> v -> v)
-> CollectErrors es v -> CollectErrors es v -> CollectErrors es v
forall es a b c.
Monoid es =>
(a -> b -> c)
-> CollectErrors es a -> CollectErrors es b -> CollectErrors es c
lift2 v -> v -> v
forall a. Ord a => a -> a -> a
max
  min :: CollectErrors es v -> CollectErrors es v -> CollectErrors es v
min = (v -> v -> v)
-> CollectErrors es v -> CollectErrors es v -> CollectErrors es v
forall es a b c.
Monoid es =>
(a -> b -> c)
-> CollectErrors es a -> CollectErrors es b -> CollectErrors es c
lift2 v -> v -> v
forall a. Ord a => a -> a -> a
min

instance (CanBeErrors es, Bounded v) => Bounded (CollectErrors es v) where
  minBound :: CollectErrors es v
minBound = v -> CollectErrors es v
forall (f :: * -> *) a. Applicative f => a -> f a
pure v
forall a. Bounded a => a
minBound
  maxBound :: CollectErrors es v
maxBound = v -> CollectErrors es v
forall (f :: * -> *) a. Applicative f => a -> f a
pure v
forall a. Bounded a => a
maxBound

instance (CanBeErrors es, Enum v) => Enum (CollectErrors es v) where
  toEnum :: Int -> CollectErrors es v
toEnum = v -> CollectErrors es v
forall (f :: * -> *) a. Applicative f => a -> f a
pure (v -> CollectErrors es v)
-> (Int -> v) -> Int -> CollectErrors es v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> v
forall a. Enum a => Int -> a
toEnum
  fromEnum :: CollectErrors es v -> Int
fromEnum = String -> (v -> Int) -> CollectErrors es v -> Int
forall es t1 t.
CanBeErrors es =>
String -> (t1 -> t) -> CollectErrors es t1 -> t
liftGotValue String
"fromEnum" v -> Int
forall a. Enum a => a -> Int
fromEnum

instance (CanBeErrors es, Num v) => Num (CollectErrors es v) where
  fromInteger :: Integer -> CollectErrors es v
fromInteger = v -> CollectErrors es v
forall (f :: * -> *) a. Applicative f => a -> f a
pure (v -> CollectErrors es v)
-> (Integer -> v) -> Integer -> CollectErrors es v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> v
forall a. Num a => Integer -> a
fromInteger
  + :: CollectErrors es v -> CollectErrors es v -> CollectErrors es v
(+) = (v -> v -> v)
-> CollectErrors es v -> CollectErrors es v -> CollectErrors es v
forall es a b c.
Monoid es =>
(a -> b -> c)
-> CollectErrors es a -> CollectErrors es b -> CollectErrors es c
lift2 v -> v -> v
forall a. Num a => a -> a -> a
(+)
  (-) = (v -> v -> v)
-> CollectErrors es v -> CollectErrors es v -> CollectErrors es v
forall es a b c.
Monoid es =>
(a -> b -> c)
-> CollectErrors es a -> CollectErrors es b -> CollectErrors es c
lift2 (-)
  * :: CollectErrors es v -> CollectErrors es v -> CollectErrors es v
(*) = (v -> v -> v)
-> CollectErrors es v -> CollectErrors es v -> CollectErrors es v
forall es a b c.
Monoid es =>
(a -> b -> c)
-> CollectErrors es a -> CollectErrors es b -> CollectErrors es c
lift2 v -> v -> v
forall a. Num a => a -> a -> a
(*)
  abs :: CollectErrors es v -> CollectErrors es v
abs = (v -> v) -> CollectErrors es v -> CollectErrors es v
forall es a b.
Monoid es =>
(a -> b) -> CollectErrors es a -> CollectErrors es b
lift v -> v
forall a. Num a => a -> a
abs
  negate :: CollectErrors es v -> CollectErrors es v
negate = (v -> v) -> CollectErrors es v -> CollectErrors es v
forall es a b.
Monoid es =>
(a -> b) -> CollectErrors es a -> CollectErrors es b
lift v -> v
forall a. Num a => a -> a
negate
  signum :: CollectErrors es v -> CollectErrors es v
signum = (v -> v) -> CollectErrors es v -> CollectErrors es v
forall es a b.
Monoid es =>
(a -> b) -> CollectErrors es a -> CollectErrors es b
lift v -> v
forall a. Num a => a -> a
signum

instance (CanBeErrors es, Real v) => Real (CollectErrors es v) where
  toRational :: CollectErrors es v -> Rational
toRational = String -> (v -> Rational) -> CollectErrors es v -> Rational
forall es t1 t.
CanBeErrors es =>
String -> (t1 -> t) -> CollectErrors es t1 -> t
liftGotValue String
"toRational" v -> Rational
forall a. Real a => a -> Rational
toRational


{- Utilities -}

errorMissingValue :: (Show t, Monoid t) => String -> t -> t2
errorMissingValue :: String -> t -> t2
errorMissingValue String
label t
es = 
  String -> t2
forall a. HasCallStack => String -> a
error (String -> t2) -> String -> t2
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Missing value in %s: %s" String
label (t -> String
forall a. Show a => a -> String
show t
es)

errorMissingValues :: (Show t, Monoid t) => String -> [t] -> t2
errorMissingValues :: String -> [t] -> t2
errorMissingValues String
label [t]
ess = 
  String -> t2
forall a. HasCallStack => String -> a
error (String -> t2) -> String -> t2
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Missing value(s) in %s: %s" String
label (t -> String
forall a. Show a => a -> String
show (t -> String) -> t -> String
forall a b. (a -> b) -> a -> b
$ [t] -> t
forall a. Monoid a => [a] -> a
mconcat [t]
ess)

liftGotValue :: (CanBeErrors es) => String -> (t1 -> t) -> CollectErrors es t1 -> t
liftGotValue :: String -> (t1 -> t) -> CollectErrors es t1 -> t
liftGotValue String
_ t1 -> t
op (CollectErrors (Just t1
v1) es
_) = 
  t1 -> t
op t1
v1
liftGotValue String
label t1 -> t
_op (CollectErrors Maybe t1
_ es
es1) = 
  String -> es -> t
forall t t2. (Show t, Monoid t) => String -> t -> t2
errorMissingValue String
label es
es1

liftGotValues2 :: (CanBeErrors es) => String -> (t1 -> t2 -> t) -> CollectErrors es t1 -> CollectErrors es t2 -> t
liftGotValues2 :: String
-> (t1 -> t2 -> t)
-> CollectErrors es t1
-> CollectErrors es t2
-> t
liftGotValues2 String
_ t1 -> t2 -> t
op (CollectErrors (Just t1
v1) es
_) (CollectErrors (Just t2
v2) es
_) = 
  t1 -> t2 -> t
op t1
v1 t2
v2
liftGotValues2 String
label t1 -> t2 -> t
_op (CollectErrors Maybe t1
_ es
es1) (CollectErrors Maybe t2
_ es
es2) = 
  String -> [es] -> t
forall t t2. (Show t, Monoid t) => String -> [t] -> t2
errorMissingValues String
label [es
es1, es
es2]