From 22b3db87a27c44abfc5f86bf24ecf8f0afbf23b7 Mon Sep 17 00:00:00 2001 From: Alice Rixte Date: Fri, 12 Dec 2025 17:05:59 +0100 Subject: [PATCH] Use convertible for more defaults. --- .gitignore | 2 + package.yaml | 1 + singletons-default.cabal | 3 +- src/Data/Default/Singletons.hs | 67 +++++++++++++++++----------------- 4 files changed, 39 insertions(+), 34 deletions(-) diff --git a/.gitignore b/.gitignore index 4c9e245..8fc0cb5 100644 --- a/.gitignore +++ b/.gitignore @@ -21,3 +21,5 @@ cabal.project.local cabal.project.local~ .HTF/ .ghc.environment.* +Makefile +.vscode \ No newline at end of file diff --git a/package.yaml b/package.yaml index 71b1644..0b01be1 100644 --- a/package.yaml +++ b/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 +- convertible >= 1.0 && < 1.2 ghc-options: - -Wall - -Wcompat diff --git a/singletons-default.cabal b/singletons-default.cabal index 2e618a8..c1eb013 100644 --- a/singletons-default.cabal +++ b/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 @@ -37,6 +37,7 @@ library ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints build-depends: base >=4.7 && <5 + , convertible >=1.0 && <1.2 , data-default-class >=0.1.2.0 && <1 , singletons >=3.0.2 && <3.1 , singletons-base >=3.1.1 && <3.5 diff --git a/src/Data/Default/Singletons.hs b/src/Data/Default/Singletons.hs index aebf841..d4809c2 100644 --- a/src/Data/Default/Singletons.hs +++ b/src/Data/Default/Singletons.hs @@ -149,43 +149,44 @@ import GHC.TypeLits import Data.Singletons import Data.String import Prelude.Singletons () +import Data.Convertible {- | `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) +type SingDef (def :: k) a = (SingI def, SingKind k, Convertible (Demote k) a) -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 +195,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,9 +223,9 @@ 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 {- | @@ -232,9 +233,9 @@ 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 -> convert $ demote @def Some a -> a {- | @@ -244,8 +245,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 @@ -435,4 +436,4 @@ instance SingKind Q where toSing q = withSomeSing q SomeSing instance (SingI num, SingI denom) => SingI (num :% denom) where - sing = SRational sing sing + sing = SRational sing sing \ No newline at end of file