{-# LANGUAGE TemplateHaskell #-}
{-|
    Module      :  Numeric.MixedType.Literals
    Description :  Fixed-type numeric literals, conversions
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

    Maintainer  :  mikkonecny@gmail.com
    Stability   :  experimental
    Portability :  portable

    This module defines fixed-type integer and rational literals.
    This is useful when deriving the type of an expression bottom-up.
    Eg we would not be able to write @1 < x@
    when the type of @<@ does not force the two sides to be of the
    same type.  We would need to write eg @(1::Integer) < x@ with
    Prelude's generic literals.

    Moreover, convenient conversion functions are provided for
    the most common numeric types.  Thus one can say eg:

    * @take (int 1)@
    * @integer (length list)@.
    * @double 0.5@

    To avoid integer overflow, no aritmetic operations return 'Int'.
    Nevertheless, one can usually mix 'Int' with other types in expressions.

    Any approximate arithmetic, ie arithmetic involving Doubles, returns
    values of type 'Double'.
    'Double' values cannot be easily converted to exact
    types such as 'Rational' or 'Integer' so that all such
    conversions are clearly visible as labelled as inexact.
-}

module Numeric.MixedTypes.Literals
(
  -- * Fixed-type literals
  fromInteger, fromRational
  -- * Generalised if-then-else
  , HasIfThenElse(..), HasIfThenElseSameType
  -- * Convenient conversions
  , CanBeInteger, integer, integers, HasIntegers, fromInteger_
  , CanBeInt, int, ints
  , CanBeRational, rational, rationals, HasRationals, fromRational_
  , CanBeDouble, double, doubles
  , ConvertibleExactly(..), convertExactly, convertExactlyTargetSample
  , ConvertResult, ConvertError, convError
  -- * Prelude List operations versions without Int
  , (!!), length, replicate, take, drop, splitAt
  -- * Testing support functions
  , T(..), tInt, tInteger, tCNInteger, tRational, tCNRational, tDouble
  , tBool, tMaybe, tMaybeBool, tMaybeMaybeBool
  , specCanBeInteger
  , printArgsIfFails2
  -- * Helper functions
  , convertFirst, convertSecond
  , convertFirstUsing, convertSecondUsing
)
where

import Utils.TH.DeclForTypes

import Numeric.MixedTypes.PreludeHiding
import qualified Prelude as P
import Text.Printf

-- import Data.Convertible (Convertible(..), convert, ConvertResult, ConvertError, convError)
import Data.Convertible.Base
import Data.Convertible.Instances.Num ()

import qualified Data.List as List

import Test.Hspec
import Test.QuickCheck
-- import Control.Exception (evaluate)

import Numeric.CollectErrors (CN)
import Control.CollectErrors

{-| Replacement for 'Prelude.fromInteger' using the RebindableSyntax extension.
    This version of fromInteger arranges that integer literals
    are always of type 'Integer'.
-}
fromInteger :: Integer -> Integer
fromInteger :: Integer -> Integer
fromInteger = forall a. a -> a
id

{-| Replacement for 'Prelude.fromRational' using the RebindableSyntax extension.
    This version of fromRational arranges that rational literals are
    always of type 'Rational'. -}
fromRational :: Rational -> Rational
fromRational :: Rational -> Rational
fromRational = forall a. a -> a
id

{-|
  Restore if-then-else with RebindableSyntax
-}
class HasIfThenElse b t where
  type IfThenElseType b t
  type IfThenElseType b t = t
  ifThenElse :: b -> t -> t -> IfThenElseType b t

type HasIfThenElseSameType b t =
  (HasIfThenElse b t, IfThenElseType b t ~ t)

instance HasIfThenElse Bool t where
  ifThenElse :: Bool -> t -> t -> IfThenElseType Bool t
ifThenElse Bool
b t
e1 t
e2
    | Bool
b = t
e1
    | Bool
otherwise = t
e2

instance 
  (HasIfThenElse b t, CanTakeErrors es (IfThenElseType b t), CanBeErrors es) 
  =>
  (HasIfThenElse (CollectErrors es b) t)
  where
  type IfThenElseType (CollectErrors es b) t = IfThenElseType b t
  ifThenElse :: CollectErrors es b
-> t -> t -> IfThenElseType (CollectErrors es b) t
ifThenElse (CollectErrors (Just b
b) es
es) t
e1 t
e2 = 
    forall es t. CanTakeErrors es t => es -> t -> t
takeErrors es
es forall a b. (a -> b) -> a -> b
$ forall b t. HasIfThenElse b t => b -> t -> t -> IfThenElseType b t
ifThenElse b
b t
e1 t
e2
  ifThenElse (CollectErrors Maybe b
_ es
es) t
_ t
_ = 
    forall es t. CanTakeErrors es t => es -> t
takeErrorsNoValue es
es

_testIf1 :: String
_testIf1 :: String
_testIf1 = if Bool
True then String
"yes" else String
"no"

{---- Numeric conversions -----}

type CanBeInteger t = ConvertibleExactly t Integer
integer :: (CanBeInteger t) => t -> Integer
integer :: forall t. CanBeInteger t => t -> Integer
integer = forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly
integers :: (CanBeInteger t) => [t] -> [Integer]
integers :: forall t. CanBeInteger t => [t] -> [Integer]
integers = forall a b. (a -> b) -> [a] -> [b]
map forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly

type HasIntegers t = ConvertibleExactly Integer t
fromInteger_ :: (HasIntegers t) => Integer -> t
fromInteger_ :: forall t. HasIntegers t => Integer -> t
fromInteger_ = forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly

(!!) :: (CanBeInteger n) => [a] -> n -> a
[a]
list !! :: forall n a. CanBeInteger n => [a] -> n -> a
!! n
ix = forall i a. Integral i => [a] -> i -> a
List.genericIndex [a]
list (forall t. CanBeInteger t => t -> Integer
integer n
ix)
-- list !! ix = List.genericIndex list (P.max 0 ((integer ix) P.- 1)) -- deliberately wrong - test the test!

length :: (Foldable t) => t a -> Integer
length :: forall (t :: * -> *) a. Foldable t => t a -> Integer
length = forall t. CanBeInteger t => t -> Integer
integer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
P.length

replicate :: (CanBeInteger n) => n -> a -> [a]
replicate :: forall n a. CanBeInteger n => n -> a -> [a]
replicate = forall a. Int -> a -> [a]
P.replicate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. CanBeInt t => t -> Int
int forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. CanBeInteger t => t -> Integer
integer

take :: (CanBeInteger n) => n -> [a] -> [a]
take :: forall n a. CanBeInteger n => n -> [a] -> [a]
take = forall a. Int -> [a] -> [a]
P.take forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. CanBeInt t => t -> Int
int forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. CanBeInteger t => t -> Integer
integer

drop :: (CanBeInteger n) => n -> [a] -> [a]
drop :: forall n a. CanBeInteger n => n -> [a] -> [a]
drop = forall a. Int -> [a] -> [a]
P.drop forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. CanBeInt t => t -> Int
int forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. CanBeInteger t => t -> Integer
integer

splitAt :: (CanBeInteger n) => n -> [a] -> ([a],[a])
splitAt :: forall n a. CanBeInteger n => n -> [a] -> ([a], [a])
splitAt = forall a. Int -> [a] -> ([a], [a])
P.splitAt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. CanBeInt t => t -> Int
int forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. CanBeInteger t => t -> Integer
integer

{-|
  HSpec properties that each implementation of CanBeInteger should satisfy.
 -}
specCanBeInteger ::
  (CanBeInteger t, Show t, Arbitrary t) =>
  T t -> Spec
specCanBeInteger :: forall t. (CanBeInteger t, Show t, Arbitrary t) => T t -> Spec
specCanBeInteger (T String
typeName :: T t) =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"generic list index (!!)" forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it (forall r. PrintfType r => String -> r
printf String
"works using %s index" String
typeName) forall a b. (a -> b) -> a -> b
$ do
      forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ \ (t
x :: t) -> let xi :: Integer
xi = forall t. CanBeInteger t => t -> Integer
integer t
x in (Integer
xi forall a. Ord a => a -> a -> Bool
P.>= Integer
0) forall prop. Testable prop => Bool -> prop -> Property
==> ([Integer
0..Integer
xi] forall n a. CanBeInteger n => [a] -> n -> a
!! t
x) Integer -> Integer -> Property
==$ Integer
xi
  where
  ==$ :: Integer -> Integer -> Property
(==$) = forall prop a b.
(Testable prop, Show a, Show b) =>
String -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 String
"==" forall a. Eq a => a -> a -> Bool
(P.==)

printArgsIfFails2 ::
  (Testable prop, Show a, Show b) =>
  String -> (a -> b -> prop) -> (a -> b -> Property)
printArgsIfFails2 :: forall prop a b.
(Testable prop, Show a, Show b) =>
String -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 String
relName a -> b -> prop
rel a
a b
b =
  forall prop. Testable prop => String -> prop -> Property
counterexample String
argsReport forall a b. (a -> b) -> a -> b
$ a
a a -> b -> prop
`rel` b
b
  where
  argsReport :: String
argsReport =
    String
"FAILED REL: (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
a forall a. [a] -> [a] -> [a]
++ String
") " forall a. [a] -> [a] -> [a]
++ String
relName forall a. [a] -> [a] -> [a]
++ String
" (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show b
b forall a. [a] -> [a] -> [a]
++ String
")"

type CanBeInt t = ConvertibleExactly t Int
int :: (CanBeInt t) => t -> Int
int :: forall t. CanBeInt t => t -> Int
int = forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly
ints :: (CanBeInt t) => [t] -> [Int]
ints :: forall t. CanBeInt t => [t] -> [Int]
ints = forall a b. (a -> b) -> [a] -> [b]
map forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly

type CanBeRational t = ConvertibleExactly t Rational
rational :: (CanBeRational t) => t -> Rational
rational :: forall t. CanBeRational t => t -> Rational
rational = forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly
rationals :: (CanBeRational t) => [t] -> [Rational]
rationals :: forall t. CanBeRational t => [t] -> [Rational]
rationals = forall a b. (a -> b) -> [a] -> [b]
map forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly

type HasRationals t = ConvertibleExactly Rational t
fromRational_ :: (HasRationals t) => Rational -> t
fromRational_ :: forall t. HasRationals t => Rational -> t
fromRational_ = forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly

type CanBeDouble t = Convertible t Double
double :: (CanBeDouble t) => t -> Double
double :: forall t. CanBeDouble t => t -> Double
double = forall a b. Convertible a b => a -> b
convert
doubles :: (CanBeDouble t) => [t] -> [Double]
doubles :: forall t. CanBeDouble t => [t] -> [Double]
doubles = forall a b. (a -> b) -> [a] -> [b]
map forall a b. Convertible a b => a -> b
convert

{-|
Define our own ConvertibleExactly since convertible is too relaxed for us.
For example, convertible allows conversion from Rational to Integer,
rounding to nearest integer.  We prefer to allow only exact conversions.
-}
class ConvertibleExactly t1 t2 where
  safeConvertExactly :: t1 -> ConvertResult t2
  default safeConvertExactly :: (Convertible t1 t2) => t1 -> ConvertResult t2
  safeConvertExactly = forall a b. Convertible a b => a -> ConvertResult b
safeConvert

convertExactly :: (ConvertibleExactly t1 t2) => t1 -> t2
convertExactly :: forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly t1
a =
  case forall t1 t2. ConvertibleExactly t1 t2 => t1 -> ConvertResult t2
safeConvertExactly t1
a of
    Right t2
v -> t2
v
    Left ConvertError
err -> forall a. HasCallStack => String -> a
error (forall a. Show a => a -> String
show ConvertError
err)

convertExactlyTargetSample :: (ConvertibleExactly t1 t2) => t2 -> t1 -> t2
convertExactlyTargetSample :: forall t1 t2. ConvertibleExactly t1 t2 => t2 -> t1 -> t2
convertExactlyTargetSample t2
_sample = forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly

instance ConvertibleExactly Integer Integer -- use CVT instance by default
instance ConvertibleExactly Int Integer

instance ConvertibleExactly Int Int where
  safeConvertExactly :: Int -> ConvertResult Int
safeConvertExactly Int
n = forall a b. b -> Either a b
Right Int
n
instance ConvertibleExactly Rational Rational where
  safeConvertExactly :: Rational -> ConvertResult Rational
safeConvertExactly Rational
q = forall a b. b -> Either a b
Right Rational
q

instance ConvertibleExactly Integer Int
instance ConvertibleExactly Int Rational
instance ConvertibleExactly Integer Rational

instance ConvertibleExactly Integer Double where
  safeConvertExactly :: Integer -> ConvertResult Double
safeConvertExactly Integer
n =
    do
    Double
d <- forall a b. Convertible a b => a -> ConvertResult b
safeConvert Integer
n
    case forall a b. (RealFrac a, Integral b) => a -> (b, a)
P.properFraction Double
d of
      (Integer
m, Double
fr) | Integer
m forall a. Eq a => a -> a -> Bool
P.== Integer
n Bool -> Bool -> Bool
P.&& Double
fr forall a. Eq a => a -> a -> Bool
P.== (forall t. CanBeDouble t => t -> Double
double Integer
0) -> forall (m :: * -> *) a. Monad m => a -> m a
return Double
d
      (Integer, Double)
_ -> forall a b.
(Show a, Typeable a, Typeable b) =>
String -> a -> ConvertResult b
convError String
"Integer could not be exactly converted to Double" Integer
n

instance ConvertibleExactly Int Double where
  safeConvertExactly :: Int -> ConvertResult Double
safeConvertExactly Int
n =
    do
    Double
d <- forall a b. Convertible a b => a -> ConvertResult b
safeConvert Int
n
    case forall a b. (RealFrac a, Integral b) => a -> (b, a)
P.properFraction Double
d of
      (Int
m, Double
fr) | Int
m forall a. Eq a => a -> a -> Bool
P.== Int
n Bool -> Bool -> Bool
P.&& Double
fr forall a. Eq a => a -> a -> Bool
P.== (forall t. CanBeDouble t => t -> Double
double Integer
0) -> forall (m :: * -> *) a. Monad m => a -> m a
return Double
d
      (Int, Double)
_ -> forall a b.
(Show a, Typeable a, Typeable b) =>
String -> a -> ConvertResult b
convError String
"Int could not be exactly converted to Double" Int
n

instance ConvertibleExactly Double Double where
  safeConvertExactly :: Double -> ConvertResult Double
safeConvertExactly Double
d = forall a b. b -> Either a b
Right Double
d

{-- we deliberately do not allow converions from Double to any other type --}

{-- auxiliary type and functions for specifying type(s) to use in tests  --}

{-|
  A runtime representative of type @t@.
  Used for specialising polymorphic tests to concrete types.
-}
data T t = T String

tInt :: T Int
tInt :: T Int
tInt = forall t. String -> T t
T String
"Int"

tInteger :: T Integer
tInteger :: T Integer
tInteger = forall t. String -> T t
T String
"Integer"

tCNInteger :: T (CN Integer)
tCNInteger :: T (CN Integer)
tCNInteger = forall t. String -> T t
T String
"(CN Integer)"

tRational :: T Rational
tRational :: T Rational
tRational = forall t. String -> T t
T String
"Rational"

tCNRational :: T (CN Rational)
tCNRational :: T (CN Rational)
tCNRational = forall t. String -> T t
T String
"(CN Rational)"

tDouble :: T Double
tDouble :: T Double
tDouble = forall t. String -> T t
T String
"Double"

tBool :: T Bool
tBool :: T Bool
tBool = forall t. String -> T t
T String
"Bool"

tMaybe :: T t -> T (Maybe t)
tMaybe :: forall t. T t -> T (Maybe t)
tMaybe (T String
tName) = forall t. String -> T t
T (String
"(Maybe " forall a. [a] -> [a] -> [a]
++ String
tName forall a. [a] -> [a] -> [a]
++ String
")")

tMaybeBool :: T (Maybe Bool)
tMaybeBool :: T (Maybe Bool)
tMaybeBool = forall t. T t -> T (Maybe t)
tMaybe T Bool
tBool

tMaybeMaybeBool :: T (Maybe (Maybe Bool))
tMaybeMaybeBool :: T (Maybe (Maybe Bool))
tMaybeMaybeBool = forall t. T t -> T (Maybe t)
tMaybe T (Maybe Bool)
tMaybeBool

{---- Auxiliary functions ----}

convertFirstUsing ::
  (a -> b -> b) {-^ conversion function -} ->
  (b -> b -> c) {-^ same-type operation -} ->
  (a -> b -> c) {-^ mixed-type operation -}
convertFirstUsing :: forall a b c. (a -> b -> b) -> (b -> b -> c) -> a -> b -> c
convertFirstUsing a -> b -> b
conv b -> b -> c
op a
a b
b = b -> b -> c
op (a -> b -> b
conv a
a b
b) b
b

convertSecondUsing ::
  (a -> b -> a) {-^ conversion function -} ->
  (a -> a -> c) {-^ same-type operation -} ->
  (a -> b -> c) {-^ mixed-type operation -}
convertSecondUsing :: forall a b c. (a -> b -> a) -> (a -> a -> c) -> a -> b -> c
convertSecondUsing a -> b -> a
conv a -> a -> c
op a
a b
b = a -> a -> c
op a
a (a -> b -> a
conv a
a b
b)

convertFirst ::
  (ConvertibleExactly a b) =>
  (b -> b -> c) {-^ same-type operation -} ->
  (a -> b -> c) {-^ mixed-type operation -}
convertFirst :: forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst = forall a b c. (a -> b -> b) -> (b -> b -> c) -> a -> b -> c
convertFirstUsing (\ a
a b
_ -> forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly a
a)

convertSecond ::
  (ConvertibleExactly b a) =>
  (a -> a -> c) {-^ same-type operation -} ->
  (a -> b -> c) {-^ mixed-type operation -}
convertSecond :: forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond = forall a b c. (a -> b -> a) -> (a -> a -> c) -> a -> b -> c
convertSecondUsing (\ a
_ b
b -> forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly b
b)

-- instance
--   (ConvertibleExactly t1 t2, CanBeErrors es)
--   =>
--   ConvertibleExactly t1 (CollectErrors es t2)
--   where
--   safeConvertExactly = fmap pure . safeConvertExactly
--

$(declForTypes
  [[t| Bool |], [t| Integer |], [t| Int |], [t| Rational |], [t| Double |]]
  (\ t -> [d|

    instance (ConvertibleExactly $t t, Monoid es) => ConvertibleExactly $t (CollectErrors es t) where
      safeConvertExactly = fmap pure . safeConvertExactly
  |]))