lehins / Color / 179

Committed 14 Jan 2025 06:40AM UTC coverage: 71.106%. Remained the same

Build # 179

Build Type

push

github

Committed by

web-flow

Commit Message

Merge pull request #18 from lehins/fix-coveralls

Make casing consistent and ensure coveralls are uploaded

Run Details

2050 of 2883 relevant lines covered (71.11%)

1.37 hits per line

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

26.92

/Color/src/Graphics/Color/Model/X.hs

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
-- |
-- Module      : Graphics.Color.Model.X
-- Copyright   : (c) Alexey Kuleshevich 2018-2025
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
-- Stability   : experimental
-- Portability : non-portable
--
module Graphics.Color.Model.X
  ( X
  -- * Constructors for X color model.
  , pattern ColorX
  , pattern ColorXA
  , Color(X)
  , Weights(..)
  , rgb2y
  ) where

import Data.List.NonEmpty
import Data.Coerce
import Foreign.Storable
import Graphics.Color.Model.Internal
import Graphics.Color.Model.RGB

-------------
--- X ---
-------------

-- | A color with a single channel, most likely luminance
data X

-- | A single channel color `X`
newtype instance Color X e = X e

-- | Constructor for @X@
pattern ColorX :: e -> Color X e
pattern ColorX y = X y
{-# COMPLETE ColorX #-}

-- | Constructor for @X@ with alpha channel.
pattern ColorXA :: e -> e -> Color (Alpha X) e
pattern ColorXA y a = Alpha (X y) a
{-# COMPLETE ColorXA #-}

-- | `X` color model
deriving instance Eq e => Eq (Color X e)
-- | `X` color model
deriving instance Ord e => Ord (Color X e)
-- | `X` color model
deriving instance Storable e => Storable (Color X e)


-- | `X` color model
instance Elevator e => Show (Color X e) where
  showsPrec _ = showsColorModel

-- | `X` color model
instance Elevator e => ColorModel X e where
  type Components X e = e
  type ChannelCount X = 1
  channelCount _ = 1
  {-# INLINE channelCount #-}
  channelNames _ = "Gray" :| []
  channelColors _ = V3 0x80 0x80 0x80 :| []
  toComponents (X y) = y
  {-# INLINE toComponents #-}
  fromComponents = X
  {-# INLINE fromComponents #-}

-- | `X` color model
instance Functor (Color X) where
  fmap f (X y) = X (f y)
  {-# INLINE fmap #-}

-- | `X` color model
instance Applicative (Color X) where
  pure = X
  {-# INLINE pure #-}
  (X fy) <*> (X y) = X (fy y)
  {-# INLINE (<*>) #-}

-- | `X` color model
instance Foldable (Color X) where
  foldr f !z (X y) = f y z
  {-# INLINE foldr #-}

-- | `X` color model
instance Traversable (Color X) where
  traverse f (X y) = X <$> f y
  {-# INLINE traverse #-}

-- | Convert an RGB color model to a single channel by using the supplied weights
--
-- @since 0.1.0
rgb2y ::
     forall e e'. (Elevator e', Elevator e, RealFloat e)
  => Color RGB e'
  -> Weights e
  -> Color X e
rgb2y rgb weights =
  X (coerce (fmap toRealFloat rgb :: Color RGB e) `dotProduct` coerce weights)
{-# INLINE rgb2y #-}

-- | Weights imposed on individual channels of a 3-component color
--
-- @since 0.1.0
newtype Weights e = Weights
  { unWeights :: V3 e
  } deriving (Eq, Num, Show, Fractional, Floating, Functor)

1	{-# LANGUAGE BangPatterns #-}
2	{-# LANGUAGE DataKinds #-}
3	{-# LANGUAGE FlexibleContexts #-}
4	{-# LANGUAGE FlexibleInstances #-}
5	{-# LANGUAGE GeneralizedNewtypeDeriving #-}
6	{-# LANGUAGE MultiParamTypeClasses #-}
7	{-# LANGUAGE PatternSynonyms #-}
8	{-# LANGUAGE ScopedTypeVariables #-}
9	{-# LANGUAGE StandaloneDeriving #-}
10	{-# LANGUAGE TypeFamilies #-}
11	-- \|
12	-- Module : Graphics.Color.Model.X
13	-- Copyright : (c) Alexey Kuleshevich 2018-2025
14	-- License : BSD3
15	-- Maintainer : Alexey Kuleshevich <lehins@yandex.ru>
16	-- Stability : experimental
17	-- Portability : non-portable
18	--
19	module Graphics.Color.Model.X
20	( X
21	-- * Constructors for X color model.
22	, pattern ColorX
23	, pattern ColorXA
24	, Color(X)
25	, Weights(..)
26	, rgb2y
27	) where
28
29	import Data.List.NonEmpty
30	import Data.Coerce
31	import Foreign.Storable
32	import Graphics.Color.Model.Internal
33	import Graphics.Color.Model.RGB
34
35	-------------
36	--- X ---
37	-------------
38
39	-- \| A color with a single channel, most likely luminance
40	data X
41
42	-- \| A single channel color `X`
43	newtype instance Color X e = X e
44
45	-- \| Constructor for @X@
46	pattern ColorX :: e -> Color X e
47	pattern ColorX y = X y	2✔
48	{-# COMPLETE ColorX #-}
49
50	-- \| Constructor for @X@ with alpha channel.
51	pattern ColorXA :: e -> e -> Color (Alpha X) e
52	pattern ColorXA y a = Alpha (X y) a	×
53	{-# COMPLETE ColorXA #-}
54
55	-- \| `X` color model
56	deriving instance Eq e => Eq (Color X e)	×
57	-- \| `X` color model
58	deriving instance Ord e => Ord (Color X e)	×
59	-- \| `X` color model
60	deriving instance Storable e => Storable (Color X e)	×
61
62
63	-- \| `X` color model
64	instance Elevator e => Show (Color X e) where	×
65	showsPrec _ = showsColorModel	×
66
67	-- \| `X` color model
68	instance Elevator e => ColorModel X e where	×
69	type Components X e = e
70	type ChannelCount X = 1
71	channelCount _ = 1	×
72	{-# INLINE channelCount #-}
73	channelNames _ = "Gray" :\| []	×
74	channelColors _ = V3 0x80 0x80 0x80 :\| []	×
75	toComponents (X y) = y	2✔
76	{-# INLINE toComponents #-}
77	fromComponents = X	2✔
78	{-# INLINE fromComponents #-}
79
80	-- \| `X` color model
81	instance Functor (Color X) where	×
82	fmap f (X y) = X (f y)	2✔
83	{-# INLINE fmap #-}
84
85	-- \| `X` color model
86	instance Applicative (Color X) where	×
87	pure = X	×
88	{-# INLINE pure #-}
89	(X fy) <*> (X y) = X (fy y)	×
90	{-# INLINE (<*>) #-}
91
92	-- \| `X` color model
93	instance Foldable (Color X) where	×
94	foldr f !z (X y) = f y z	1✔
95	{-# INLINE foldr #-}
96
97	-- \| `X` color model
98	instance Traversable (Color X) where	×
99	traverse f (X y) = X <$> f y	×
100	{-# INLINE traverse #-}
101
102	-- \| Convert an RGB color model to a single channel by using the supplied weights
103	--
104	-- @since 0.1.0
105	rgb2y ::
106	forall e e'. (Elevator e', Elevator e, RealFloat e)
107	=> Color RGB e'
108	-> Weights e
109	-> Color X e
110	rgb2y rgb weights =	2✔
111	X (coerce (fmap toRealFloat rgb :: Color RGB e) `dotProduct` coerce weights)	2✔
112	{-# INLINE rgb2y #-}
113
114	-- \| Weights imposed on individual channels of a 3-component color
115	--
116	-- @since 0.1.0
117	newtype Weights e = Weights
118	{ unWeights :: V3 e	×
119	} deriving (Eq, Num, Show, Fractional, Floating, Functor)	×

lehins / Color / 179

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