Commit a9935c60dbea11108e689bb17d5306fe9b85ec5c - shoes

Fixed some num typeclass stuff Getty Ritter 9 years ago

1 changed file(s) with 40 addition(s) and 19 deletion(s). Collapse all Expand all

+40

-19

src/Shoes.hs less more

6	6	{-# LANGUAGE OverloadedStrings #-}
7	7	{-# LANGUAGE MultiParamTypeClasses #-}
8	8	{-# LANGUAGE FunctionalDependencies #-}
	9	{-# LANGUAGE GeneralizedNewtypeDeriving #-}
9	10
10	11	module Shoes where
11	12

46	47
47	48	-- \| Number magic
48	49
49		instance (~~a ~ ShoesUnit, b ~ ShoesUnit~~) => Num ((Integer -> a) -> b) where
	50	instance (Num a, Num b, a ~ b) => Num ((Integer -> a) -> b) where
50	51	fromInteger n f = f n
51
52		instance Num ShoesUnit where
53		~~fromInteger = Pixels . fromInteger~~
	52	(x + y) f = (x f + y f)
	53	(x - y) f = (x f - y f)
	54	(x * y) f = (x f * y f)
	55	abs x f = x (f . abs)
	56	signum x f = x (f . signum)
	57
	58	newtype Pixels = Pixels Int deriving (Eq, Show, Num)
	59	newtype Percent = Percent Float deriving (Eq, Show, Num)
	60	newtype Pt = Pt Int deriving (Eq, Show, Num)
	61
	62	-- data ShoesUnit
	63	-- = Pixels Int
	64	-- \| Percent Float
	65	-- \| Pt Int
	66	-- deriving (Eq, Show)
	67
	68	percent :: Integer -> Percent
	69	percent x = Percent (fromIntegral x * 0.01)
	70
	71	px :: Integer -> Pixels
	72	px = Pixels . fromIntegral
	73
	74	pt :: Integer -> Pt
	75	pt = Pt . fromIntegral
54	76
55	77	data ShoesUnit
56		= Pixels Int
57		\| Percent Float
58		~~\| Pt Int~~
	78	= SUPixels Pixels
	79	\| SUPercent Percent
	80	\| SUPt Pt
59	81	deriving (Eq, Show)
60
61		percent :: Integer -> ShoesUnit
62		percent x = Percent (fromIntegral x * 0.01)
63
64		px :: Integer -> ShoesUnit
65		px = Pixels . fromIntegral
66
67		pt :: Integer -> ShoesUnit
68		pt = Pt . fromIntegral
69	82
70	83	class ShoesNum x where
71	84	toShoesUnit :: x -> ShoesUnit
72		instance ShoesNum ShoesUnit where
73		toShoesUnit = id
	85
	86	instance ShoesNum Pixels where
	87	toShoesUnit = SUPixels
	88
	89	instance ShoesNum Percent where
	90	toShoesUnit = SUPercent
	91
	92	instance ShoesNum Pt where
	93	toShoesUnit = SUPt
	94
74	95	instance ShoesNum Integer where
75		toShoesUnit = Pixels . fromIntegral
	96	toShoesUnit = SUPixels . Pixels . fromIntegral
76	97
77	98	-- \| Property stuff
78	99