Opt for Num and Fractional types

Author: AliceRixte

.gitignore

@@ -21,3 +21,4 @@ cabal.project.local
 cabal.project.local~
 .HTF/
 .ghc.environment.*
+Makefile

package.yaml

@@ -16,6 +16,7 @@ dependencies:
 - data-default-class >= 0.1.2.0 && < 1
 - singletons >= 3.0.2 && < 3.1
 - singletons-base >= 3.1.1 && < 3.5
+- text >= 2 && < 2.2
 ghc-options:
 - -Wall
 - -Wcompat

singletons-default.cabal

@@ -1,6 +1,6 @@
 cabal-version: 2.2
 
--- This file has been generated from package.yaml by hpack version 0.36.0.
+-- This file has been generated from package.yaml by hpack version 0.38.1.
 --
 -- see: https://github.com/sol/hpack
 
@@ -40,4 +40,5 @@ library
     , data-default-class >=0.1.2.0 && <1
     , singletons >=3.0.2 && <3.1
     , singletons-base >=3.1.1 && <3.5
+    , text >=2 && <2.2
   default-language: Haskell2010

src/Data/Default/Singletons.hs

@@ -1,3 +1,7 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE GHC2021#-}
+
 {-|
 Module      : Data.Default.Singletons
 Description : Provides singleton-based default values and optional types.
@@ -150,42 +154,69 @@ import Data.Singletons
 import Data.String
 import Prelude.Singletons ()
 
+import qualified Data.Text as T
+
 {- |
 `Opt`ional type with
 either a `Def`ault promoted value @def@,
 or `Some` specific `Demote`d value.
 -}
-data Opt (def :: k) where
-  Def :: forall {k} def. SingDef def => Opt (def :: k)
-  Some :: forall {k} def. Demote k -> Opt (def :: k)
+data Opt (def :: k) a where
+  Def :: forall {k} def a. SingDef def a => Opt (def :: k) a
+  Some :: forall {k} def a. a -> Opt (def :: k) a
 
 {- | Constraint required to `demote` @@def@. -}
-type SingDef (def :: k) = (SingI def, SingKind k)
+class SingKind k => SingDef (def :: k) a where
+  demoteDef :: a
+
+instance {-# OVERLAPPABLE #-} (SingKind k, a ~ Demote k, SingI def)
+  => SingDef (def :: k) a where
+  demoteDef = demote @def
+
+instance (KnownNat def, Num a)
+  => SingDef (def :: Nat) a where
+  demoteDef = fromIntegral $ demote @def
+
+instance (SingI def, Num a)
+  => SingDef (def :: Z) a where
+  demoteDef = fromIntegral $ demote @def
+
+instance (SingI def, Fractional a)
+  => SingDef (def :: Q) a where
+  demoteDef = fromRational $ demote @def
+
+instance {-# OVERLAPPING #-} KnownSymbol def
+  => SingDef (def :: Symbol) T.Text where
+  demoteDef = demote @def
+
+instance (IsString a, KnownSymbol def) => SingDef (def :: Symbol) a where
+  demoteDef = fromString $ symbolVal (Proxy @def)
+
 
-instance Semigroup (Opt (def :: k)) where
+instance Semigroup (Opt (def :: k) a) where
   Def <> opt = opt
   Some x <> _ = Some x
 
-instance SingDef def => Monoid (Opt def) where
+instance SingDef def a => Monoid (Opt def a) where
   mempty = Def
 
-deriving instance (SingDef def, Show (Demote k))
-  => Show (Opt (def :: k))
+deriving instance (SingDef def a, Show a)
+  => Show (Opt (def :: k) a)
 
-deriving instance (SingDef def, Read (Demote k))
-  => Read (Opt (def :: k))
+deriving instance (SingDef def a, Read a)
+  => Read (Opt (def :: k) a)
 
-deriving instance (SingDef def, Eq (Demote k))
-  => Eq (Opt (def :: k))
+deriving instance (SingDef def a, Eq a)
+  => Eq (Opt (def :: k) a)
 
-deriving instance (SingDef def, Ord (Demote k))
-  => Ord (Opt (def :: k))
+deriving instance (SingDef def a, Ord a)
+  => Ord (Opt (def :: k) a)
 
-instance SingDef def
-  => Default (Opt (def :: k)) where def = Def
+instance SingDef def a
+  => Default (Opt (def :: k) a) where def = Def
 
-instance Num (Demote k)
-  => Num (Opt (def :: k)) where
+instance Num a
+  => Num (Opt (def :: k) a) where
     x + y = Some $ definite x + definite y
     x * y = Some $ definite x * definite y
     abs x = Some $ abs (definite x)
@@ -194,19 +225,19 @@ instance Num (Demote k)
     negate x = Some $ negate (definite x)
     x - y = Some $ definite x - definite y
 
-instance Fractional (Demote k)
-  => Fractional (Opt (def :: k)) where
+instance Fractional a
+  => Fractional (Opt (def :: k) a) where
     recip x = Some $ recip (definite x)
     x / y = Some $ definite x / definite y
     fromRational x = Some $ fromRational x
 
-instance IsString (Demote k)
-  => IsString (Opt (def :: k)) where
+instance IsString a
+  => IsString (Opt (def :: k) a) where
     fromString x = Some $ fromString x
 
-instance IsList (Demote k)
-  => IsList (Opt (def :: k)) where
-    type Item (Opt (def :: k)) = Item (Demote k)
+instance IsList a
+  => IsList (Opt (def :: k) a) where
+    type Item (Opt (def :: k) a) = Item a
     fromList xs = Some $ fromList xs
     fromListN n xs = Some $ fromListN n xs
     toList x = toList $ definite x
@@ -222,19 +253,19 @@ and `Just` maps to `Some`.
 "bar"
 -}
 optionally
-  :: forall {k} def. SingDef def
-  => Maybe (Demote k)
-  -> Opt (def :: k)
+  :: forall {k} def a. SingDef def a
+  => Maybe a
+  -> Opt (def :: k) a
 optionally = maybe Def Some
 
 {- |
 Deconstructs an `Opt` to a `Demote`d value.
 `Def` maps to `demote` @@def@,
 and `Some` maps to its argument.
 -}
-definite :: forall {k} def. Opt (def :: k) -> Demote k
+definite :: forall {k} def a. Opt (def :: k) a -> a
 definite = \case
-  Def -> demote @def
+  Def -> demoteDef @k @def
   Some a -> a
 
 {- |
@@ -244,8 +275,8 @@ and `Some` maps to `pure`,
 inverting `optionally`.
 -}
 perhaps
-  :: forall {k} def m. Alternative m
-  => Opt (def :: k) -> m (Demote k)
+  :: forall {k} def a m. Alternative m
+  => Opt (def :: k) a -> m a
 perhaps = \case
   Def -> empty
   Some a -> pure a