Hi,
I want to build a 3d graphics engine a la: but in haskell.
TL:DR; I cannot define addVecToPoint with lenses:
addVecToPoint :: Num a => Point a -> Point a -> Point a
addVecToPoint p1@(Point3D {}) = over' xLens (+ x p1) . over' yLens (+ y p1) . over' zLens (+ z p1) -- gives wrong answers
Right now I’m on this page with making Vectors.
I have Points defined like so:
import Control.Lens ( view, over, Identity(..) )
import Control.Lens.Fold
import Data.Functor.Identity
data Point a = Point2D {x :: a, y :: a}
| Point3D {x :: a, y :: a, z :: a}
deriving Show
instance Functor Point where
fmap :: (a -> b) -> Point a -> Point b
fmap f (Point2D x y) = Point2D (f x) (f y)
fmap f (Point3D x y z) = Point3D (f x) (f y) (f z)
newtype Vector a = Vector {runVector :: Point a -> Point a}
And some auxilliary functions like so:
getVec :: Num a => Point a -> Point a -> Vector a
getVec from = mkVector . addVecToPoint from . fmap negate
addVecs :: Vector a -> Vector a -> Vector a
addVecs (Vector f) (Vector g) = Vector (f . g)
origin3D = Point3D 0 0 0
I made lenses and traversals like so:
type MyLens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
type MyLens' s a = MyLens s s a a
type MyGetter s a = forall f. Functor f => (a -> f a) -> s -> f s
type MyTraversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t
type MySetter s t a b = forall f. Applicative f => (a -> f b) -> s -> f t
newtype MyConst a b = MyConst {getMyConst :: a}
instance Functor (MyConst a) where
fmap _ (MyConst a) = MyConst a
lens' :: (s -> a) -> (s -> a -> s) -> MyLens' s a
lens' getterf setterf f s = setterf s <$> f (getterf s)
view' :: MyLens' s a -> s -> a
view' l s = let fa = l MyConst s
in getMyConst fa
mySet' :: MyLens' s a -> s -> a -> s
mySet' l s val = let fa = l (const (Identity val)) s
in runIdentity fa
over' :: MyLens' s a -> (a -> a) -> s -> s
over' l f s = let fa = l (fmap f . Identity) s
in runIdentity fa
pointCoords :: MyTraversal (Point a) (Point a) a a -- Traversal for points
pointCoords g (Point2D x y) = Point2D <$> g x <*> g y
pointCoords g (Point3D x y z) = Point3D <$> g x <*> g y <*> g z
xLens, yLens, zLens :: MyGetter (Point a) a
xLens g p = (\val -> p {x = val}) <$> g (x p)
yLens g p = (\val -> p {y = val}) <$> g (y p)
zLens g p = (\val -> p {y = val}) <$> g (z p)
...
but I can’t use lenses to do it
addVecToPoint :: Num a => Point a -> Point a -> Point a
addVecToPoint p1@(Point3D {}) = over' xLens (+ x p1) . over' yLens (+ y p1) . over' zLens (+ z p1) -- gives wrong answers
because my tests return:
myTest = do
let p1 = Point3D 1 2 1
p2 = Point3D 0 4 4
v1 = mkVector $ Point3D 2 0 0
v2 = getVec p1 p2 -- Gets the vector p1 -> p2
v3 = addVecs v1 v2 -- Adds v1 to v2
shouldBe (Point3D 1 2 1) p1
shouldBe (Point3D 0 4 4) p2
shouldBe (Point3D 2 0 0) (runVector v1 origin3D)
let showV2 = runVector v2 origin3D -- views the v2 vector which is p1 -> p2
showV3 = runVector v3 origin3D -- view v3 which is v1 + v2
drawp1 = runVector v3 p1 -- applies v3 to p1
-- drawp2 = runVector (invert v2) p2 -- applies (inverse v2) to p2
zipWithM_ shouldBe
[ Point3D 2 0 0
, Point3D 3 (-2) (-3)
, Point3D 4 0 (-2)
-- , Point3D (-1) 6 7
]
[ showV2
, showV3
, drawp1
-- , drawp2 -- not working :(
]
ghci> myTest
Should be: Point3D {x = 1, y = 2, z = 1} -- and is: Point3D {x = 1, y = 2, z = 1}
Should be: Point3D {x = 0, y = 4, z = 4} -- and is: Point3D {x = 0, y = 4, z = 4}
Should be: Point3D {x = 2, y = 0, z = 0} -- and is: Point3D {x = 2, y = 0, z = 0}
Should be: Point3D {x = 1, y = -2, z = -3} -- and is: Point3D {x = 1, y = -2, z = -3}
Should be: Point3D {x = 3, y = -2, z = -3} -- and is: Point3D {x = 3, y = 0, z = 0} -- very wrong
Should be: Point3D {x = 4, y = 0, z = -2} -- and is: Point3D {x = 4, y = 1, z = 1} -- also wrong
so now I define it like:
addVecToPoint :: Num a => Point a -> Point a -> Point a
addVecToPoint p1@(Point3D {}) p2@(Point3D {}) = Point3D (x p1 + x p2) (y p1 + y p2) (z p1 + z p2)
addVecToPoint p1@(Point2D {}) p2@(Point2D {}) = Point2D (x p1 + x p2) (y p1 + y p2)
addVecToPoint _ _ = error "Not possible!"
this gives:
ghci> myTest
Should be: Point3D {x = 1, y = 2, z = 1} -- and is: Point3D {x = 1, y = 2, z = 1}
Should be: Point3D {x = 0, y = 4, z = 4} -- and is: Point3D {x = 0, y = 4, z = 4}
Should be: Point3D {x = 2, y = 0, z = 0} -- and is: Point3D {x = 2, y = 0, z = 0}
Should be: Point3D {x = 1, y = -2, z = -3} -- and is: Point3D {x = 1, y = -2, z = -3}
Should be: Point3D {x = 3, y = -2, z = -3} -- and is: Point3D {x = 3, y = -2, z = -3}
Should be: Point3D {x = 4, y = 0, z = -2} -- and is: Point3D {x = 4, y = 0, z = -2}
I’m a bit stumped as to why lenses can’t work here.