Decent, consistent Num for Shaped, but with type classes :(

1 files changed, 19 insertions, 21 deletions

diff --git a/src/Data/Array/Nested/Internal/Shaped.hs b/src/Data/Array/Nested/Internal/Shaped.hs
index f427041..d8c80d1 100644
--- a/src/Data/Array/Nested/Internal/Shaped.hs
+++ b/src/Data/Array/Nested/Internal/Shaped.hs
@@ -188,36 +188,34 @@ arithPromoteShaped2 :: forall sh a b c.
                     -> Shaped sh a -> Shaped sh b -> Shaped sh c
 arithPromoteShaped2 = coerce
 
-instance (NumElt a, PrimElt a, Num a) => Num (Shaped sh a) where
+-- | TODO: 'KnownShS' is only there for 'fromInteger'.
+instance (NumElt a, PrimElt a, Num a, KnownShS sh) => Num (Shaped sh a) where
   (+) = arithPromoteShaped2 (+)
   (-) = arithPromoteShaped2 (-)
   (*) = arithPromoteShaped2 (*)
   negate = arithPromoteShaped negate
   abs = arithPromoteShaped abs
   signum = arithPromoteShaped signum
-  fromInteger = error "Data.Array.Nested.fromInteger: No singletons available, use explicit sreplicateScal/sscalar"
-
-instance {-# INCOHERENT #-} (NumElt a, PrimElt a, Num a) => Num (Shaped '[] a) where
-  (+) = arithPromoteShaped2 (+)
-  (-) = arithPromoteShaped2 (-)
-  (*) = arithPromoteShaped2 (*)
-  negate = arithPromoteShaped negate
-  abs = arithPromoteShaped abs
-  signum = arithPromoteShaped signum
-  fromInteger = sscalar . fromInteger
-
-instance (FloatElt a, NumElt a, PrimElt a, Num a) => Fractional (Shaped sh a) where
-  fromRational _ = error "Data.Array.Nested.fromRational: No singletons available, use explicit sreplicateScal/sscalar"
-  recip = arithPromoteShaped recip
-  (/) = arithPromoteShaped2 (/)
-
-instance {-# INCOHERENT #-} (FloatElt a, NumElt a, PrimElt a, Fractional a) => Fractional (Shaped '[] a) where
-  fromRational = sscalar . fromRational
+  fromInteger =
+    case knownShS @sh of
+      ZSS -> sscalar . fromInteger
+      _ -> error "Data.Array.Nested.fromInteger: No singletons available, use explicit sreplicateScal/sscalar"
+
+-- | TODO: 'KnownShS' is only there for 'fromRational'.
+instance (FloatElt a, NumElt a, PrimElt a, Fractional a, KnownShS sh) => Fractional (Shaped sh a) where
+  fromRational =
+    case knownShS @sh of
+      ZSS -> sscalar . fromRational
+      _ -> error "Data.Array.Nested.fromRational: No singletons available, use explicit sreplicateScal/sscalar"
   recip = arithPromoteShaped recip
   (/) = arithPromoteShaped2 (/)
 
-instance (FloatElt a, NumElt a, PrimElt a, Num a) => Floating (Shaped sh a) where
-  pi = error "Data.Array.Nested.pi: No singletons available, use explicit sreplicateScal/sscalar"
+-- | TODO: 'KnownShS' is only there for 'pi'.
+instance (FloatElt a, NumElt a, PrimElt a, Floating a, KnownShS sh) => Floating (Shaped sh a) where
+  pi =
+    case knownShS @sh of
+      ZSS -> sscalar pi
+      _ -> error "Data.Array.Nested.pi: No singletons available, use explicit sreplicateScal/sscalar"
   exp = arithPromoteShaped exp
   log = arithPromoteShaped log
   sqrt = arithPromoteShaped sqrt