module Numeric.MixedTypes.Literals
(
fromInteger, fromRational
, HasIfThenElse(..), HasIfThenElseSameType
, CanBeInteger, integer, integers, HasIntegers, fromInteger_
, CanBeInt, int, ints
, CanBeRational, rational, rationals, HasRationals, fromRational_
, CanBeDouble, double, doubles
, ConvertibleExactly(..), convertExactly, convertExactlyTargetSample
, ConvertResult, ConvertError, convError
, (!!), length, replicate, take, drop, splitAt
, T(..), tInt, tInteger, tRational, tDouble
, tBool, tMaybe, tMaybeBool, tMaybeMaybeBool
, specCanBeInteger
, printArgsIfFails2
, 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 qualified Data.List as List
import Test.Hspec
import Test.QuickCheck
import Control.CollectErrors
fromInteger :: Integer -> Integer
fromInteger = id
fromRational :: Rational -> Rational
fromRational = id
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 b e1 e2
| b = e1
| otherwise = e2
_testIf1 :: String
_testIf1 = if True then "yes" else "no"
type CanBeInteger t = ConvertibleExactly t Integer
integer :: (CanBeInteger t) => t -> Integer
integer = convertExactly
integers :: (CanBeInteger t) => [t] -> [Integer]
integers = map convertExactly
type HasIntegers t = ConvertibleExactly Integer t
fromInteger_ :: (HasIntegers t) => Integer -> t
fromInteger_ = convertExactly
(!!) :: (CanBeInteger n) => [a] -> n -> a
list !! ix = List.genericIndex list (integer ix)
length :: (Foldable t) => t a -> Integer
length = integer . P.length
replicate :: (CanBeInteger n) => n -> a -> [a]
replicate = P.replicate . int . integer
take :: (CanBeInteger n) => n -> [a] -> [a]
take = P.take . int . integer
drop :: (CanBeInteger n) => n -> [a] -> [a]
drop = P.drop . int . integer
splitAt :: (CanBeInteger n) => n -> [a] -> ([a],[a])
splitAt = P.splitAt . int . integer
specCanBeInteger ::
(CanBeInteger t, Show t, Arbitrary t) =>
T t -> Spec
specCanBeInteger (T typeName :: T t) =
describe "generic list index (!!)" $ do
it (printf "works using %s index" typeName) $ do
property $ \ (x :: t) -> let xi = integer x in (xi P.>= 0) ==> ([0..xi] !! x) ==$ xi
where
(==$) = printArgsIfFails2 "==" (P.==)
printArgsIfFails2 ::
(Testable prop, Show a, Show b) =>
String -> (a -> b -> prop) -> (a -> b -> Property)
printArgsIfFails2 relName rel a b =
counterexample argsReport $ a `rel` b
where
argsReport =
"FAILED REL: (" ++ show a ++ ") " ++ relName ++ " (" ++ show b ++ ")"
type CanBeInt t = ConvertibleExactly t Int
int :: (CanBeInt t) => t -> Int
int = convertExactly
ints :: (CanBeInt t) => [t] -> [Int]
ints = map convertExactly
type CanBeRational t = ConvertibleExactly t Rational
rational :: (CanBeRational t) => t -> Rational
rational = convertExactly
rationals :: (CanBeRational t) => [t] -> [Rational]
rationals = map convertExactly
type HasRationals t = ConvertibleExactly Rational t
fromRational_ :: (HasRationals t) => Rational -> t
fromRational_ = convertExactly
type CanBeDouble t = Convertible t Double
double :: (CanBeDouble t) => t -> Double
double = convert
doubles :: (CanBeDouble t) => [t] -> [Double]
doubles = map convert
class ConvertibleExactly t1 t2 where
safeConvertExactly :: t1 -> ConvertResult t2
default safeConvertExactly :: (Convertible t1 t2) => t1 -> ConvertResult t2
safeConvertExactly = safeConvert
convertExactly :: (ConvertibleExactly t1 t2) => t1 -> t2
convertExactly a =
case safeConvertExactly a of
Right v -> v
Left err -> error (show err)
convertExactlyTargetSample :: (ConvertibleExactly t1 t2) => t2 -> t1 -> t2
convertExactlyTargetSample _sample = convertExactly
instance ConvertibleExactly Integer Integer
instance ConvertibleExactly Int Integer
instance ConvertibleExactly Int Int where
safeConvertExactly n = Right n
instance ConvertibleExactly Rational Rational where
safeConvertExactly q = Right q
instance ConvertibleExactly Integer Int
instance ConvertibleExactly Int Rational
instance ConvertibleExactly Integer Rational
instance ConvertibleExactly Integer Double where
safeConvertExactly n =
do
d <- safeConvert n
case P.properFraction d of
(m, fr) | m P.== n P.&& fr P.== (double 0) -> return d
_ -> convError "Integer could not be exactly converted to Double" n
instance ConvertibleExactly Int Double where
safeConvertExactly n =
do
d <- safeConvert n
case P.properFraction d of
(m, fr) | m P.== n P.&& fr P.== (double 0) -> return d
_ -> convError "Int could not be exactly converted to Double" n
instance ConvertibleExactly Double Double where
safeConvertExactly d = Right d
data T t = T String
tInt :: T Int
tInt = T "Int"
tInteger :: T Integer
tInteger = T "Integer"
tRational :: T Rational
tRational = T "Rational"
tDouble :: T Double
tDouble = T "Double"
tBool :: T Bool
tBool = T "Bool"
tMaybe :: T t -> T (Maybe t)
tMaybe (T tName) = T ("(Maybe " ++ tName ++ ")")
tMaybeBool :: T (Maybe Bool)
tMaybeBool = tMaybe tBool
tMaybeMaybeBool :: T (Maybe (Maybe Bool))
tMaybeMaybeBool = tMaybe tMaybeBool
convertFirstUsing ::
(a -> b -> b) ->
(b -> b -> c) ->
(a -> b -> c)
convertFirstUsing conv op a b = op (conv a b) b
convertSecondUsing ::
(a -> b -> a) ->
(a -> a -> c) ->
(a -> b -> c)
convertSecondUsing conv op a b = op a (conv a b)
convertFirst ::
(ConvertibleExactly a b) =>
(b -> b -> c) ->
(a -> b -> c)
convertFirst = convertFirstUsing (\ a _ -> convertExactly a)
convertSecond ::
(ConvertibleExactly b a) =>
(a -> a -> c) ->
(a -> b -> c)
convertSecond = convertSecondUsing (\ _ b -> convertExactly b)
$(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 (\v -> CollectErrors (Just v) mempty) . safeConvertExactly
|]))