lehins / Color / 6

Committed 20 Oct 2025 08:45PM UTC coverage: 71.409% (+0.3%) from 71.106%

Build # 6

Build Type

push

github

Committed by

web-flow

Commit Message

Merge pull request #22 from lehins/update-ghc-and-fix-ci

Update GHC versions on CI

Run Details

2133 of 2987 relevant lines covered (71.41%)

1.37 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

76.08

/Color/src/Graphics/Color/Algebra/Elevator.hs

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- |
-- Module      : Graphics.Color.Algebra.Elevator
-- Copyright   : (c) Alexey Kuleshevich 2018-2025
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
-- Stability   : experimental
-- Portability : non-portable
--
module Graphics.Color.Algebra.Elevator
  ( Elevator(..)
  , module Data.Word
  , clamp01
  ) where

import Data.Complex
import Data.Int
import Data.Typeable
import Data.Vector.Storable (Storable)
import Data.Vector.Unboxed (Unbox)
import Data.Word
import GHC.Float
import Text.Printf

infixl 7 //

defFieldFormat :: FieldFormat
defFieldFormat = FieldFormat Nothing Nothing Nothing Nothing False "" 'v'

-- | A class with a set of functions that allow for changing precision by shrinking and
-- streatching the values.
class (Show e, Eq e, Num e, Typeable e, Unbox e, Storable e) => Elevator e where
  maxValue :: e

  minValue :: e

  fieldFormat :: e -> FieldFormat
  fieldFormat _ = defFieldFormat

  -- | This is a pretty printer for the value.
  toShowS :: e -> ShowS
  default toShowS :: PrintfArg e => e -> ShowS
  toShowS e = formatArg e (fieldFormat e)

  -- | Values are scaled to @[0, 255]@ range.
  toWord8 :: e -> Word8

  -- | Values are scaled from @[0, 255]@ range to @[minValue, maxValue]@.
  fromWord8 :: Word8 -> e

  -- | Values are scaled to @[0, 65535]@ range.
  toWord16 :: e -> Word16

  -- | Values are scaled to @[0, 4294967295]@ range.
  toWord32 :: e -> Word32

  -- | Values are scaled to @[0, 18446744073709551615]@ range.
  toWord64 :: e -> Word64

  -- | Values are scaled to @[0.0, 1.0]@ range.
  toRealFloat :: (Elevator a, RealFloat a) => e -> a

  -- | Values are scaled from @[0.0, 1.0]@ range.
  fromRealFloat :: (Elevator a, RealFloat a) => a -> e

  -- | Values are scaled to @[0.0, 1.0]@ range.
  toFloat :: e -> Float
  toFloat = toRealFloat

  -- | Values are scaled to @[0.0, 1.0]@ range.
  toDouble :: e -> Double
  toDouble = toRealFloat

  -- | Values are scaled from @[0.0, 1.0]@ range.
  fromDouble :: Double -> e
  fromDouble = fromRealFloat

  -- | Division that works for integral types as well as floating points. May throw an exception.
  (//) :: e -> e -> e


-- | Lower the precision
dropDown :: forall a b. (Integral a, Bounded a, Integral b, Bounded b) => a -> b
dropDown !e = fromIntegral $ fromIntegral e `div` ((maxBound :: a) `div`
                                                   fromIntegral (maxBound :: b))
{-# INLINE dropDown #-}

-- | Increase the precision
raiseUp :: forall a b. (Integral a, Bounded a, Integral b, Bounded b) => a -> b
raiseUp !e = fromIntegral e * ((maxBound :: b) `div` fromIntegral (maxBound :: a))
{-# INLINE raiseUp #-}

-- | Convert to fractional with value less than or equal to 1.
squashTo1 :: forall a b. (Fractional b, Integral a, Bounded a) => a -> b
squashTo1 !e = fromIntegral e / fromIntegral (maxBound :: a)
{-# INLINE squashTo1 #-}

-- | Convert to integral streaching it's value up to a maximum value.
stretch :: forall a b. (RealFloat a, Integral b, Bounded b) => a -> b
stretch !e = round (fromIntegral (maxBound :: b) * clamp01 e)
{-# INLINE stretch #-}

-- | Clamp a value to @[0, 1]@ range.
clamp01 :: RealFloat a => a -> a
clamp01 !x = min (max 0 x) 1
{-# INLINE clamp01 #-}


float2Word32 :: Float -> Word32
float2Word32 d'
  | d' <= 0 = 0
  | d > 4.294967e9 = maxBound
  | otherwise = round d
  where
    d = maxWord32 * d'
{-# INLINE float2Word32 #-}

-- | Same as:
-- >>> fromIntegral (maxBound :: Word32) :: Float
-- 4.2949673e9
--
maxWord32 :: Float
maxWord32 = F# 4.2949673e9#
{-# INLINE maxWord32 #-}

double2Word64 :: Double -> Word64
double2Word64 d'
  | d' <= 0 = 0
  | d > 1.844674407370955e19 = maxBound
  | otherwise = round d
  where
    d = maxWord64 * d'
{-# INLINE double2Word64 #-}

-- | Differs from `fromIntegral` due to: [GHC #17782](https://gitlab.haskell.org/ghc/ghc/issues/17782)
--
-- This is the value for ghc < 9.2
--
-- > fromIntegral (maxBound :: Word64) :: Double
-- 1.844674407370955e19
--
maxWord64 :: Double
maxWord64 = D# 1.8446744073709552e19##
{-# INLINE maxWord64 #-}

{-# RULES
"fromRealFloat :: Double -> Word" fromRealFloat = fromDouble :: Double -> Word
"fromRealFloat :: Double -> Word64" fromRealFloat = fromDouble :: Double -> Word64
"fromRealFloat :: Float -> Word32" fromRealFloat = float2Word32
 #-}


-- | Values between @[0, 255]]@
instance Elevator Word8 where
  maxValue = maxBound
  minValue = minBound
  fieldFormat _ = defFieldFormat {fmtWidth = Just 3, fmtChar = 'd'}
  toWord8 = id
  {-# INLINE toWord8 #-}
  fromWord8 = id
  {-# INLINE fromWord8 #-}
  toWord16 = raiseUp
  {-# INLINE toWord16 #-}
  toWord32 = raiseUp
  {-# INLINE toWord32 #-}
  toWord64 = raiseUp
  {-# INLINE toWord64 #-}
  toFloat = squashTo1
  {-# INLINE toFloat #-}
  toDouble = squashTo1
  {-# INLINE toDouble #-}
  fromDouble = toWord8
  {-# INLINE fromDouble #-}
  toRealFloat = squashTo1
  {-# INLINE toRealFloat #-}
  fromRealFloat = toWord8
  {-# INLINE fromRealFloat #-}
  (//) = div
  {-# INLINE (//) #-}


-- | Values between @[0, 65535]]@
instance Elevator Word16 where
  maxValue = maxBound
  minValue = minBound
  fieldFormat _ = defFieldFormat { fmtWidth = Just 5, fmtChar = 'd'}
  toWord8 = dropDown
  {-# INLINE toWord8 #-}
  fromWord8 = raiseUp
  {-# INLINE fromWord8 #-}
  toWord16 = id
  {-# INLINE toWord16 #-}
  toWord32 = raiseUp
  {-# INLINE toWord32 #-}
  toWord64 = raiseUp
  {-# INLINE toWord64 #-}
  toFloat = squashTo1
  {-# INLINE toFloat #-}
  toDouble = squashTo1
  {-# INLINE toDouble #-}
  fromDouble = toWord16
  {-# INLINE fromDouble #-}
  toRealFloat = squashTo1
  {-# INLINE toRealFloat #-}
  fromRealFloat = toWord16
  {-# INLINE fromRealFloat #-}
  (//) = div
  {-# INLINE (//) #-}


-- | Values between @[0, 4294967295]@
instance Elevator Word32 where
  maxValue = maxBound
  minValue = minBound
  fieldFormat _ = defFieldFormat { fmtWidth = Just 10, fmtChar = 'd'}
  toWord8 = dropDown
  {-# INLINE toWord8 #-}
  fromWord8 = raiseUp
  {-# INLINE fromWord8 #-}
  toWord16 = dropDown
  {-# INLINE toWord16 #-}
  toWord32 = id
  {-# INLINE toWord32 #-}
  toWord64 = raiseUp
  {-# INLINE toWord64 #-}
  toFloat = squashTo1
  {-# INLINE toFloat #-}
  toDouble = squashTo1
  {-# INLINE toDouble #-}
  fromDouble = toWord32
  {-# INLINE fromDouble #-}
  toRealFloat = squashTo1
  {-# INLINE toRealFloat #-}
  fromRealFloat = toWord32
  {-# INLINE fromRealFloat #-}
  (//) = div
  {-# INLINE (//) #-}


-- | Values between @[0, 18446744073709551615]@
instance Elevator Word64 where
  maxValue = maxBound
  minValue = minBound
  fieldFormat _ = defFieldFormat { fmtWidth = Just 20, fmtChar = 'd'}
  toWord8 = dropDown
  {-# INLINE toWord8 #-}
  fromWord8 = raiseUp
  {-# INLINE fromWord8 #-}
  toWord16 = dropDown
  {-# INLINE toWord16 #-}
  toWord32 = dropDown
  {-# INLINE toWord32 #-}
  toWord64 = id
  {-# INLINE toWord64 #-}
  toFloat = squashTo1
  {-# INLINE toFloat #-}
  toDouble = squashTo1
  {-# INLINE toDouble #-}
  fromDouble = double2Word64
  {-# INLINE fromDouble #-}
  toRealFloat = squashTo1
  {-# INLINE toRealFloat #-}
  fromRealFloat = toWord64
  {-# INLINE fromRealFloat #-}
  (//) = div
  {-# INLINE (//) #-}

-- | Values between @[0, 18446744073709551615]@ on 64bit
instance Elevator Word where
  maxValue = maxBound
  minValue = minBound
#if WORD_SIZE_IN_BITS < 64
  fieldFormat _ = defFieldFormat { fmtWidth = Just 10, fmtChar = 'd'}
  toWord64 = dropDown
  {-# INLINE toWord64 #-}
  fromDouble = stretch
  {-# INLINE fromDouble #-}
#else
  fieldFormat _ = defFieldFormat { fmtWidth = Just 20, fmtChar = 'd'}
  toWord64 (W64# w#) = (W# w#)
  {-# INLINE toWord64 #-}
  fromDouble = toWord64 . double2Word64
  {-# INLINE fromDouble #-}
#endif
  toWord8 = dropDown
  {-# INLINE toWord8 #-}
  fromWord8 = raiseUp
  {-# INLINE fromWord8 #-}
  toWord16 = dropDown
  {-# INLINE toWord16 #-}
  toWord32 = dropDown
  {-# INLINE toWord32 #-}
  toFloat = squashTo1
  {-# INLINE toFloat #-}
  toDouble = squashTo1
  {-# INLINE toDouble #-}
  toRealFloat = squashTo1
  {-# INLINE toRealFloat #-}
  fromRealFloat = stretch
  {-# INLINE fromRealFloat #-}
  (//) = div
  {-# INLINE (//) #-}

-- | Values between @[0, 127]@
instance Elevator Int8 where
  maxValue = maxBound
  minValue = 0
  fieldFormat _ = defFieldFormat { fmtWidth = Just 3, fmtChar = 'd'}
  toWord8 = raiseUp . max 0
  {-# INLINE toWord8 #-}
  fromWord8 = dropDown
  {-# INLINE fromWord8 #-}
  toWord16 = raiseUp . max 0
  {-# INLINE toWord16 #-}
  toWord32 = raiseUp . max 0
  {-# INLINE toWord32 #-}
  toWord64 = raiseUp . max 0
  {-# INLINE toWord64 #-}
  toFloat = squashTo1 . max 0
  {-# INLINE toFloat #-}
  toRealFloat = squashTo1 . max 0
  {-# INLINE toRealFloat #-}
  fromRealFloat = stretch
  {-# INLINE fromRealFloat #-}
  (//) = div
  {-# INLINE (//) #-}


-- | Values between @[0, 32767]@
instance Elevator Int16 where
  maxValue = maxBound
  minValue = 0
  fieldFormat _ = defFieldFormat { fmtWidth = Just 5, fmtChar = 'd'}
  toWord8 = dropDown . max 0
  {-# INLINE toWord8 #-}
  fromWord8 = raiseUp
  {-# INLINE fromWord8 #-}
  toWord16 = raiseUp . max 0
  {-# INLINE toWord16 #-}
  toWord32 = raiseUp . max 0
  {-# INLINE toWord32 #-}
  toWord64 = raiseUp . max 0
  {-# INLINE toWord64 #-}
  toFloat = squashTo1 . max 0
  {-# INLINE toFloat #-}
  toRealFloat = squashTo1 . max 0
  {-# INLINE toRealFloat #-}
  fromRealFloat = stretch
  {-# INLINE fromRealFloat #-}
  (//) = div
  {-# INLINE (//) #-}


-- | Values between @[0, 2147483647]@
instance Elevator Int32 where
  maxValue = maxBound
  minValue = 0
  fieldFormat _ = defFieldFormat { fmtWidth = Just 10, fmtChar = 'd'}
  toWord8 = dropDown . max 0
  {-# INLINE toWord8 #-}
  fromWord8 = raiseUp
  {-# INLINE fromWord8 #-}
  toWord16 = dropDown . max 0
  {-# INLINE toWord16 #-}
  toWord32 = raiseUp . max 0
  {-# INLINE toWord32 #-}
  toWord64 = raiseUp . max 0
  {-# INLINE toWord64 #-}
  toFloat = squashTo1 . max 0
  {-# INLINE toFloat #-}
  toRealFloat = squashTo1 . max 0
  {-# INLINE toRealFloat #-}
  fromRealFloat = stretch
  {-# INLINE fromRealFloat #-}
  (//) = div
  {-# INLINE (//) #-}


-- | Values between @[0, 9223372036854775807]@
instance Elevator Int64 where
  maxValue = maxBound
  minValue = 0
  fieldFormat _ = defFieldFormat { fmtWidth = Just 19, fmtChar = 'd'}
  toWord8 = dropDown . max 0
  {-# INLINE toWord8 #-}
  fromWord8 = raiseUp
  {-# INLINE fromWord8 #-}
  toWord16 = dropDown . max 0
  {-# INLINE toWord16 #-}
  toWord32 = dropDown . max 0
  {-# INLINE toWord32 #-}
  toWord64 = raiseUp . max 0
  {-# INLINE toWord64 #-}
  toFloat = squashTo1 . max 0
  {-# INLINE toFloat #-}
  toRealFloat = squashTo1 . max 0
  {-# INLINE toRealFloat #-}
  fromRealFloat = stretch
  {-# INLINE fromRealFloat #-}
  (//) = div
  {-# INLINE (//) #-}


-- | Values between @[0, 9223372036854775807]@ on 64bit
instance Elevator Int where
  maxValue = maxBound
  minValue = 0
#if WORD_SIZE_IN_BITS < 64
  fieldFormat _ = defFieldFormat { fmtWidth = Just 10, fmtChar = 'd'}
  toWord64 = dropDown . max 0
  {-# INLINE toWord64 #-}
#else
  fieldFormat _ = defFieldFormat { fmtWidth = Just 19, fmtChar = 'd'}
  toWord64 = raiseUp . max 0
  {-# INLINE toWord64 #-}
#endif
  toWord8 = dropDown . max 0
  {-# INLINE toWord8 #-}
  fromWord8 = raiseUp
  {-# INLINE fromWord8 #-}
  toWord16 = dropDown . max 0
  {-# INLINE toWord16 #-}
  toWord32 = dropDown . max 0
  {-# INLINE toWord32 #-}
  toFloat = squashTo1 . max 0
  {-# INLINE toFloat #-}
  toRealFloat = squashTo1 . max 0
  {-# INLINE toRealFloat #-}
  fromRealFloat = stretch
  {-# INLINE fromRealFloat #-}
  (//) = div
  {-# INLINE (//) #-}


-- | Values between @[0.0, 1.0]@
instance Elevator Float where
  maxValue = 1
  minValue = 0
  fieldFormat _ = defFieldFormat { fmtWidth = Just 11, fmtPrecision = Just 8, fmtChar = 'f'}
  toWord8 = stretch
  {-# INLINE toWord8 #-}
  fromWord8 = squashTo1
  {-# INLINE fromWord8 #-}
  toWord16 = stretch
  {-# INLINE toWord16 #-}
  toWord32 = float2Word32
  {-# INLINE toWord32 #-}
  toWord64 = stretch
  {-# INLINE toWord64 #-}
  toFloat = id
  {-# INLINE toFloat #-}
  toDouble = float2Double
  {-# INLINE toDouble #-}
  fromDouble = toFloat
  {-# INLINE fromDouble #-}
  toRealFloat = uncurry encodeFloat . decodeFloat
  {-# INLINE toRealFloat #-}
  fromRealFloat = uncurry encodeFloat . decodeFloat
  {-# INLINE fromRealFloat #-}
  (//) = (/)
  {-# INLINE (//) #-}


-- | Values between @[0.0, 1.0]@
instance Elevator Double where
  maxValue = 1
  minValue = 0
  fieldFormat _ = defFieldFormat { fmtWidth = Just 19, fmtPrecision = Just 16, fmtChar = 'f' }
  toWord8 = stretch
  {-# INLINE toWord8 #-}
  fromWord8 = squashTo1
  {-# INLINE fromWord8 #-}
  toWord16 = stretch
  {-# INLINE toWord16 #-}
  toWord32 = stretch
  {-# INLINE toWord32 #-}
  toWord64 = double2Word64
  {-# INLINE toWord64 #-}
  toFloat = double2Float
  {-# INLINE toFloat #-}
  toDouble = id
  {-# INLINE toDouble #-}
  fromDouble = id
  {-# INLINE fromDouble #-}
  toRealFloat = uncurry encodeFloat . decodeFloat
  {-# INLINE toRealFloat #-}
  fromRealFloat = uncurry encodeFloat . decodeFloat
  {-# INLINE fromRealFloat #-}
  (//) = (/)
  {-# INLINE (//) #-}

{-# RULES
"toRealFloat   :: Double -> Double / Float -> Float" toRealFloat = id
"toRealFloat   :: Double -> Float"                   toRealFloat = double2Float
"toRealFloat   :: Float -> Double"                   toRealFloat = float2Double
"fromRealFloat :: Double -> Double / Float -> Float" fromRealFloat = id
"fromRealFloat :: Double -> Float"                   fromRealFloat = double2Float
"fromRealFloat :: Float -> Double"                   fromRealFloat = float2Double
 #-}



-- | Discards imaginary part and changes precision of real part.
instance (PrintfArg e, Elevator e, RealFloat e) => Elevator (Complex e) where
  maxValue = maxValue :+ maxValue
  minValue = minValue :+ minValue
  toShowS (r :+ i) = toShowS r . formatArg i ((fieldFormat i) {fmtSign = Just SignPlus}) . ('i' :)
  toWord8 = toWord8 . realPart
  {-# INLINE toWord8 #-}
  fromWord8 = (:+ 0) . fromWord8
  {-# INLINE fromWord8 #-}
  toWord16 = toWord16 . realPart
  {-# INLINE toWord16 #-}
  toWord32 = toWord32 . realPart
  {-# INLINE toWord32 #-}
  toWord64 = toWord64 . realPart
  {-# INLINE toWord64 #-}
  toFloat = toFloat . realPart
  {-# INLINE toFloat #-}
  toDouble = toDouble . realPart
  {-# INLINE toDouble #-}
  fromDouble = (:+ 0) . fromDouble
  {-# INLINE fromDouble #-}
  toRealFloat = toRealFloat . realPart
  {-# INLINE toRealFloat #-}
  fromRealFloat = (:+ 0) . fromRealFloat
  {-# INLINE fromRealFloat #-}
  (//) = (/)
  {-# INLINE (//) #-}

1	{-# LANGUAGE BangPatterns #-}
2	{-# LANGUAGE CPP #-}
3	{-# LANGUAGE DefaultSignatures #-}
4	{-# LANGUAGE MagicHash #-}
5	{-# LANGUAGE ScopedTypeVariables #-}
6	-- \|
7	-- Module : Graphics.Color.Algebra.Elevator
8	-- Copyright : (c) Alexey Kuleshevich 2018-2025
9	-- License : BSD3
10	-- Maintainer : Alexey Kuleshevich <lehins@yandex.ru>
11	-- Stability : experimental
12	-- Portability : non-portable
13	--
14	module Graphics.Color.Algebra.Elevator
15	( Elevator(..)
16	, module Data.Word
17	, clamp01
18	) where
19
20	import Data.Complex
21	import Data.Int
22	import Data.Typeable
23	import Data.Vector.Storable (Storable)
24	import Data.Vector.Unboxed (Unbox)
25	import Data.Word
26	import GHC.Float
27	import Text.Printf
28
29	infixl 7 //
30
31	defFieldFormat :: FieldFormat
32	defFieldFormat = FieldFormat Nothing Nothing Nothing Nothing False "" 'v'	1✔
33
34	-- \| A class with a set of functions that allow for changing precision by shrinking and
35	-- streatching the values.
36	class (Show e, Eq e, Num e, Typeable e, Unbox e, Storable e) => Elevator e where
37	maxValue :: e
38
39	minValue :: e
40
41	fieldFormat :: e -> FieldFormat
42	fieldFormat _ = defFieldFormat	×
43
44	-- \| This is a pretty printer for the value.
45	toShowS :: e -> ShowS
46	default toShowS :: PrintfArg e => e -> ShowS
47	toShowS e = formatArg e (fieldFormat e)	1✔
48
49	-- \| Values are scaled to @[0, 255]@ range.
50	toWord8 :: e -> Word8
51
52	-- \| Values are scaled from @[0, 255]@ range to @[minValue, maxValue]@.
53	fromWord8 :: Word8 -> e
54
55	-- \| Values are scaled to @[0, 65535]@ range.
56	toWord16 :: e -> Word16
57
58	-- \| Values are scaled to @[0, 4294967295]@ range.
59	toWord32 :: e -> Word32
60
61	-- \| Values are scaled to @[0, 18446744073709551615]@ range.
62	toWord64 :: e -> Word64
63
64	-- \| Values are scaled to @[0.0, 1.0]@ range.
65	toRealFloat :: (Elevator a, RealFloat a) => e -> a
66
67	-- \| Values are scaled from @[0.0, 1.0]@ range.
68	fromRealFloat :: (Elevator a, RealFloat a) => a -> e
69
70	-- \| Values are scaled to @[0.0, 1.0]@ range.
71	toFloat :: e -> Float
72	toFloat = toRealFloat	×
73
74	-- \| Values are scaled to @[0.0, 1.0]@ range.
75	toDouble :: e -> Double
76	toDouble = toRealFloat	2✔
77
78	-- \| Values are scaled from @[0.0, 1.0]@ range.
79	fromDouble :: Double -> e
80	fromDouble = fromRealFloat	2✔
81
82	-- \| Division that works for integral types as well as floating points. May throw an exception.
83	(//) :: e -> e -> e
84
85
86	-- \| Lower the precision
87	dropDown :: forall a b. (Integral a, Bounded a, Integral b, Bounded b) => a -> b
88	dropDown !e = fromIntegral $ fromIntegral e `div` ((maxBound :: a) `div`	2✔
89	fromIntegral (maxBound :: b))	2✔
90	{-# INLINE dropDown #-}
91
92	-- \| Increase the precision
93	raiseUp :: forall a b. (Integral a, Bounded a, Integral b, Bounded b) => a -> b
94	raiseUp !e = fromIntegral e * ((maxBound :: b) `div` fromIntegral (maxBound :: a))	2✔
95	{-# INLINE raiseUp #-}
96
97	-- \| Convert to fractional with value less than or equal to 1.
98	squashTo1 :: forall a b. (Fractional b, Integral a, Bounded a) => a -> b
99	squashTo1 !e = fromIntegral e / fromIntegral (maxBound :: a)	2✔
100	{-# INLINE squashTo1 #-}
101
102	-- \| Convert to integral streaching it's value up to a maximum value.
103	stretch :: forall a b. (RealFloat a, Integral b, Bounded b) => a -> b
104	stretch !e = round (fromIntegral (maxBound :: b) * clamp01 e)	2✔
105	{-# INLINE stretch #-}
106
107	-- \| Clamp a value to @[0, 1]@ range.
108	clamp01 :: RealFloat a => a -> a
109	clamp01 !x = min (max 0 x) 1	2✔
110	{-# INLINE clamp01 #-}
111
112
113	float2Word32 :: Float -> Word32
114	float2Word32 d'	2✔
115	\| d' <= 0 = 0	2✔
116	\| d > 4.294967e9 = maxBound	2✔
117	\| otherwise = round d	1✔
118	where
119	d = maxWord32 * d'	2✔
120	{-# INLINE float2Word32 #-}
121
122	-- \| Same as:
123	-- >>> fromIntegral (maxBound :: Word32) :: Float
124	-- 4.2949673e9
125	--
126	maxWord32 :: Float
127	maxWord32 = F# 4.2949673e9#	2✔
128	{-# INLINE maxWord32 #-}
129
130	double2Word64 :: Double -> Word64
131	double2Word64 d'	2✔
132	\| d' <= 0 = 0	2✔
133	\| d > 1.844674407370955e19 = maxBound	2✔
134	\| otherwise = round d	1✔
135	where
136	d = maxWord64 * d'	2✔
137	{-# INLINE double2Word64 #-}
138
139	-- \| Differs from `fromIntegral` due to: [GHC #17782](https://gitlab.haskell.org/ghc/ghc/issues/17782)
140	--
141	-- This is the value for ghc < 9.2
142	--
143	-- > fromIntegral (maxBound :: Word64) :: Double
144	-- 1.844674407370955e19
145	--
146	maxWord64 :: Double
147	maxWord64 = D# 1.8446744073709552e19##	2✔
148	{-# INLINE maxWord64 #-}
149
150	{-# RULES
151	"fromRealFloat :: Double -> Word" fromRealFloat = fromDouble :: Double -> Word
152	"fromRealFloat :: Double -> Word64" fromRealFloat = fromDouble :: Double -> Word64
153	"fromRealFloat :: Float -> Word32" fromRealFloat = float2Word32
154	#-}
155
156
157	-- \| Values between @[0, 255]]@
158	instance Elevator Word8 where	2✔
159	maxValue = maxBound	2✔
160	minValue = minBound	2✔
161	fieldFormat _ = defFieldFormat {fmtWidth = Just 3, fmtChar = 'd'}	2✔
162	toWord8 = id	2✔
163	{-# INLINE toWord8 #-}
164	fromWord8 = id	2✔
165	{-# INLINE fromWord8 #-}
166	toWord16 = raiseUp	2✔
167	{-# INLINE toWord16 #-}
168	toWord32 = raiseUp	2✔
169	{-# INLINE toWord32 #-}
170	toWord64 = raiseUp	2✔
171	{-# INLINE toWord64 #-}
172	toFloat = squashTo1	2✔
173	{-# INLINE toFloat #-}
174	toDouble = squashTo1	2✔
175	{-# INLINE toDouble #-}
176	fromDouble = toWord8	2✔
177	{-# INLINE fromDouble #-}
178	toRealFloat = squashTo1	2✔
179	{-# INLINE toRealFloat #-}
180	fromRealFloat = toWord8	2✔
181	{-# INLINE fromRealFloat #-}
182	(//) = div	×
183	{-# INLINE (//) #-}
184
185
186	-- \| Values between @[0, 65535]]@
187	instance Elevator Word16 where	2✔
188	maxValue = maxBound	2✔
189	minValue = minBound	2✔
190	fieldFormat _ = defFieldFormat { fmtWidth = Just 5, fmtChar = 'd'}	2✔
191	toWord8 = dropDown	2✔
192	{-# INLINE toWord8 #-}
193	fromWord8 = raiseUp	2✔
194	{-# INLINE fromWord8 #-}
195	toWord16 = id	2✔
196	{-# INLINE toWord16 #-}
197	toWord32 = raiseUp	2✔
198	{-# INLINE toWord32 #-}
199	toWord64 = raiseUp	2✔
200	{-# INLINE toWord64 #-}
201	toFloat = squashTo1	2✔
202	{-# INLINE toFloat #-}
203	toDouble = squashTo1	2✔
204	{-# INLINE toDouble #-}
205	fromDouble = toWord16	2✔
206	{-# INLINE fromDouble #-}
207	toRealFloat = squashTo1	2✔
208	{-# INLINE toRealFloat #-}
209	fromRealFloat = toWord16	2✔
210	{-# INLINE fromRealFloat #-}
211	(//) = div	×
212	{-# INLINE (//) #-}
213
214
215	-- \| Values between @[0, 4294967295]@
216	instance Elevator Word32 where	2✔
217	maxValue = maxBound	2✔
218	minValue = minBound	2✔
219	fieldFormat _ = defFieldFormat { fmtWidth = Just 10, fmtChar = 'd'}	2✔
220	toWord8 = dropDown	2✔
221	{-# INLINE toWord8 #-}
222	fromWord8 = raiseUp	2✔
223	{-# INLINE fromWord8 #-}
224	toWord16 = dropDown	2✔
225	{-# INLINE toWord16 #-}
226	toWord32 = id	2✔
227	{-# INLINE toWord32 #-}
228	toWord64 = raiseUp	2✔
229	{-# INLINE toWord64 #-}
230	toFloat = squashTo1	2✔
231	{-# INLINE toFloat #-}
232	toDouble = squashTo1	2✔
233	{-# INLINE toDouble #-}
234	fromDouble = toWord32	2✔
235	{-# INLINE fromDouble #-}
236	toRealFloat = squashTo1	2✔
237	{-# INLINE toRealFloat #-}
238	fromRealFloat = toWord32	2✔
239	{-# INLINE fromRealFloat #-}
240	(//) = div	×
241	{-# INLINE (//) #-}
242
243
244	-- \| Values between @[0, 18446744073709551615]@
245	instance Elevator Word64 where	2✔
246	maxValue = maxBound	2✔
247	minValue = minBound	2✔
248	fieldFormat _ = defFieldFormat { fmtWidth = Just 20, fmtChar = 'd'}	2✔
249	toWord8 = dropDown	2✔
250	{-# INLINE toWord8 #-}
251	fromWord8 = raiseUp	2✔
252	{-# INLINE fromWord8 #-}
253	toWord16 = dropDown	2✔
254	{-# INLINE toWord16 #-}
255	toWord32 = dropDown	2✔
256	{-# INLINE toWord32 #-}
257	toWord64 = id	2✔
258	{-# INLINE toWord64 #-}
259	toFloat = squashTo1	2✔
260	{-# INLINE toFloat #-}
261	toDouble = squashTo1	2✔
262	{-# INLINE toDouble #-}
263	fromDouble = double2Word64	2✔
264	{-# INLINE fromDouble #-}
265	toRealFloat = squashTo1	2✔
266	{-# INLINE toRealFloat #-}
267	fromRealFloat = toWord64	2✔
268	{-# INLINE fromRealFloat #-}
269	(//) = div	×
270	{-# INLINE (//) #-}
271
272	-- \| Values between @[0, 18446744073709551615]@ on 64bit
273	instance Elevator Word where	2✔
274	maxValue = maxBound	2✔
275	minValue = minBound	2✔
276	#if WORD_SIZE_IN_BITS < 64
277	fieldFormat _ = defFieldFormat { fmtWidth = Just 10, fmtChar = 'd'}	2✔
278	toWord64 = dropDown	2✔
279	{-# INLINE toWord64 #-}
280	fromDouble = stretch	2✔
281	{-# INLINE fromDouble #-}
282	#else
283	fieldFormat _ = defFieldFormat { fmtWidth = Just 20, fmtChar = 'd'}
284	toWord64 (W64# w#) = (W# w#)
285	{-# INLINE toWord64 #-}
286	fromDouble = toWord64 . double2Word64
287	{-# INLINE fromDouble #-}
288	#endif
289	toWord8 = dropDown	2✔
290	{-# INLINE toWord8 #-}
291	fromWord8 = raiseUp	2✔
292	{-# INLINE fromWord8 #-}
293	toWord16 = dropDown	×
294	{-# INLINE toWord16 #-}
295	toWord32 = dropDown	×
296	{-# INLINE toWord32 #-}
297	toFloat = squashTo1	2✔
298	{-# INLINE toFloat #-}
299	toDouble = squashTo1	2✔
300	{-# INLINE toDouble #-}
301	toRealFloat = squashTo1	2✔
302	{-# INLINE toRealFloat #-}
303	fromRealFloat = stretch	2✔
304	{-# INLINE fromRealFloat #-}
305	(//) = div	×
306	{-# INLINE (//) #-}
307
308	-- \| Values between @[0, 127]@
309	instance Elevator Int8 where	2✔
310	maxValue = maxBound	2✔
311	minValue = 0	2✔
312	fieldFormat _ = defFieldFormat { fmtWidth = Just 3, fmtChar = 'd'}	2✔
313	toWord8 = raiseUp . max 0	2✔
314	{-# INLINE toWord8 #-}
315	fromWord8 = dropDown	2✔
316	{-# INLINE fromWord8 #-}
317	toWord16 = raiseUp . max 0	×
318	{-# INLINE toWord16 #-}
319	toWord32 = raiseUp . max 0	×
320	{-# INLINE toWord32 #-}
321	toWord64 = raiseUp . max 0	×
322	{-# INLINE toWord64 #-}
323	toFloat = squashTo1 . max 0	2✔
324	{-# INLINE toFloat #-}
325	toRealFloat = squashTo1 . max 0	2✔
326	{-# INLINE toRealFloat #-}
327	fromRealFloat = stretch	2✔
328	{-# INLINE fromRealFloat #-}
329	(//) = div	×
330	{-# INLINE (//) #-}
331
332
333	-- \| Values between @[0, 32767]@
334	instance Elevator Int16 where	2✔
335	maxValue = maxBound	2✔
336	minValue = 0	2✔
337	fieldFormat _ = defFieldFormat { fmtWidth = Just 5, fmtChar = 'd'}	2✔
338	toWord8 = dropDown . max 0	2✔
339	{-# INLINE toWord8 #-}
340	fromWord8 = raiseUp	2✔
341	{-# INLINE fromWord8 #-}
342	toWord16 = raiseUp . max 0	×
343	{-# INLINE toWord16 #-}
344	toWord32 = raiseUp . max 0	×
345	{-# INLINE toWord32 #-}
346	toWord64 = raiseUp . max 0	×
347	{-# INLINE toWord64 #-}
348	toFloat = squashTo1 . max 0	2✔
349	{-# INLINE toFloat #-}
350	toRealFloat = squashTo1 . max 0	2✔
351	{-# INLINE toRealFloat #-}
352	fromRealFloat = stretch	2✔
353	{-# INLINE fromRealFloat #-}
354	(//) = div	×
355	{-# INLINE (//) #-}
356
357
358	-- \| Values between @[0, 2147483647]@
359	instance Elevator Int32 where	2✔
360	maxValue = maxBound	2✔
361	minValue = 0	2✔
362	fieldFormat _ = defFieldFormat { fmtWidth = Just 10, fmtChar = 'd'}	2✔
363	toWord8 = dropDown . max 0	2✔
364	{-# INLINE toWord8 #-}
365	fromWord8 = raiseUp	2✔
366	{-# INLINE fromWord8 #-}
367	toWord16 = dropDown . max 0	×
368	{-# INLINE toWord16 #-}
369	toWord32 = raiseUp . max 0	×
370	{-# INLINE toWord32 #-}
371	toWord64 = raiseUp . max 0	×
372	{-# INLINE toWord64 #-}
373	toFloat = squashTo1 . max 0	2✔
374	{-# INLINE toFloat #-}
375	toRealFloat = squashTo1 . max 0	2✔
376	{-# INLINE toRealFloat #-}
377	fromRealFloat = stretch	2✔
378	{-# INLINE fromRealFloat #-}
379	(//) = div	×
380	{-# INLINE (//) #-}
381
382
383	-- \| Values between @[0, 9223372036854775807]@
384	instance Elevator Int64 where	2✔
385	maxValue = maxBound	2✔
386	minValue = 0	2✔
387	fieldFormat _ = defFieldFormat { fmtWidth = Just 19, fmtChar = 'd'}	2✔
388	toWord8 = dropDown . max 0	2✔
389	{-# INLINE toWord8 #-}
390	fromWord8 = raiseUp	2✔
391	{-# INLINE fromWord8 #-}
392	toWord16 = dropDown . max 0	×
393	{-# INLINE toWord16 #-}
394	toWord32 = dropDown . max 0	×
395	{-# INLINE toWord32 #-}
396	toWord64 = raiseUp . max 0	×
397	{-# INLINE toWord64 #-}
398	toFloat = squashTo1 . max 0	2✔
399	{-# INLINE toFloat #-}
400	toRealFloat = squashTo1 . max 0	2✔
401	{-# INLINE toRealFloat #-}
402	fromRealFloat = stretch	2✔
403	{-# INLINE fromRealFloat #-}
404	(//) = div	×
405	{-# INLINE (//) #-}
406
407
408	-- \| Values between @[0, 9223372036854775807]@ on 64bit
409	instance Elevator Int where	2✔
410	maxValue = maxBound	2✔
411	minValue = 0	2✔
412	#if WORD_SIZE_IN_BITS < 64
413	fieldFormat _ = defFieldFormat { fmtWidth = Just 10, fmtChar = 'd'}	2✔
414	toWord64 = dropDown . max 0	×
415	{-# INLINE toWord64 #-}
416	#else
417	fieldFormat _ = defFieldFormat { fmtWidth = Just 19, fmtChar = 'd'}
418	toWord64 = raiseUp . max 0
419	{-# INLINE toWord64 #-}
420	#endif
421	toWord8 = dropDown . max 0	2✔
422	{-# INLINE toWord8 #-}
423	fromWord8 = raiseUp	2✔
424	{-# INLINE fromWord8 #-}
425	toWord16 = dropDown . max 0	×
426	{-# INLINE toWord16 #-}
427	toWord32 = dropDown . max 0	×
428	{-# INLINE toWord32 #-}
429	toFloat = squashTo1 . max 0	2✔
430	{-# INLINE toFloat #-}
431	toRealFloat = squashTo1 . max 0	2✔
432	{-# INLINE toRealFloat #-}
433	fromRealFloat = stretch	2✔
434	{-# INLINE fromRealFloat #-}
435	(//) = div	×
436	{-# INLINE (//) #-}
437
438
439	-- \| Values between @[0.0, 1.0]@
440	instance Elevator Float where	×
441	maxValue = 1	2✔
442	minValue = 0	2✔
443	fieldFormat _ = defFieldFormat { fmtWidth = Just 11, fmtPrecision = Just 8, fmtChar = 'f'}	×
444	toWord8 = stretch	2✔
445	{-# INLINE toWord8 #-}
446	fromWord8 = squashTo1	2✔
447	{-# INLINE fromWord8 #-}
448	toWord16 = stretch	2✔
449	{-# INLINE toWord16 #-}
450	toWord32 = float2Word32	2✔
451	{-# INLINE toWord32 #-}
452	toWord64 = stretch	2✔
453	{-# INLINE toWord64 #-}
454	toFloat = id	2✔
455	{-# INLINE toFloat #-}
456	toDouble = float2Double	2✔
457	{-# INLINE toDouble #-}
458	fromDouble = toFloat	2✔
459	{-# INLINE fromDouble #-}
460	toRealFloat = uncurry encodeFloat . decodeFloat	2✔
461	{-# INLINE toRealFloat #-}
462	fromRealFloat = uncurry encodeFloat . decodeFloat	2✔
463	{-# INLINE fromRealFloat #-}
464	(//) = (/)	×
465	{-# INLINE (//) #-}
466
467
468	-- \| Values between @[0.0, 1.0]@
469	instance Elevator Double where	×
470	maxValue = 1	2✔
471	minValue = 0	2✔
472	fieldFormat _ = defFieldFormat { fmtWidth = Just 19, fmtPrecision = Just 16, fmtChar = 'f' }	×
473	toWord8 = stretch	2✔
474	{-# INLINE toWord8 #-}
475	fromWord8 = squashTo1	2✔
476	{-# INLINE fromWord8 #-}
477	toWord16 = stretch	2✔
478	{-# INLINE toWord16 #-}
479	toWord32 = stretch	2✔
480	{-# INLINE toWord32 #-}
481	toWord64 = double2Word64	2✔
482	{-# INLINE toWord64 #-}
483	toFloat = double2Float	2✔
484	{-# INLINE toFloat #-}
485	toDouble = id	2✔
486	{-# INLINE toDouble #-}
487	fromDouble = id	2✔
488	{-# INLINE fromDouble #-}
489	toRealFloat = uncurry encodeFloat . decodeFloat	2✔
490	{-# INLINE toRealFloat #-}
491	fromRealFloat = uncurry encodeFloat . decodeFloat	2✔
492	{-# INLINE fromRealFloat #-}
493	(//) = (/)	×
494	{-# INLINE (//) #-}
495
496	{-# RULES
497	"toRealFloat :: Double -> Double / Float -> Float" toRealFloat = id
498	"toRealFloat :: Double -> Float" toRealFloat = double2Float
499	"toRealFloat :: Float -> Double" toRealFloat = float2Double
500	"fromRealFloat :: Double -> Double / Float -> Float" fromRealFloat = id
501	"fromRealFloat :: Double -> Float" fromRealFloat = double2Float
502	"fromRealFloat :: Float -> Double" fromRealFloat = float2Double
503	#-}
504
505
506
507	-- \| Discards imaginary part and changes precision of real part.
508	instance (PrintfArg e, Elevator e, RealFloat e) => Elevator (Complex e) where	×
509	maxValue = maxValue :+ maxValue	×
510	minValue = minValue :+ minValue	×
511	toShowS (r :+ i) = toShowS r . formatArg i ((fieldFormat i) {fmtSign = Just SignPlus}) . ('i' :)	×
512	toWord8 = toWord8 . realPart	×
513	{-# INLINE toWord8 #-}
514	fromWord8 = (:+ 0) . fromWord8	×
515	{-# INLINE fromWord8 #-}
516	toWord16 = toWord16 . realPart	×
517	{-# INLINE toWord16 #-}
518	toWord32 = toWord32 . realPart	×
519	{-# INLINE toWord32 #-}
520	toWord64 = toWord64 . realPart	×
521	{-# INLINE toWord64 #-}
522	toFloat = toFloat . realPart	×
523	{-# INLINE toFloat #-}
524	toDouble = toDouble . realPart	×
525	{-# INLINE toDouble #-}
526	fromDouble = (:+ 0) . fromDouble	×
527	{-# INLINE fromDouble #-}
528	toRealFloat = toRealFloat . realPart	×
529	{-# INLINE toRealFloat #-}
530	fromRealFloat = (:+ 0) . fromRealFloat	×
531	{-# INLINE fromRealFloat #-}
532	(//) = (/)	×
533	{-# INLINE (//) #-}

lehins / Color / 6

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous