gdritter repos shoes / master
Fixed some num typeclass stuff Getty Ritter 7 years ago
1 changed file(s) with 40 addition(s) and 19 deletion(s). Collapse all Expand all
66 {-# LANGUAGE OverloadedStrings #-}
77 {-# LANGUAGE MultiParamTypeClasses #-}
88 {-# LANGUAGE FunctionalDependencies #-}
9 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
910
1011 module Shoes where
1112
4647
4748 -- | Number magic
4849
49 instance (a ~ ShoesUnit, b ~ ShoesUnit) => Num ((Integer -> a) -> b) where
50 instance (Num a, Num b, a ~ b) => Num ((Integer -> a) -> b) where
5051 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
5476
5577 data ShoesUnit
56 = Pixels Int
57 | Percent Float
58 | Pt Int
78 = SUPixels Pixels
79 | SUPercent Percent
80 | SUPt Pt
5981 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
6982
7083 class ShoesNum x where
7184 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
7495 instance ShoesNum Integer where
75 toShoesUnit = Pixels . fromIntegral
96 toShoesUnit = SUPixels . Pixels . fromIntegral
7697
7798 -- | Property stuff
7899