diff --git a/numhask-space.cabal b/numhask-space.cabal
--- a/numhask-space.cabal
+++ b/numhask-space.cabal
@@ -1,6 +1,6 @@
 cabal-version: 2.4
 name: numhask-space
-version: 0.5.0
+version: 0.6.0
 synopsis:
   numerical spaces
 description:
@@ -48,13 +48,11 @@
     base >=4.7 && <5,
     containers >= 0.6 && < 0.7,
     distributive >=0.2.2 && <1,
-    foldl >= 1.4.5 && <2,
-    lattices >= 2.0.1 && <2.1,
-    protolude >= 0.3.0 && < 0.4.0,
+    numhask >= 0.6 && < 0.7,
     semigroupoids >=5 && <6,
     tdigest >= 0.2.1 && < 0.3,
     text >= 1.2.3.1 && <2,
-    time >= 1.8.0.2 && <2
+    time >= 1.8.0.2 && <2,
   exposed-modules:
     NumHask.Space
     NumHask.Space.Types
@@ -63,6 +61,7 @@
     NumHask.Space.Point
     NumHask.Space.Time
     NumHask.Space.Histogram
+    NumHask.Space.XY
   other-modules:
   default-language: Haskell2010
 
@@ -74,7 +73,7 @@
   build-depends:
     base >=4.7 && <5,
     doctest >= 0.16 && < 0.18,
-    protolude >= 0.3
+    numhask >= 0.6 && < 0.7,
   default-language: Haskell2010
   ghc-options:
     -Wall
diff --git a/src/NumHask/Space.hs b/src/NumHask/Space.hs
--- a/src/NumHask/Space.hs
+++ b/src/NumHask/Space.hs
@@ -17,6 +17,7 @@
     module NumHask.Space.Rect,
     module NumHask.Space.Time,
     module NumHask.Space.Histogram,
+    module NumHask.Space.XY,
   )
 where
 
@@ -26,17 +27,21 @@
 import NumHask.Space.Rect hiding ()
 import NumHask.Space.Time hiding ()
 import NumHask.Space.Types hiding ()
+import NumHask.Space.XY hiding ()
 
 -- $space
 -- The final frontier.
 
--- $instances
--- Space is an interesting cross-section of many programming domains.
---
--- - A Range is a Space of numbers.
---
--- - A Rect is a Space of Points.
---
--- - A time span is a space containing moments of time.
---
--- - A histogram is a divided Range with a count of elements within each division.
+{- $instances
+
+ Space is an interesting cross-section of many programming domains.
+
+ - A Range is a Space of numbers.
+
+ - A Rect is a Space of Points.
+
+ - A time span is a space containing moments of time.
+
+ - A histogram is a divided Range with a count of elements within each division.
+
+-}
diff --git a/src/NumHask/Space/Histogram.hs b/src/NumHask/Space/Histogram.hs
--- a/src/NumHask/Space/Histogram.hs
+++ b/src/NumHask/Space/Histogram.hs
@@ -17,14 +17,13 @@
   )
 where
 
-import qualified Control.Foldl as L
 import qualified Data.List as List
 import qualified Data.Map as Map
 import Data.TDigest
 import NumHask.Space.Range
 import NumHask.Space.Rect
 import NumHask.Space.Types
-import Protolude
+import NumHask.Prelude
 
 -- | This Histogram is a list of contiguous boundaries (a boundary being the lower edge of one bucket and the upper edge of another), and a value (usually a count) for each bucket, represented here as a map
 --
@@ -95,13 +94,13 @@
 -- >>> regularQuantiles 4 [0..100]
 -- [0.0,24.75,50.0,75.25,100.0]
 regularQuantiles :: Double -> [Double] -> [Double]
-regularQuantiles n = L.fold (quantileFold qs)
+regularQuantiles n xs = quantileFold qs xs
   where
     qs = ((1 / n) *) <$> [0 .. n]
 
 -- | one-pass approximate quantiles fold
-quantileFold :: [Double] -> L.Fold Double [Double]
-quantileFold qs = L.Fold step begin done
+quantileFold :: [Double] -> [Double] -> [Double]
+quantileFold qs xs = done $ foldl' step begin xs
   where
     step x a = Data.TDigest.insert a x
     begin = tdigest ([] :: [Double]) :: TDigest 25
@@ -116,7 +115,7 @@
   where
     diffq [] = []
     diffq [_] = []
-    diffq (x : xs') = L.fold (L.Fold step (x, []) (reverse . snd)) xs'
+    diffq (x : xs') = (reverse . snd) $ foldl' step (x, []) xs'
     step (a0, xs') a = (a, (a - a0) : xs')
 
 -- | normalize a histogram so that sum values = one
diff --git a/src/NumHask/Space/Point.hs b/src/NumHask/Space/Point.hs
--- a/src/NumHask/Space/Point.hs
+++ b/src/NumHask/Space/Point.hs
@@ -1,5 +1,7 @@
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE RebindableSyntax #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# OPTIONS_GHC -Wall #-}
 
@@ -11,14 +13,14 @@
   )
 where
 
-import Algebra.Lattice
-import Data.Distributive as D
+import Data.Distributive
 import Data.Functor.Classes
 import Data.Functor.Rep
 import GHC.Show (show)
 import NumHask.Space.Range
 import NumHask.Space.Types
-import Protolude as P hiding (rotate)
+import NumHask.Prelude hiding (show, Distributive, rotate)
+import qualified NumHask.Prelude as P
 
 -- $setup
 -- >>> :set -XNoImplicitPrelude
@@ -44,7 +46,7 @@
   deriving (Eq, Generic)
 
 instance (Show a) => Show (Point a) where
-  show (Point a b) = "Point " <> P.show a <> " " <> P.show b
+  show (Point a b) = "Point " <> show a <> " " <> show b
 
 instance Functor Point where
   fmap f (Point a b) = Point (f a) (f b)
@@ -85,22 +87,26 @@
 
   maxBound = Point maxBound maxBound
 
-instance (Num a) => Num (Point a) where
+instance (Additive a) => Additive (Point a) where
   (Point a0 b0) + (Point a1 b1) = Point (a0 + a1) (b0 + b1)
+  zero = Point zero zero
 
+instance (Subtractive a) => Subtractive (Point a) where
   negate = fmap negate
 
+instance (Multiplicative a) => Multiplicative (Point a) where
   (Point a0 b0) * (Point a1 b1) = Point (a0 * a1) (b0 * b1)
-
-  signum = fmap signum
+  one = Point one one
 
-  abs = fmap abs
+instance (P.Distributive a) => P.Distributive (Point a)
 
-  fromInteger x = Point (fromInteger x) (fromInteger x)
+instance (Field a) => Field (Point a)
 
-instance (Fractional a) => Fractional (Point a) where
-  fromRational x = Point (fromRational x) (fromRational x)
+instance (Signed a) => Signed (Point a) where
+  sign = fmap sign
+  abs = fmap abs
 
+instance (Divisive a) => Divisive (Point a) where
   recip = fmap recip
 
 instance Distributive Point where
@@ -117,16 +123,17 @@
   index (Point l _) False = l
   index (Point _ r) True = r
 
-instance (Ord a) => Lattice (Point a) where
+instance (Ord a) => JoinSemiLattice (Point a) where
   (\/) (Point x y) (Point x' y') = Point (max x x') (max y y')
 
+instance (Ord a) => MeetSemiLattice (Point a) where
   (/\) (Point x y) (Point x' y') = Point (min x x') (min y y')
 
 -- | rotate a point by x degrees relative to the origin
 --
 -- >>> rotate 90 (Point 0 1)
 -- Point 1.0 6.123233995736766e-17
-rotate :: (Floating a) => a -> Point a -> Point a
+rotate :: (FromInteger a, TrigField a) => a -> Point a -> Point a
 rotate d (Point x y) = Point (x * cos d' + y * sin d') (y * cos d' - x * sin d')
   where
     d' = d * pi / 180
@@ -135,5 +142,5 @@
 --
 -- >>> gridP (**2) (Range 0 4) 4
 -- [Point 0.0 0.0,Point 1.0 1.0,Point 2.0 4.0,Point 3.0 9.0,Point 4.0 16.0]
-gridP :: (Ord a, Fractional a) => (a -> a) -> Range a -> Int -> [Point a]
+gridP :: (FieldSpace (Range a)) => (a -> a) -> Range a -> Grid (Range a) -> [Point a]
 gridP f r g = (\x -> Point x (f x)) <$> grid OuterPos r g
diff --git a/src/NumHask/Space/Range.hs b/src/NumHask/Space/Range.hs
--- a/src/NumHask/Space/Range.hs
+++ b/src/NumHask/Space/Range.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# OPTIONS_GHC -Wall #-}
@@ -10,8 +11,6 @@
   )
 where
 
-import Algebra.Lattice
-import Control.Category (id)
 import Data.Distributive as D
 import Data.Functor.Apply (Apply (..))
 import Data.Functor.Classes
@@ -20,9 +19,13 @@
 import Data.Semigroup.Traversable (Traversable1 (..))
 import GHC.Show (show)
 import NumHask.Space.Types as S
-import Protolude as P
+import NumHask.Prelude hiding (show)
 
 -- $setup
+--
+-- >>> :set -XFlexibleContexts
+-- >>> :set -XGADTs
+--
 
 -- | A continuous range over type a
 --
@@ -35,7 +38,7 @@
 -- >>> a + a
 -- Range -2 2
 -- >>> a * a
--- Range -1 1
+-- Range -1.0 1.0
 -- >>> (+1) <$> (Range 1 2)
 -- Range 2 3
 --
@@ -47,18 +50,18 @@
 --
 -- Create an equally spaced grid including outer bounds over a Range
 --
--- >>> grid OuterPos (Range 0 10) 5
+-- >>> grid OuterPos (Range 0.0 10.0) 5
 -- [0.0,2.0,4.0,6.0,8.0,10.0]
 --
 -- divide up a Range into equal-sized sections
 --
--- >>> gridSpace (Range 0 1) 4
+-- >>> gridSpace (Range 0.0 1.0) 4
 -- [Range 0.0 0.25,Range 0.25 0.5,Range 0.5 0.75,Range 0.75 1.0]
 data Range a = Range a a
   deriving (Eq, Generic)
 
 instance (Show a) => Show (Range a) where
-  show (Range a b) = "Range " <> P.show a <> " " <> P.show b
+  show (Range a b) = "Range " <> show a <> " " <> show b
 
 instance Eq1 Range where
   liftEq f (Range a b) (Range c d) = f a c && f b d
@@ -102,9 +105,10 @@
   index (Range l _) False = l
   index (Range _ r) True = r
 
-instance (Ord a) => Lattice (Range a) where
+instance (Ord a) => JoinSemiLattice (Range a) where
   (\/) = liftR2 min
 
+instance (Ord a) => MeetSemiLattice (Range a) where
   (/\) = liftR2 max
 
 instance (Eq a, Ord a) => Space (Range a) where
@@ -116,8 +120,8 @@
 
   (>.<) = Range
 
-instance (Ord a, Fractional a) => FieldSpace (Range a) where
-  type Grid (Range a) = Int
+instance FieldSpace (Range Double) where
+  type Grid (Range Double) = Int
 
   grid o s n = (+ bool 0 (step / 2) (o == MidPos)) <$> posns
     where
@@ -138,26 +142,27 @@
 instance (Eq a, Ord a) => Semigroup (Range a) where
   (<>) a b = getUnion (Union a <> Union b)
 
--- | Numeric algebra based on Interval arithmetic
-instance (Num a, Eq a, Ord a) => Num (Range a) where
+instance (Additive a, Eq a, Ord a) => Additive (Range a) where
   (Range l u) + (Range l' u') = space1 [l + l', u + u']
+  zero = Range zero zero
 
+instance (Subtractive a, Eq a, Ord a) => Subtractive (Range a) where
   negate (Range l u) = negate u ... negate l
 
+instance (Field a, Eq a, Ord a) => Multiplicative (Range a) where
   (Range l u) * (Range l' u') =
     space1 [l * l', l * u', u * l', u * u']
-
-  signum (Range l u) = bool (negate 1) 1 (u >= l)
+  one = Range (negate one/(one + one)) (one/(one+one))
 
+instance (Field a, Subtractive a, Eq a, Ord a) => Signed (Range a) where
+  sign (Range l u) = bool (negate one) one (u >= l)
   abs (Range l u) = bool (u ... l) (l ... u) (u >= l)
 
-  fromInteger x = fromInteger x ... fromInteger x
-
-stepSensible :: (Fractional a, RealFrac a, Floating a, Integral b) => Pos -> a -> b -> a
+stepSensible :: Pos -> Double -> Integer -> Double
 stepSensible tp span' n =
   step + bool 0 (step / 2) (tp == MidPos)
   where
-    step' = 10.0 ^^ (floor (logBase 10 (span' / fromIntegral n)) :: Integer)
+    step' = 10.0 ^^ (floor (logBase 10 (span' / fromInteger n)) :: Integer)
     err = fromIntegral n / span' * step'
     step
       | err <= 0.15 = 10.0 * step'
@@ -170,12 +175,11 @@
 -- >>> gridSensible OuterPos False (Range (-12.0) 23.0) 6
 -- [-15.0,-10.0,-5.0,0.0,5.0,10.0,15.0,20.0,25.0]
 gridSensible ::
-  (Ord a, RealFrac a, Floating a, Integral b) =>
   Pos ->
   Bool ->
-  Range a ->
-  b ->
-  [a]
+  Range Double ->
+  Integer ->
+  [Double]
 gridSensible tp inside r@(Range l u) n =
   bool id (filter (`memberOf` r)) inside $
     (+ bool 0 (step / 2) (tp == MidPos)) <$> posns
diff --git a/src/NumHask/Space/Rect.hs b/src/NumHask/Space/Rect.hs
--- a/src/NumHask/Space/Rect.hs
+++ b/src/NumHask/Space/Rect.hs
@@ -1,9 +1,11 @@
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE RebindableSyntax #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# OPTIONS_GHC -Wall #-}
 {-# OPTIONS_GHC -Wincomplete-patterns #-}
@@ -16,9 +18,6 @@
     corners,
     corners4,
     projectRect,
-    addRect,
-    multRect,
-    unitRect,
     foldRect,
     addPoint,
     rotateRect,
@@ -29,7 +28,6 @@
   )
 where
 
-import Algebra.Lattice
 import Data.Distributive as D
 import Data.Functor.Compose
 import Data.Functor.Rep
@@ -39,30 +37,34 @@
 import NumHask.Space.Point
 import NumHask.Space.Range
 import NumHask.Space.Types
-import Protolude as P hiding (rotate)
+import NumHask.Prelude hiding (rotate, Distributive, show)
 
 -- $setup
+--
+-- >>> :set -XFlexibleContexts
+-- >>> :set -XGADTs
+--
 
 -- | a rectangular space often representing a 2-dimensional or XY plane.
 --
--- >>> let a = Rect (-1) 1 (-2) 4
+-- >>> let a = Rect (-1.0) 1.0 (-2.0) 4.0
 -- >>> a
--- Rect -1 1 -2 4
+-- Rect -1.0 1.0 -2.0 4.0
 -- >>> let (Ranges x y) = a
 -- >>> x
--- Range -1 1
+-- Range -1.0 1.0
 -- >>> y
--- Range -2 4
+-- Range -2.0 4.0
 -- >>> fmap (+1) (Rect 1 2 3 4)
 -- Rect 2 3 4 5
 --
 -- as a Space instance with Points as Elements
 --
--- >>> project (Rect 0 1 (-1) 0) (Rect 1 4 10 0) (Point 0.5 1)
+-- >>> project (Rect 0.0 1.0 (-1.0) 0.0) (Rect 1.0 4.0 10.0 0.0) (Point 0.5 1.0)
 -- Point 2.5 -10.0
--- >>> gridSpace (Rect 0 10 0 1) (Point 2 2)
+-- >>> gridSpace (Rect 0.0 10.0 0.0 1.0) (Point (2::Int) (2::Int))
 -- [Rect 0.0 5.0 0.0 0.5,Rect 0.0 5.0 0.5 1.0,Rect 5.0 10.0 0.0 0.5,Rect 5.0 10.0 0.5 1.0]
--- >>> grid MidPos (Rect 0 10 0 1) (Point 2 2)
+-- >>> grid MidPos (Rect 0.0 10.0 0.0 1.0) (Point (2::Int) (2::Int))
 -- [Point 2.5 0.25,Point 2.5 0.75,Point 7.5 0.25,Point 7.5 0.75]
 newtype Rect a
   = Rect' (Compose Point Range a)
@@ -89,7 +91,7 @@
 
 instance (Show a) => Show (Rect a) where
   show (Rect a b c d) =
-    "Rect " <> P.show a <> " " <> P.show b <> " " <> P.show c <> " " <> P.show d
+    "Rect " <> show a <> " " <> show b <> " " <> show c <> " " <> show d
 
 instance Distributive Rect where
   collect f x =
@@ -140,10 +142,10 @@
 
   (|<|) s0 s1 = lower s1 `joinLeq` upper s0
 
-instance (Ord a, Fractional a, Num a) => FieldSpace (Rect a) where
-  type Grid (Rect a) = Point Int
+instance FieldSpace (Rect Double) where
+  type Grid (Rect Double) = Point Int
 
-  grid o s n = (+ bool 0 (step / 2) (o == MidPos)) <$> posns
+  grid o s n = (+ bool zero (step / (one+one)) (o == MidPos)) <$> posns
     where
       posns =
         (lower s +) . (step *) . fmap fromIntegral
@@ -151,11 +153,11 @@
       step = (/) (width s) (fromIntegral <$> n)
       (Point x0 y0, Point x1 y1) =
         case o of
-          OuterPos -> (0, n)
-          InnerPos -> (1, n - 1)
-          LowerPos -> (0, n - 1)
-          UpperPos -> (1, n)
-          MidPos -> (0, n - 1)
+          OuterPos -> (zero, n)
+          InnerPos -> (one, n - one)
+          LowerPos -> (zero, n - one)
+          UpperPos -> (one, n)
+          MidPos -> (zero, n - one)
 
   gridSpace (Ranges rX rY) (Point stepX stepY) =
     [ Rect x (x + sx) y (y + sy)
@@ -168,14 +170,14 @@
 
 -- | create a list of points representing the lower left and upper right corners of a rectangle.
 --
--- >>> corners unitRect
+-- >>> corners one
 -- [Point -0.5 -0.5,Point 0.5 0.5]
 corners :: (Ord a) => Rect a -> [Point a]
 corners r = [lower r, upper r]
 
 -- | the 4 corners
 --
--- >>> corners4 unitRect
+-- >>> corners4 one
 -- [Point -0.5 -0.5,Point -0.5 0.5,Point 0.5 -0.5,Point 0.5 0.5]
 corners4 :: Rect a -> [Point a]
 corners4 (Rect x z y w) =
@@ -192,63 +194,47 @@
 -- >>> projectRect (Rect 0 1 (-1) 0) (Rect 0 4 0 8) (Rect 0.25 0.75 (-0.75) (-0.25))
 -- Rect 1.0 3.0 2.0 6.0
 projectRect ::
-  (Ord a, Fractional a) =>
-  Rect a ->
-  Rect a ->
-  Rect a ->
-  Rect a
+  Rect Double ->
+  Rect Double ->
+  Rect Double ->
+  Rect Double
 projectRect r0 r1 (Rect a b c d) = Rect a' b' c' d'
   where
     (Point a' c') = project r0 r1 (Point a c)
     (Point b' d') = project r0 r1 (Point b d)
 
 -- | Numeric algebra based on interval arithmetioc for addition and unitRect and projection for multiplication
-instance (Fractional a, Num a, Eq a, Ord a) => Num (Rect a) where
-  (+) = addRect
+-- >>> one + one :: Rect Double
+-- Rect -1.0 1.0 -1.0 1.0
+--
+instance (Additive a) => Additive (Rect a) where
+  (+)
+    (Rect a b c d) (Rect a' b' c' d') =
+    Rect (a + a') (b + b') (c + c') (d + d')
+  zero = Rect zero zero zero zero
 
+instance (Subtractive a) => Subtractive (Rect a) where
   negate = fmap negate
 
-  (*) = multRect
-
-  signum (Rect x z y w) = bool (negate 1) 1 (z >= x && (w >= y))
-
-  abs (Ranges x y) = Ranges (norm x) (norm y)
-
-  fromInteger x = fromInteger x ... fromInteger x
-
--- | Rect addition
---
--- >>> unitRect `addRect` unitRect
--- Rect -1.0 1.0 -1.0 1.0
-addRect :: (Num a) => Rect a -> Rect a -> Rect a
-addRect (Rect a b c d) (Rect a' b' c' d') =
-  Rect (a + a') (b + b') (c + c') (d + d')
+instance (Ord a, Field a) => Multiplicative (Rect a) where
+  (*)
+    (Ranges x0 y0) (Ranges x1 y1) =
+    Ranges (x0 `rtimes` x1) (y0 `rtimes` y1)
+    where
+      rtimes a b = bool (Range (m - r / (one+one)) (m + r / (one+one))) zero (a == zero || b == zero)
+        where
+          m = mid a + mid b
+          r = width a * width b
 
--- | Rect multiplication
---
--- >>> unitRect `multRect` Rect 0 2 0 4
--- Rect 0.0 2.0 0.0 4.0
-multRect :: (Ord a, Fractional a) => Rect a -> Rect a -> Rect a
-multRect (Ranges x0 y0) (Ranges x1 y1) =
-  Ranges (x0 `rtimes` x1) (y0 `rtimes` y1)
-  where
-    rtimes a b = bool (Range (m - r / 2) (m + r / 2)) 0 (a == 0 || b == 0)
-      where
-        m = mid a + mid b
-        r = width a * width b
+  one = Ranges one one
 
--- | a unit Rectangle, with values chosen so that width and height are one and mid is zero
---
--- >>> unitRect :: Rect Double
--- Rect -0.5 0.5 -0.5 0.5
-unitRect :: (Fractional a) => Rect a
-unitRect = Ranges rone rone
-  where
-    rone = Range (-0.5) 0.5
+instance (Ord a, Field a) => Signed (Rect a) where
+  sign (Rect x z y w) = bool (negate one) one (z >= x && (w >= y))
+  abs (Ranges x y) = Ranges (abs x) (abs y)
 
 -- | convex hull union of Rect's
 --
--- >>> foldRect [Rect 0 1 0 1, unitRect]
+-- >>> foldRect [Rect 0 1 0 1, one]
 -- Just Rect -0.5 1.0 -0.5 1.0
 foldRect :: (Ord a) => [Rect a] -> Maybe (Rect a)
 foldRect [] = Nothing
@@ -256,16 +242,16 @@
 
 -- | add a Point to a Rect
 --
--- >>> addPoint (Point 0 1) unitRect
+-- >>> addPoint (Point 0 1) one
 -- Rect -0.5 0.5 0.5 1.5
-addPoint :: (Num a) => Point a -> Rect a -> Rect a
+addPoint :: (Additive a) => Point a -> Rect a -> Rect a
 addPoint (Point x' y') (Rect x z y w) = Rect (x + x') (z + x') (y + y') (w + y')
 
 -- | rotate the corners of a Rect by x degrees relative to the origin, and fold to a new Rect
 --
--- >>> rotateRect 45 unitRect
+-- >>> rotateRect 45 one
 -- Rect -0.7071067811865475 0.7071067811865475 -5.551115123125783e-17 5.551115123125783e-17
-rotateRect :: (Floating a, Ord a) => a -> Rect a -> Rect a
+rotateRect :: Double -> Rect Double -> Rect Double
 rotateRect d r =
   space1 $ rotate d <$> corners r
 
@@ -273,7 +259,7 @@
 --
 -- >>> gridR (**2) (Range 0 4) 4
 -- [Rect 0.0 1.0 0.0 0.25,Rect 1.0 2.0 0.0 2.25,Rect 2.0 3.0 0.0 6.25,Rect 3.0 4.0 0.0 12.25]
-gridR :: (Ord a, Fractional a) => (a -> a) -> Range a -> Int -> [Rect a]
+gridR :: (Double -> Double) -> Range Double -> Int -> [Rect Double]
 gridR f r g = (\x -> Rect (x - tick / 2) (x + tick / 2) 0 (f x)) <$> grid MidPos r g
   where
     tick = width r / fromIntegral g
@@ -282,19 +268,19 @@
 --
 -- >>> gridF (\(Point x y) -> x * y) (Rect 0 4 0 4) (Point 2 2)
 -- [(Rect 0.0 2.0 0.0 2.0,1.0),(Rect 0.0 2.0 2.0 4.0,3.0),(Rect 2.0 4.0 0.0 2.0,3.0),(Rect 2.0 4.0 2.0 4.0,9.0)]
-gridF :: (Ord a, Fractional a) => (Point a -> b) -> Rect a -> Grid (Rect a) -> [(Rect a, b)]
+gridF :: (Point Double -> b) -> Rect Double -> Grid (Rect Double) -> [(Rect Double, b)]
 gridF f r g = (\x -> (x, f (mid x))) <$> gridSpace r g
 
 -- | convert a ratio (eg x:1) to a Rect with a height of one.
 --
 -- >>> aspect 2
 -- Rect -1.0 1.0 -0.5 0.5
-aspect :: (Fractional a) => a -> Rect a
+aspect :: Double -> Rect Double
 aspect a = Rect (a * (-0.5)) (a * 0.5) (-0.5) 0.5
 
 -- | convert a Rect to a ratio
 --
 -- >>> ratio (Rect (-1) 1 (-0.5) 0.5)
 -- 2.0
-ratio :: (Fractional a) => Rect a -> a
+ratio :: (Field a) => Rect a -> a
 ratio (Rect x z y w) = (z - x) / (w - y)
diff --git a/src/NumHask/Space/Time.hs b/src/NumHask/Space/Time.hs
--- a/src/NumHask/Space/Time.hs
+++ b/src/NumHask/Space/Time.hs
@@ -1,7 +1,10 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE RebindableSyntax #-}
 {-# OPTIONS_GHC -Wall #-}
 {-# OPTIONS_GHC -Wno-unused-top-binds #-}
+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+{-# OPTIONS_GHC -fno-warn-type-defaults #-}
 
 -- | data algorithms related to time (as a Space)
 module NumHask.Space.Time
@@ -13,17 +16,19 @@
     PosDiscontinuous (..),
     placedTimeLabelDiscontinuous,
     placedTimeLabelContinuous,
+    fromNominalDiffTime,
+    toNominalDiffTime,
+    fromDiffTime,
+    toDiffTime,
   )
 where
 
-import Control.Category (id)
-import qualified Control.Foldl as L
 import Data.List (nub)
 import Data.String (String)
-import Data.Text (pack, unpack)
 import Data.Time
 import NumHask.Space.Types
-import Protolude
+import NumHask.Prelude
+import Data.Fixed (Fixed(MkFixed))
 
 -- | parse text as per iso8601
 --
@@ -46,34 +51,32 @@
   deriving (Show, Eq, Generic)
 
 grainSecs :: TimeGrain -> Double
-grainSecs (Years n) = fromIntegral n * 365.0 * toDouble nominalDay
-grainSecs (Months n) = fromIntegral n * 365.0 / 12 * toDouble nominalDay
-grainSecs (Days n) = fromIntegral n * toDouble nominalDay
+grainSecs (Years n) = fromIntegral n * 365.0 * fromNominalDiffTime nominalDay
+grainSecs (Months n) = fromIntegral n * 365.0 / 12 * fromNominalDiffTime nominalDay
+grainSecs (Days n) = fromIntegral n * fromNominalDiffTime nominalDay
 grainSecs (Hours n) = fromIntegral n * 60 * 60
 grainSecs (Minutes n) = fromIntegral n * 60
 grainSecs (Seconds n) = n
 
-toDouble :: NominalDiffTime -> Double
-toDouble t =
-  (/ 1000000000000.0) $
-    fromIntegral (floor $ t * 1000000000000 :: Integer)
-
-toDouble' :: DiffTime -> Double
-toDouble' =
-  (\x -> x / ((10 :: Double) ^ (12 :: Integer))) . fromIntegral . fromEnum
+fromNominalDiffTime :: NominalDiffTime -> Double
+fromNominalDiffTime t = let (MkFixed i) = (nominalDiffTimeToSeconds t) in (fromInteger i) * 1e-12
 
-fromDouble :: Double -> NominalDiffTime
-fromDouble x =
+toNominalDiffTime :: Double -> NominalDiffTime
+toNominalDiffTime x =
   let d0 = ModifiedJulianDay 0
-      days = floor (x / toDouble nominalDay)
-      secs = x - fromIntegral days * toDouble nominalDay
+      days = floor (x / fromNominalDiffTime nominalDay)
+      secs = x - fromIntegral days * fromNominalDiffTime nominalDay
       t0 = UTCTime d0 (picosecondsToDiffTime 0)
       t1 = UTCTime (addDays days d0) (picosecondsToDiffTime $ floor (secs / 1.0e-12))
    in diffUTCTime t1 t0
 
-fromDouble' :: Double -> DiffTime
-fromDouble' d = toEnum . fromEnum $ d * ((10 :: Double) ^ (12 :: Integer))
+fromDiffTime :: DiffTime -> Double
+fromDiffTime =
+  (\x -> x / ((10 :: Double) ^ (12 :: Integer))) . fromIntegral . fromEnum
 
+toDiffTime :: Double -> DiffTime
+toDiffTime d = toEnum . fromEnum $ d * ((10 :: Double) ^ (12 :: Integer))
+
 -- | add a TimeGrain to a UTCTime
 --
 -- >>> addGrain (Years 1) 5 (UTCTime (fromGregorian 2015 2 28) 0)
@@ -93,9 +96,9 @@
 addGrain (Months n) x (UTCTime d t) =
   UTCTime (addDays (-1) $ addGregorianMonthsClip (fromIntegral (n * x)) (addDays 1 d)) t
 addGrain (Days n) x (UTCTime d t) = UTCTime (addDays (fromIntegral x * fromIntegral n) d) t
-addGrain g@(Hours _) x d = addUTCTime (fromDouble (fromIntegral x * grainSecs g)) d
-addGrain g@(Minutes _) x d = addUTCTime (fromDouble (fromIntegral x * grainSecs g)) d
-addGrain g@(Seconds _) x d = addUTCTime (fromDouble (fromIntegral x * grainSecs g)) d
+addGrain g@(Hours _) x d = addUTCTime (toNominalDiffTime (fromIntegral x * grainSecs g)) d
+addGrain g@(Minutes _) x d = addUTCTime (toNominalDiffTime (fromIntegral x * grainSecs g)) d
+addGrain g@(Seconds _) x d = addUTCTime (toNominalDiffTime (fromIntegral x * grainSecs g)) d
 
 addHalfGrain :: TimeGrain -> UTCTime -> UTCTime
 addHalfGrain (Years n) (UTCTime d t) =
@@ -116,13 +119,13 @@
   where
     (d', m') = divMod 2 n
 addHalfGrain (Days n) (UTCTime d t) =
-  (if m' == 1 then addUTCTime (fromDouble (0.5 * grainSecs (Days 1))) else id) $
+  (if m' == 1 then addUTCTime (toNominalDiffTime (0.5 * grainSecs (Days 1))) else id) $
     UTCTime (addDays (fromIntegral d') d) t
   where
     (d', m') = divMod 2 n
-addHalfGrain g@(Hours _) d = addUTCTime (fromDouble (0.5 * grainSecs g)) d
-addHalfGrain g@(Minutes _) d = addUTCTime (fromDouble (0.5 * grainSecs g)) d
-addHalfGrain g@(Seconds _) d = addUTCTime (fromDouble (0.5 * grainSecs g)) d
+addHalfGrain g@(Hours _) d = addUTCTime (toNominalDiffTime (0.5 * grainSecs g)) d
+addHalfGrain g@(Minutes _) d = addUTCTime (toNominalDiffTime (0.5 * grainSecs g)) d
+addHalfGrain g@(Seconds _) d = addUTCTime (toNominalDiffTime (0.5 * grainSecs g)) d
 
 -- | compute the floor UTCTime based on the timegrain
 --
@@ -135,33 +138,33 @@
 -- >>> floorGrain (Days 5) (UTCTime (fromGregorian 2016 12 30) 1)
 -- 2016-12-30 00:00:00 UTC
 --
--- >>> floorGrain (Minutes 15) (UTCTime (fromGregorian 2016 12 30) (fromDouble' $ 15*60+1))
+-- >>> floorGrain (Minutes 15) (UTCTime (fromGregorian 2016 12 30) (toDiffTime $ 15*60+1))
 -- 2016-12-30 00:15:00 UTC
 --
 -- >>> floorGrain (Seconds 0.1) (UTCTime (fromGregorian 2016 12 30) 0.12)
 -- 2016-12-30 00:00:00.1 UTC
 floorGrain :: TimeGrain -> UTCTime -> UTCTime
-floorGrain (Years n) (UTCTime d _) = UTCTime (addDays (-1) $ fromGregorian y' 1 1) 0
+floorGrain (Years n) (UTCTime d _) = UTCTime (addDays (-1) $ fromGregorian y' 1 1) (secondsToDiffTime 0)
   where
     (y, _, _) = toGregorian (addDays 1 d)
     y' = fromIntegral $ 1 + n * floor (fromIntegral (y - 1) / fromIntegral n :: Double)
-floorGrain (Months n) (UTCTime d _) = UTCTime (addDays (-1) $ fromGregorian y m' 1) 0
+floorGrain (Months n) (UTCTime d _) = UTCTime (addDays (-1) $ fromGregorian y m' 1) (secondsToDiffTime 0)
   where
     (y, m, _) = toGregorian (addDays 1 d)
     m' = fromIntegral (1 + fromIntegral n * floor (fromIntegral (m - 1) / fromIntegral n :: Double) :: Integer)
-floorGrain (Days _) (UTCTime d _) = UTCTime d 0
+floorGrain (Days _) (UTCTime d _) = UTCTime d (secondsToDiffTime 0)
 floorGrain (Hours h) u@(UTCTime _ t) = addUTCTime x u
   where
-    s = toDouble' t
-    x = fromDouble $ fromIntegral (h * 3600 * fromIntegral (floor (s / (fromIntegral h * 3600)) :: Integer)) - s
+    s = fromDiffTime t
+    x = toNominalDiffTime $ fromIntegral (h * 3600 * fromIntegral (floor (s / (fromIntegral h * 3600)) :: Integer)) - s
 floorGrain (Minutes m) u@(UTCTime _ t) = addUTCTime x u
   where
-    s = toDouble' t
-    x = fromDouble $ fromIntegral (m * 60 * fromIntegral (floor (s / (fromIntegral m * 60)) :: Integer)) - s
+    s = fromDiffTime t
+    x = toNominalDiffTime $ fromIntegral (m * 60 * fromIntegral (floor (s / (fromIntegral m * 60)) :: Integer)) - s
 floorGrain (Seconds secs) u@(UTCTime _ t) = addUTCTime x u
   where
-    s = toDouble' t
-    x = fromDouble $ (secs * fromIntegral (floor (s / secs) :: Integer)) - s
+    s = fromDiffTime t
+    x = toNominalDiffTime $ (secs * fromIntegral (floor (s / secs) :: Integer)) - s
 
 -- | compute the ceiling UTCTime based on the timegrain
 --
@@ -174,34 +177,34 @@
 -- >>> ceilingGrain (Days 5) (UTCTime (fromGregorian 2016 12 30) 1)
 -- 2016-12-31 00:00:00 UTC
 --
--- >>> ceilingGrain (Minutes 15) (UTCTime (fromGregorian 2016 12 30) (fromDouble' $ 15*60+1))
+-- >>> ceilingGrain (Minutes 15) (UTCTime (fromGregorian 2016 12 30) (toDiffTime $ 15*60+1))
 -- 2016-12-30 00:30:00 UTC
 --
 -- >>> ceilingGrain (Seconds 0.1) (UTCTime (fromGregorian 2016 12 30) 0.12)
 -- 2016-12-30 00:00:00.2 UTC
 ceilingGrain :: TimeGrain -> UTCTime -> UTCTime
-ceilingGrain (Years n) (UTCTime d _) = UTCTime (addDays (-1) $ fromGregorian y' 1 1) 0
+ceilingGrain (Years n) (UTCTime d _) = UTCTime (addDays (-1) $ fromGregorian y' 1 1) (secondsToDiffTime 0)
   where
     (y, _, _) = toGregorian (addDays 1 d)
     y' = fromIntegral $ 1 + n * ceiling (fromIntegral (y - 1) / fromIntegral n :: Double)
-ceilingGrain (Months n) (UTCTime d _) = UTCTime (addDays (-1) $ fromGregorian y' m'' 1) 0
+ceilingGrain (Months n) (UTCTime d _) = UTCTime (addDays (-1) $ fromGregorian y' m'' 1) (secondsToDiffTime 0)
   where
     (y, m, _) = toGregorian (addDays 1 d)
     m' = (m + n - 1) `div` n * n
     (y', m'') = fromIntegral <$> if m' == 12 then (y + 1, 1) else (y, m' + 1)
-ceilingGrain (Days _) (UTCTime d t) = if t == 0 then UTCTime d 0 else UTCTime (addDays 1 d) 0
+ceilingGrain (Days _) (UTCTime d t) = if t == (secondsToDiffTime 0) then UTCTime d (secondsToDiffTime 0) else UTCTime (addDays 1 d) (secondsToDiffTime 0)
 ceilingGrain (Hours h) u@(UTCTime _ t) = addUTCTime x u
   where
-    s = toDouble' t
-    x = fromDouble $ fromIntegral (h * 3600 * fromIntegral (ceiling (s / (fromIntegral h * 3600)) :: Integer)) - s
+    s = fromDiffTime t
+    x = toNominalDiffTime $ fromIntegral (h * 3600 * fromIntegral (ceiling (s / (fromIntegral h * 3600)) :: Integer)) - s
 ceilingGrain (Minutes m) u@(UTCTime _ t) = addUTCTime x u
   where
-    s = toDouble' t
-    x = fromDouble $ fromIntegral (m * 60 * fromIntegral (ceiling (s / (fromIntegral m * 60)) :: Integer)) - s
+    s = fromDiffTime t
+    x = toNominalDiffTime $ fromIntegral (m * 60 * fromIntegral (ceiling (s / (fromIntegral m * 60)) :: Integer)) - s
 ceilingGrain (Seconds secs) u@(UTCTime _ t) = addUTCTime x u
   where
-    s = toDouble' t
-    x = fromDouble $ (secs * fromIntegral (ceiling (s / secs) :: Integer)) - s
+    s = fromDiffTime t
+    x = toNominalDiffTime $ (secs * fromIntegral (ceiling (s / secs) :: Integer)) - s
 
 -- | whether to include lower and upper times
 data PosDiscontinuous = PosInnerOnly | PosIncludeBoundaries
@@ -221,7 +224,15 @@
     tps' = case posd of
       PosInnerOnly -> tps
       PosIncludeBoundaries -> [l] <> tps <> [u]
-    (rem', inds) = L.fold (matchTimes tps') ts
+    begin = (tps', [], 0)
+    done (p, x, _) = (p, reverse x)
+    step ([], xs, n) _ = ([], xs, n)
+    step (p : ps, xs, n) a
+      | p == a = step (ps, (n, p) : xs, n) a
+      | p > a = (p : ps, xs, n + 1)
+      | otherwise = step (ps, (n - 1, p) : xs, n) a
+    (rem', inds) = done $ foldl' step begin ts
+
     inds' = laterTimes inds
     fmt = case format of
       Just f -> unpack f
@@ -240,27 +251,17 @@
 autoFormat (Minutes _) = "%R"
 autoFormat (Seconds _) = "%R%Q"
 
-matchTimes :: [UTCTime] -> L.Fold UTCTime ([UTCTime], [(Int, UTCTime)])
-matchTimes ticks = L.Fold step begin (\(p, x, _) -> (p, reverse x))
-  where
-    begin = (ticks, [], 0)
-    step ([], xs, n) _ = ([], xs, n)
-    step (p : ps, xs, n) a
-      | p == a = step (ps, (n, p) : xs, n) a
-      | p > a = (p : ps, xs, n + 1)
-      | otherwise = step (ps, (n - 1, p) : xs, n) a
-
 laterTimes :: [(Int, a)] -> [(Int, a)]
 laterTimes [] = []
 laterTimes [x] = [x]
-laterTimes (x : xs) = L.fold (L.Fold step (x, []) (\(x0, x1) -> reverse $ x0 : x1)) xs
+laterTimes (x : xs) = (\(x0, x1) -> reverse $ x0 : x1) $ foldl' step (x,[]) xs
   where
     step ((n, a), rs) (na, aa) = if na == n then ((na, aa), rs) else ((na, aa), (n, a) : rs)
 
 -- | A sensible time grid between two dates, projected onto (0,1) with no attempt to get finnicky.
 --
 -- >>> placedTimeLabelContinuous PosIncludeBoundaries (Just "%d %b") 2 (UTCTime (fromGregorian 2017 12 6) 0, UTCTime (fromGregorian 2017 12 29) 0)
--- [(0.0,"06 Dec"),(0.43478260869565216,"16 Dec"),(0.8695652173913043,"26 Dec"),(1.0,"29 Dec")]
+-- [(0.0,"06 Dec"),(0.4347826086956521,"16 Dec"),(0.8695652173913042,"26 Dec"),(0.9999999999999999,"29 Dec")]
 placedTimeLabelContinuous :: PosDiscontinuous -> Maybe Text -> Int -> (UTCTime, UTCTime) -> [(Double, Text)]
 placedTimeLabelContinuous posd format n (l, u) = zip tpsd labels
   where
@@ -274,8 +275,8 @@
     labels = pack . formatTime defaultTimeLocale fmt <$> tps'
     l' = minimum tps'
     u' = maximum tps'
-    r' = toDouble $ diffUTCTime u' l'
-    tpsd = (/ r') . toDouble . flip diffUTCTime l <$> tps'
+    r' = fromNominalDiffTime $ diffUTCTime u' l'
+    tpsd = (/ r') . fromNominalDiffTime . flip diffUTCTime l <$> tps'
 
 -- | compute a sensible TimeGrain and list of UTCTimes
 --
@@ -297,7 +298,7 @@
     grain = stepSensibleTime p span' n
     first' = floorGrain grain l
     last' = ceilingGrain grain u
-    n' = round $ toDouble (diffUTCTime last' first') / grainSecs grain :: Integer
+    n' = round $ fromNominalDiffTime (diffUTCTime last' first') / grainSecs grain :: Integer
     posns = case p of
       OuterPos -> take (fromIntegral $ n' + 1)
       InnerPos -> drop (if first' == l then 0 else 1) . take (fromIntegral $ n' + if last' == u then 1 else 0)
@@ -310,11 +311,10 @@
 
 -- come up with a sensible step for a grid over a Field
 stepSensible ::
-  (Fractional a, RealFrac a, Floating a) =>
   Pos ->
-  a ->
+  Double ->
   Int ->
-  a
+  Double
 stepSensible tp span' n =
   step
     + if tp == MidPos
@@ -332,11 +332,10 @@
 -- come up with a sensible step for a grid over a Field, where sensible means the 18th century
 -- practice of using multiples of 3 to round
 stepSensible3 ::
-  (Fractional a, Floating a, RealFrac a) =>
   Pos ->
-  a ->
+  Double ->
   Int ->
-  a
+  Double
 stepSensible3 tp span' n =
   step
     + if tp == MidPos
@@ -362,11 +361,11 @@
   | secondsstep >= 1 = Seconds secondsstep3
   | otherwise = Seconds secondsstep
   where
-    sp = toDouble span'
+    sp = fromNominalDiffTime span'
     minutes = sp / 60
     hours = sp / (60 * 60)
-    days = sp / toDouble nominalDay
-    years = sp / 365 / toDouble nominalDay
+    days = sp / fromNominalDiffTime nominalDay
+    years = sp / 365 / fromNominalDiffTime nominalDay
     months' = years * 12
     yearsstep = stepSensible tp years n
     monthsstep = stepSensible3 tp months' n
diff --git a/src/NumHask/Space/Types.hs b/src/NumHask/Space/Types.hs
--- a/src/NumHask/Space/Types.hs
+++ b/src/NumHask/Space/Types.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE RebindableSyntax #-}
 {-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -27,8 +28,8 @@
   )
 where
 
-import Protolude
-import Protolude.Partial (foldr1)
+import NumHask.Prelude
+import qualified Prelude as P
 
 -- | Space is a continuous range of numbers that contains elements and has an upper and lower value.
 --
@@ -129,13 +130,13 @@
 memberOf = (|.|)
 
 -- | distance between boundaries
-width :: (Space s, Num (Element s)) => s -> Element s
+width :: (Space s, Subtractive (Element s)) => s -> Element s
 width s = upper s - lower s
 
 -- | create a space centered on a plus or minus b
 infixl 6 +/-
 
-(+/-) :: (Space s, Num (Element s)) => Element s -> Element s -> s
+(+/-) :: (Space s, Subtractive (Element s)) => Element s -> Element s -> s
 a +/- b = a - b ... a + b
 
 -- | a convex hull
@@ -154,7 +155,7 @@
 --
 -- > space1 (grid OuterPos s g) == s
 -- > getUnion (sconcat (Union <$> (gridSpace s g))) == s
-class (Space s, Num (Element s)) => FieldSpace s where
+class (Space s, Field (Element s)) => FieldSpace s where
   type Grid s :: Type
 
   -- | create equally-spaced elements across a space
@@ -178,8 +179,8 @@
   deriving (Show, Eq)
 
 -- | middle element of the space
-mid :: (Space s, Fractional (Element s)) => s -> Element s
-mid s = (lower s + upper s) / 2.0
+mid :: (Space s, Field (Element s)) => s -> Element s
+mid s = (lower s + upper s) / (one + one)
 
 -- | project a data point from one space to another, preserving relative position
 --
@@ -187,7 +188,7 @@
 -- > project o n (upper o) = upper n
 -- > project o n (mid o) = mid n
 -- > project a a x = x
-project :: (Space s, Fractional (Element s)) => s -> s -> Element s -> Element s
+project :: (Space s, Field (Element s)) => s -> s -> Element s -> Element s
 project s0 s1 p =
   ((p - lower s0) / (upper s0 - lower s0)) * (upper s1 - lower s1) + lower s1
 
@@ -195,7 +196,7 @@
 --
 -- > all $ space1 a `contains` <$> a
 space1 :: (Space s, Traversable f) => f (Element s) -> s
-space1 = foldr1 union . fmap singleton
+space1 = P.foldr1 union . fmap singleton
 
 -- | lift a monotone function (increasing or decreasing) over a given space
 monotone :: (Space a, Space b) => (Element a -> Element b) -> a -> b
@@ -204,7 +205,8 @@
 -- | a small space
 eps ::
   ( Space s,
-    Fractional (Element s)
+    FromRational (Element s),
+    Field (Element s)
   ) =>
   Element s ->
   Element s ->
@@ -214,7 +216,7 @@
 -- | widen a space
 widen ::
   ( Space s,
-    Num (Element s)
+    Ring (Element s)
   ) =>
   Element s ->
   s ->
@@ -224,7 +226,8 @@
 -- | widen by a small amount
 widenEps ::
   ( Space s,
-    Fractional (Element s)
+    FromRational (Element s),
+    Field (Element s)
   ) =>
   Element s ->
   s ->
@@ -232,9 +235,9 @@
 widenEps accuracy = widen (accuracy * 1e-6)
 
 -- | Scale a Space. (scalar multiplication)
-scale :: (Num (Element s), Space s) => Element s -> s -> s
+scale :: (Multiplicative (Element s), Space s) => Element s -> s -> s
 scale e s = (e * lower s) ... (e * upper s)
 
 -- | Move a Space. (scalar addition)
-move :: (Num (Element s), Space s) => Element s -> s -> s
+move :: (Additive (Element s), Space s) => Element s -> s -> s
 move e s = (e + lower s) ... (e + upper s)
diff --git a/src/NumHask/Space/XY.hs b/src/NumHask/Space/XY.hs
new file mode 100644
--- /dev/null
+++ b/src/NumHask/Space/XY.hs
@@ -0,0 +1,115 @@
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE PatternSynonyms #-}
+
+{- | Unification of a point on the XY-plane and a rectangle on the XY-plane.
+
+
+-}
+
+module NumHask.Space.XY
+  ( XY(..),
+    pattern P,
+    pattern R,
+    toRect,
+    toPoint,
+    projectOn,
+    projectTo,
+    fixRect,
+  ) where
+
+import NumHask.Prelude
+import NumHask.Space.Point
+import NumHask.Space.Rect
+import NumHask.Space.Types
+
+-- | unification of a point and rect on the plane
+data XY a
+  = PointXY (Point a)
+  | RectXY (Rect a)
+  deriving (Eq, Show, Functor)
+
+-- | make an XY from a point
+pattern P :: a -> a -> XY a
+pattern P x y = PointXY (Point x y)
+
+{-# COMPLETE P #-}
+
+-- | make an XY from a rectangle
+pattern R :: a -> a -> a -> a -> XY a
+pattern R x z y w = RectXY (Rect x z y w)
+
+{-# COMPLETE R #-}
+
+instance (Additive a) => Additive (XY a) where
+  PointXY (Point x y) + PointXY (Point x' y') = PointXY (Point (x + x') (y + y'))
+  PointXY (Point x' y') + RectXY (Rect x z y w) = RectXY $ Rect (x + x') (z + x') (y + y') (w + y')
+  RectXY (Rect x z y w) + PointXY (Point x' y') = RectXY $ Rect (x + x') (z + x') (y + y') (w + y')
+  RectXY (Rect x z y w) + RectXY (Rect x' z' y' w') =
+    RectXY $ Rect (x + x') (z + z') (y + y') (w + w')
+  zero = PointXY (Point zero zero)
+
+instance (Ord a, Field a) => Multiplicative (XY a) where
+  x * y = RectXY $ toRect x * toRect y
+  one = RectXY one
+
+instance (Ord a, Subtractive a) => Subtractive (XY a) where
+  negate (PointXY (Point x y)) = PointXY (Point (negate x) (negate y))
+  negate (RectXY (Rect x z y w)) = RectXY (Rect (negate x) (negate z) (negate y) (negate w))
+
+instance (Ord a, Field a, Signed a) => Signed (XY a) where
+  abs x = PointXY $ abs <$> toPoint x
+  sign x = PointXY $ sign <$> toPoint x
+
+-- * Natural transformations
+
+-- | Convert a spot to a Rect
+toRect :: XY a -> Rect a
+toRect (PointXY (Point x y)) = Rect x x y y
+toRect (RectXY a) = a
+
+-- | Convert a spot to a Point
+toPoint :: (Ord a, Field a) => XY a -> Point a
+toPoint (PointXY (Point x y)) = Point x y
+toPoint (RectXY (Ranges x y)) = Point (mid x) (mid y)
+
+instance (Ord a) => Semigroup (XY a) where
+  (<>) a b = RectXY (toRect a `union` toRect b)
+
+-- | project an XY from one Rect to another, preserving relative position.
+--
+-- >>> projectOn one (Rect 0 1 0 1) zero
+-- PointXY Point -0.5 -0.5
+projectOn :: Rect Double -> Rect Double -> XY Double -> XY Double
+projectOn new old@(Rect x z y w) po@(PointXY (Point px py))
+  | x == z && y == w = po
+  | x == z = (P px py')
+  | y == w = (P px' py)
+  | otherwise = (P px' py')
+  where
+    (Point px' py') = project old new (toPoint po)
+projectOn new old@(Rect x z y w) ao@(RectXY (Rect ox oz oy ow))
+  | x == z && y == w = ao
+  | x == z = (R ox oz ny nw)
+  | y == w = (R nx nz oy ow)
+  | otherwise = RectXY a
+  where
+    a@(Rect nx nz ny nw) = projectRect old new (toRect ao)
+
+-- | project a [Spot a] from it's folded space to the given area
+--
+-- >>> projectTo one (SpotPoint <$> zipWith Point [0..2] [0..2])
+-- [SpotPoint Point -0.5 -0.5,SpotPoint Point 0.0 0.0,SpotPoint Point 0.5 0.5]
+projectTo :: Rect Double -> [XY Double] -> [XY Double]
+projectTo _ [] = []
+projectTo vb (x : xs) = projectOn vb (toRect $ sconcat (x :| xs)) <$> (x : xs)
+
+-- | guard substituting singleton dimensions
+fixRect :: Maybe (Rect Double) -> Rect Double
+fixRect r = maybe one singletonUnit r
+  where
+    singletonUnit (Rect x z y w)
+      | x == z && y == w = Rect (x - 0.5) (x + 0.5) (y - 0.5) (y + 0.5)
+      | x == z = Rect (x - 0.5) (x + 0.5) y w
+      | y == w = Rect x z (y - 0.5) (y + 0.5)
+      | otherwise = Rect x z y w
diff --git a/test/test.hs b/test/test.hs
--- a/test/test.hs
+++ b/test/test.hs
@@ -2,7 +2,7 @@
 
 module Main where
 
-import Protolude
+import NumHask.Prelude
 import Test.DocTest
 
 main :: IO ()