{-# 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 = Integer -> Integer
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 = Rational -> Rational
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
IfThenElseType Bool t
e1
    | Bool
otherwise = t
IfThenElseType Bool 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 = 
    es -> IfThenElseType b t -> IfThenElseType b t
forall es t. CanTakeErrors es t => es -> t -> t
takeErrors es
es (IfThenElseType b t -> IfThenElseType b t)
-> IfThenElseType b t -> IfThenElseType b t
forall a b. (a -> b) -> a -> b
$ b -> t -> t -> IfThenElseType b t
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
_ = 
    es -> IfThenElseType b 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 :: t -> Integer
integer = t -> Integer
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly
integers :: (CanBeInteger t) => [t] -> [Integer]
integers :: [t] -> [Integer]
integers = (t -> Integer) -> [t] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map t -> Integer
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly

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

(!!) :: (CanBeInteger n) => [a] -> n -> a
[a]
list !! :: [a] -> n -> a
!! n
ix = [a] -> Integer -> a
forall i a. Integral i => [a] -> i -> a
List.genericIndex [a]
list (n -> Integer
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 :: t a -> Integer
length = Int -> Integer
forall t. CanBeInteger t => t -> Integer
integer (Int -> Integer) -> (t a -> Int) -> t a -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length

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

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

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

splitAt :: (CanBeInteger n) => n -> [a] -> ([a],[a])
splitAt :: n -> [a] -> ([a], [a])
splitAt = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
P.splitAt (Int -> [a] -> ([a], [a])) -> (n -> Int) -> n -> [a] -> ([a], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall t. CanBeInt t => t -> Int
int (Integer -> Int) -> (n -> Integer) -> n -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Integer
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 :: T t -> Spec
specCanBeInteger (T String
typeName :: T t) =
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"generic list index (!!)" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"works using %s index" String
typeName) (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
      (t -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t -> Property) -> Property) -> (t -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t
x :: t) -> let xi :: Integer
xi = t -> Integer
forall t. CanBeInteger t => t -> Integer
integer t
x in (Integer
xi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
P.>= Integer
0) Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==> ([Integer
0..Integer
xi] [Integer] -> t -> Integer
forall n a. CanBeInteger n => [a] -> n -> a
!! t
x) Integer -> Integer -> Property
==$ Integer
xi
  where
  ==$ :: Integer -> Integer -> Property
(==$) = String
-> (Integer -> Integer -> Bool) -> Integer -> Integer -> Property
forall prop a b.
(Testable prop, Show a, Show b) =>
String -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 String
"==" Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
(P.==)

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

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

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

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

type CanBeDouble t = Convertible t Double
double :: (CanBeDouble t) => t -> Double
double :: t -> Double
double = t -> Double
forall a b. Convertible a b => a -> b
convert
doubles :: (CanBeDouble t) => [t] -> [Double]
doubles :: [t] -> [Double]
doubles = (t -> Double) -> [t] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map t -> Double
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 = t1 -> ConvertResult t2
forall a b. Convertible a b => a -> ConvertResult b
safeConvert

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

convertExactlyTargetSample :: (ConvertibleExactly t1 t2) => t2 -> t1 -> t2
convertExactlyTargetSample :: t2 -> t1 -> t2
convertExactlyTargetSample t2
_sample = t1 -> t2
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 = Int -> ConvertResult Int
forall a b. b -> Either a b
Right Int
n
instance ConvertibleExactly Rational Rational where
  safeConvertExactly :: Rational -> ConvertResult Rational
safeConvertExactly Rational
q = Rational -> ConvertResult Rational
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 <- Integer -> ConvertResult Double
forall a b. Convertible a b => a -> ConvertResult b
safeConvert Integer
n
    case Double -> (Integer, Double)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
P.properFraction Double
d of
      (Integer
m, Double
fr) | Integer
m Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
P.== Integer
n Bool -> Bool -> Bool
P.&& Double
fr Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
P.== (Integer -> Double
forall t. CanBeDouble t => t -> Double
double Integer
0) -> Double -> ConvertResult Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
d
      (Integer, Double)
_ -> String -> Integer -> ConvertResult 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 <- Int -> ConvertResult Double
forall a b. Convertible a b => a -> ConvertResult b
safeConvert Int
n
    case Double -> (Int, Double)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
P.properFraction Double
d of
      (Int
m, Double
fr) | Int
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
P.== Int
n Bool -> Bool -> Bool
P.&& Double
fr Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
P.== (Integer -> Double
forall t. CanBeDouble t => t -> Double
double Integer
0) -> Double -> ConvertResult Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
d
      (Int, Double)
_ -> String -> Int -> ConvertResult 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 = Double -> ConvertResult Double
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 = String -> T Int
forall t. String -> T t
T String
"Int"

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

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

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

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

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

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

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

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

tMaybeMaybeBool :: T (Maybe (Maybe Bool))
tMaybeMaybeBool :: T (Maybe (Maybe Bool))
tMaybeMaybeBool = T (Maybe Bool) -> T (Maybe (Maybe Bool))
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 :: (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 :: (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 :: (b -> b -> c) -> a -> b -> c
convertFirst = (a -> b -> b) -> (b -> b -> c) -> a -> b -> c
forall a b c. (a -> b -> b) -> (b -> b -> c) -> a -> b -> c
convertFirstUsing (\ a
a b
_ -> 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 :: (a -> a -> c) -> a -> b -> c
convertSecond = (a -> b -> a) -> (a -> a -> c) -> a -> b -> c
forall a b c. (a -> b -> a) -> (a -> a -> c) -> a -> b -> c
convertSecondUsing (\ a
_ b
b -> b -> a
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
  |]))