Copyright | (c) Michal Konecny |
---|---|
License | BSD3 |
Maintainer | mikkonecny@gmail.com |
Stability | experimental |
Portability | portable |
Safe Haskell | None |
Language | Haskell2010 |
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.
Synopsis
- fromInteger :: Integer -> Integer
- fromRational :: Rational -> Rational
- class HasIfThenElse b t where
- type IfThenElseType b t
- ifThenElse :: b -> t -> t -> IfThenElseType b t
- type HasIfThenElseSameType b t = (HasIfThenElse b t, IfThenElseType b t ~ t)
- type CanBeInteger t = ConvertibleExactly t Integer
- integer :: CanBeInteger t => t -> Integer
- integers :: CanBeInteger t => [t] -> [Integer]
- type HasIntegers t = ConvertibleExactly Integer t
- fromInteger_ :: HasIntegers t => Integer -> t
- type CanBeInt t = ConvertibleExactly t Int
- int :: CanBeInt t => t -> Int
- ints :: CanBeInt t => [t] -> [Int]
- type CanBeRational t = ConvertibleExactly t Rational
- rational :: CanBeRational t => t -> Rational
- rationals :: CanBeRational t => [t] -> [Rational]
- type HasRationals t = ConvertibleExactly Rational t
- fromRational_ :: HasRationals t => Rational -> t
- type CanBeDouble t = Convertible t Double
- double :: CanBeDouble t => t -> Double
- doubles :: CanBeDouble t => [t] -> [Double]
- class ConvertibleExactly t1 t2 where
- safeConvertExactly :: t1 -> ConvertResult t2
- convertExactly :: ConvertibleExactly t1 t2 => t1 -> t2
- convertExactlyTargetSample :: ConvertibleExactly t1 t2 => t2 -> t1 -> t2
- type ConvertResult a = Either ConvertError a
- data ConvertError
- convError :: (Show a, Typeable a, Typeable b) => String -> a -> ConvertResult b
- (!!) :: CanBeInteger n => [a] -> n -> a
- length :: Foldable t => t a -> Integer
- replicate :: CanBeInteger n => n -> a -> [a]
- take :: CanBeInteger n => n -> [a] -> [a]
- drop :: CanBeInteger n => n -> [a] -> [a]
- splitAt :: CanBeInteger n => n -> [a] -> ([a], [a])
- data T t = T String
- tInt :: T Int
- tInteger :: T Integer
- tCNInteger :: T (CN Integer)
- tRational :: T Rational
- tCNRational :: T (CN Rational)
- tDouble :: T Double
- tBool :: T Bool
- tMaybe :: T t -> T (Maybe t)
- tMaybeBool :: T (Maybe Bool)
- tMaybeMaybeBool :: T (Maybe (Maybe Bool))
- specCanBeInteger :: (CanBeInteger t, Show t, Arbitrary t) => T t -> Spec
- printArgsIfFails2 :: (Testable prop, Show a, Show b) => String -> (a -> b -> prop) -> a -> b -> Property
- convertFirst :: ConvertibleExactly a b => (b -> b -> c) -> a -> b -> c
- convertSecond :: ConvertibleExactly b a => (a -> a -> c) -> a -> b -> c
- convertFirstUsing :: (a -> b -> b) -> (b -> b -> c) -> a -> b -> c
- convertSecondUsing :: (a -> b -> a) -> (a -> a -> c) -> a -> b -> c
Fixed-type literals
fromInteger :: Integer -> Integer Source #
Replacement for fromInteger
using the RebindableSyntax extension.
This version of fromInteger arranges that integer literals
are always of type Integer
.
fromRational :: Rational -> Rational Source #
Replacement for fromRational
using the RebindableSyntax extension.
This version of fromRational arranges that rational literals are
always of type Rational
.
Generalised if-then-else
class HasIfThenElse b t where Source #
Restore if-then-else with RebindableSyntax
type IfThenElseType b t Source #
type IfThenElseType b t = t
ifThenElse :: b -> t -> t -> IfThenElseType b t Source #
Instances
HasIfThenElse Bool t Source # | |
Defined in Numeric.MixedTypes.Literals type IfThenElseType Bool t Source # ifThenElse :: Bool -> t -> t -> IfThenElseType Bool t Source # | |
(HasIfThenElse b t, CanTakeErrors es (IfThenElseType b t), CanBeErrors es) => HasIfThenElse (CollectErrors es b) t Source # | |
Defined in Numeric.MixedTypes.Literals type IfThenElseType (CollectErrors es b) t Source # ifThenElse :: CollectErrors es b -> t -> t -> IfThenElseType (CollectErrors es b) t Source # |
type HasIfThenElseSameType b t = (HasIfThenElse b t, IfThenElseType b t ~ t) Source #
Convenient conversions
type CanBeInteger t = ConvertibleExactly t Integer Source #
integer :: CanBeInteger t => t -> Integer Source #
integers :: CanBeInteger t => [t] -> [Integer] Source #
type HasIntegers t = ConvertibleExactly Integer t Source #
fromInteger_ :: HasIntegers t => Integer -> t Source #
type CanBeInt t = ConvertibleExactly t Int Source #
type CanBeRational t = ConvertibleExactly t Rational Source #
rational :: CanBeRational t => t -> Rational Source #
rationals :: CanBeRational t => [t] -> [Rational] Source #
type HasRationals t = ConvertibleExactly Rational t Source #
fromRational_ :: HasRationals t => Rational -> t Source #
type CanBeDouble t = Convertible t Double Source #
double :: CanBeDouble t => t -> Double Source #
doubles :: CanBeDouble t => [t] -> [Double] Source #
class ConvertibleExactly t1 t2 where Source #
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.
Nothing
safeConvertExactly :: t1 -> ConvertResult t2 Source #
default safeConvertExactly :: Convertible t1 t2 => t1 -> ConvertResult t2 Source #
Instances
convertExactly :: ConvertibleExactly t1 t2 => t1 -> t2 Source #
convertExactlyTargetSample :: ConvertibleExactly t1 t2 => t2 -> t1 -> t2 Source #
type ConvertResult a = Either ConvertError a Source #
The result of a safe conversion via safeConvert
.
data ConvertError Source #
How we indicate that there was an error.
Instances
Eq ConvertError Source # | |
Defined in Data.Convertible.Base (==) :: ConvertError -> ConvertError -> Bool # (/=) :: ConvertError -> ConvertError -> Bool # | |
Read ConvertError Source # | |
Defined in Data.Convertible.Base readsPrec :: Int -> ReadS ConvertError # readList :: ReadS [ConvertError] # | |
Show ConvertError Source # | |
Defined in Data.Convertible.Base showsPrec :: Int -> ConvertError -> ShowS # show :: ConvertError -> String # showList :: [ConvertError] -> ShowS # | |
Error ConvertError Source # | |
Defined in Data.Convertible.Base noMsg :: ConvertError # strMsg :: String -> ConvertError # |
Prelude List operations versions without Int
(!!) :: CanBeInteger n => [a] -> n -> a Source #
replicate :: CanBeInteger n => n -> a -> [a] Source #
take :: CanBeInteger n => n -> [a] -> [a] Source #
drop :: CanBeInteger n => n -> [a] -> [a] Source #
splitAt :: CanBeInteger n => n -> [a] -> ([a], [a]) Source #
Testing support functions
A runtime representative of type t
.
Used for specialising polymorphic tests to concrete types.
specCanBeInteger :: (CanBeInteger t, Show t, Arbitrary t) => T t -> Spec Source #
HSpec properties that each implementation of CanBeInteger should satisfy.
printArgsIfFails2 :: (Testable prop, Show a, Show b) => String -> (a -> b -> prop) -> a -> b -> Property Source #
Helper functions
:: ConvertibleExactly a b | |
=> (b -> b -> c) | same-type operation |
-> a -> b -> c | mixed-type operation |
:: ConvertibleExactly b a | |
=> (a -> a -> c) | same-type operation |
-> a -> b -> c | mixed-type operation |
:: (a -> b -> b) | conversion function |
-> (b -> b -> c) | same-type operation |
-> a -> b -> c | mixed-type operation |
:: (a -> b -> a) | conversion function |
-> (a -> a -> c) | same-type operation |
-> a -> b -> c | mixed-type operation |