countable 1.1 → 1.2

raw patch · 10 files changed

+168/−103 lines, 10 files

Files

• changelog.md +9/−0
• countable.cabal +31/−3
• src/Data/Empty.hs +0/−4
• src/Data/Function/Eq.hs +90/−0
• src/Data/Function/Foldable.hs +13/−0
• src/Data/Function/Show.hs +12/−0
• src/Data/Function/Traversable.hs +11/−0
• src/Data/Searchable.hs +0/−96
• test/Count.hs +1/−0
• test/Show.hs +1/−0

@@ -0,0 +1,9 @@+## [1.2] - 2022-04-29+- orphan instances in separate modules++## [1.1] - 2022-04-28+- removed None type (use Void instead)+- new Singular class+- hid Data.Expression++## [1.0] - 2016-06-22

@@ -5,18 +5,42 @@ -- see: https://github.com/sol/hpack  name:           countable-version:        1.1+version:        1.2 synopsis:       Countable, Searchable, Finite, Empty classes-description:     * @class Countable@, for countable types . * @class AtLeastOneCountable@, for countable types that have at least one value . * @class InfiniteCountable@, for infinite countable types . * @class Searchable@, for types that can be searched over. This turns out to include some infinite types, see <http://math.andrej.com/2007/09/28/seemingly-impossible-functional-programs/>. . * @class Finite@, for finite types . * @class Singular@, for singular (n = 1) types . * @class Empty@, for empty (n = 0) types . * @data Nothing@, an empty type . Some orphan instances: . * @(Searchable a,Eq b) => Eq (a -> b)@ / / . * @(Finite t) => Foldable ((->) t)@ / / . * @(Finite a) => Traversable ((->) a)@ / / . * @(Show a,Finite a,Show b) => Show (a -> b)@ / /+description:    * @class Countable@, for countable types+                .+                * @class AtLeastOneCountable@, for countable types that have at least one value+                .+                * @class InfiniteCountable@, for infinite countable types+                .+                * @class Searchable@, for types that can be searched over. This turns out to include some infinite types, see <http://math.andrej.com/2007/09/28/seemingly-impossible-functional-programs/>.+                .+                * @class Finite@, for finite types+                .+                * @class Singular@, for singular (n = 1) types+                .+                * @class Empty@, for empty (n = 0) types+                .+                Some orphan instances (in their own modules):+                .+                * @(Searchable a,Eq b) => Eq (a -> b)@ / /+                .+                * @Finite t => Foldable ((->) t)@ / /+                .+                * @Finite a => Traversable ((->) a)@ / /+                .+                * @(Show a,Finite a,Show b) => Show (a -> b)@ / / category:       Data homepage:       https://github.com/AshleyYakeley/countable bug-reports:    https://github.com/AshleyYakeley/countable/issues author:         Ashley Yakeley maintainer:     <ashley@semantic.org>-copyright:      (c) 2010 Ashley Yakeley+copyright:      (c) 2010-2022 Ashley Yakeley license:        BSD-3-Clause license-file:   LICENSE build-type:     Simple+extra-source-files:+    changelog.md  library   exposed-modules:@@ -24,6 +48,10 @@       Data.Countable       Data.Singular       Data.Empty+      Data.Function.Eq+      Data.Function.Foldable+      Data.Function.Traversable+      Data.Function.Show   other-modules:       Data.Expression   hs-source-dirs:

@@ -1,6 +1,5 @@ module Data.Empty where -import Data.Countable import Data.Searchable import Data.Void @@ -17,6 +16,3 @@  instance (Empty a, Finite b) => Empty (a, b) where     never (a, _) = never a--instance (AtLeastOneCountable a, Finite a, Empty b) => Empty (a -> b) where-    never ab = never (ab countFirst)

@@ -0,0 +1,90 @@+{-# OPTIONS -fno-warn-orphans #-}++module Data.Function.Eq+    (+    ) where++import Data.Countable+import Data.Empty+import Data.Expression+import Data.Foldable hiding (find)+import Data.Function.Traversable ()+import Data.Searchable+import Data.Traversable+import Prelude++instance (Searchable a, Eq b) => Eq (a -> b) where+    p == q = forevery (\a -> p a == q a)++instance (Finite a, Countable b) => Countable (a -> b) where+    countPrevious =+        case isoCountableFn of+            MkIsoCountable encode decode -> (fmap decode) . countPrevious . encode+    countMaybeNext =+        case isoCountableFn of+            MkIsoCountable encode decode -> (fmap decode) . countMaybeNext . (fmap encode)++instance (Finite a, AtLeastOneCountable b) => AtLeastOneCountable (a -> b) where+    countFirst = \_ -> countFirst++setpair :: (Eq a) => (a, b) -> (a -> b) -> (a -> b)+setpair (a', b') _ a+    | a == a' = b'+setpair _ ab a = ab a++data IsoCountable x =+    forall l. (Countable l) =>+                  MkIsoCountable (x -> l)+                                 (l -> x)++isoCountableFn :: (Finite a, Countable b) => IsoCountable (a -> b)+isoCountableFn = makeFromList allValues+  where+    makeFromList :: (Eq a, Countable b) => [a] -> IsoCountable (a -> b)+    makeFromList [] = MkIsoCountable (\_ -> ()) (\a -> seq a undefined)+    makeFromList (a:as) =+        case makeFromList as of+            MkIsoCountable encode decode ->+                MkIsoCountable (\ab -> (ab a, encode ab)) (\(b, l) -> setpair (a, b) (decode l))++data IsoInfiniteCountable x =+    forall l. (InfiniteCountable l) =>+                  MkIsoInfiniteCountable (x -> l)+                                         (l -> x)++isoInfiniteCountableFn :: (Finite a, AtLeastOneCountable a, InfiniteCountable b) => IsoInfiniteCountable (a -> b)+isoInfiniteCountableFn = makeFromList allValues+  where+    makeFromList :: (Eq a, InfiniteCountable b) => [a] -> IsoInfiniteCountable (a -> b)+    makeFromList [] = undefined+    makeFromList [a] = MkIsoInfiniteCountable (\ab -> ab a) (\b -> setpair (a, b) (\a' -> seq a' undefined))+    makeFromList (a:as) =+        case makeFromList as of+            MkIsoInfiniteCountable encode decode ->+                MkIsoInfiniteCountable (\ab -> (ab a, encode ab)) (\(b, l) -> setpair (a, b) (decode l))++instance (Finite a, AtLeastOneCountable a, InfiniteCountable b) => InfiniteCountable (a -> b) where+    countNext =+        case isoInfiniteCountableFn of+            MkIsoInfiniteCountable encode decode -> decode . countNext . (fmap encode)++instance (Finite a, Finite b) => Finite (a -> b) where+    allValues = sequenceA (\_ -> allValues)+    assemble abfr =+        runValueExpression+            (Data.Foldable.foldr assemble1 (\ab -> ClosedExpression (abfr ab)) allValues (\_ -> error "missing value"))+      where+            -- assemble1 :: a -> ((a -> b) -> Expression a b f r) -> (a -> b) -> Expression a b f r+        assemble1 a0 aber x =+            OpenExpression+                a0+                (assemble+                     (\b0 ->+                          aber+                              (\a ->+                                   if a == a0+                                       then b0+                                       else x a)))++instance (AtLeastOneCountable a, Finite a, Empty b) => Empty (a -> b) where+    never ab = never (ab countFirst)

@@ -0,0 +1,13 @@+{-# OPTIONS -fno-warn-orphans #-}++module Data.Function.Foldable+    (+    ) where++import Data.Foldable hiding (find)+import Data.Monoid+import Data.Searchable+import Prelude++instance Finite t => Foldable ((->) t) where+    foldMap am ta = mconcat (fmap (am . ta) allValues)

@@ -0,0 +1,12 @@+{-# OPTIONS -fno-warn-orphans #-}++module Data.Function.Show+    (+    ) where++import Data.List+import Data.Searchable+import Prelude++instance (Show a, Finite a, Show b) => Show (a -> b) where+    show f = "{" ++ (intercalate "," (fmap (\a -> (show a) ++ "->" ++ (show (f a))) allValues)) ++ "}"

@@ -0,0 +1,11 @@+{-# OPTIONS -fno-warn-orphans #-}++module Data.Function.Traversable+    (+    ) where++import Data.Function.Foldable ()+import Data.Searchable++instance Finite a => Traversable ((->) a) where+    sequenceA = assemble

@@ -1,14 +1,3 @@-{-# OPTIONS -fno-warn-orphans #-}---- | This module also includes these orphan instances:------ * @('Searchable' a,'Eq' b) => 'Eq' (a -> b)@ / /------ * @('Finite' t) => 'Foldable' ((->) t)@ / /------ * @('Finite' a) => 'Traversable' ((->) a)@ / /------ * @('Show' a,'Finite' a,'Show' b) => 'Show' (a -> b)@ / / module Data.Searchable     ( Searchable(..)     , forsome@@ -21,12 +10,9 @@  import Control.Applicative import Data.Countable-import Data.Expression-import Data.Foldable hiding (find) import Data.Int import Data.List import Data.Maybe-import Data.Monoid import Data.Traversable import Data.Void import Data.Word@@ -89,9 +75,6 @@                 in csmx (findcs csmx)             Nothing -> Nothing -instance (Searchable a, Eq b) => Eq (a -> b) where-    p == q = forevery (\a -> p a == q a)- -- | There are a finite number of values (possibly zero). class (Searchable a, Countable a) => Finite a where     -- | Not necessarily in counting order.@@ -108,12 +91,6 @@             | a == a' = b         listLookup (_:l) a' = listLookup l a' -instance (Finite t) => Foldable ((->) t) where-    foldMap am ta = mconcat (fmap (am . ta) allValues)--instance (Finite a) => Traversable ((->) a) where-    sequenceA = assemble- firstJust :: [Maybe a] -> Maybe a firstJust [] = Nothing firstJust ((Just a):_) = Just a@@ -230,76 +207,3 @@ instance (Finite a, Finite b) => Finite (a, b) where     allValues = liftA2 (,) allValues allValues     assemble abfr = fmap (\abr (a, b) -> abr a b) (assemble (\a -> assemble (\b -> abfr (a, b))))--setpair :: (Eq a) => (a, b) -> (a -> b) -> (a -> b)-setpair (a', b') _ a-    | a == a' = b'-setpair _ ab a = ab a--data IsoCountable x =-    forall l. (Countable l) =>-                  MkIsoCountable (x -> l)-                                 (l -> x)--isoCountableFn :: (Finite a, Countable b) => IsoCountable (a -> b)-isoCountableFn = makeFromList allValues-  where-    makeFromList :: (Eq a, Countable b) => [a] -> IsoCountable (a -> b)-    makeFromList [] = MkIsoCountable (\_ -> ()) (\a -> seq a undefined)-    makeFromList (a:as) =-        case makeFromList as of-            MkIsoCountable encode decode ->-                MkIsoCountable (\ab -> (ab a, encode ab)) (\(b, l) -> setpair (a, b) (decode l))--instance (Finite a, Countable b) => Countable (a -> b) where-    countPrevious =-        case isoCountableFn of-            MkIsoCountable encode decode -> (fmap decode) . countPrevious . encode-    countMaybeNext =-        case isoCountableFn of-            MkIsoCountable encode decode -> (fmap decode) . countMaybeNext . (fmap encode)--instance (Finite a, AtLeastOneCountable b) => AtLeastOneCountable (a -> b) where-    countFirst = \_ -> countFirst--data IsoInfiniteCountable x =-    forall l. (InfiniteCountable l) =>-                  MkIsoInfiniteCountable (x -> l)-                                         (l -> x)--isoInfiniteCountableFn :: (Finite a, AtLeastOneCountable a, InfiniteCountable b) => IsoInfiniteCountable (a -> b)-isoInfiniteCountableFn = makeFromList allValues-  where-    makeFromList :: (Eq a, InfiniteCountable b) => [a] -> IsoInfiniteCountable (a -> b)-    makeFromList [] = undefined-    makeFromList [a] = MkIsoInfiniteCountable (\ab -> ab a) (\b -> setpair (a, b) (\a' -> seq a' undefined))-    makeFromList (a:as) =-        case makeFromList as of-            MkIsoInfiniteCountable encode decode ->-                MkIsoInfiniteCountable (\ab -> (ab a, encode ab)) (\(b, l) -> setpair (a, b) (decode l))--instance (Finite a, AtLeastOneCountable a, InfiniteCountable b) => InfiniteCountable (a -> b) where-    countNext =-        case isoInfiniteCountableFn of-            MkIsoInfiniteCountable encode decode -> decode . countNext . (fmap encode)--instance (Finite a, Finite b) => Finite (a -> b) where-    allValues = sequenceA (\_ -> allValues)-    assemble abfr =-        runValueExpression-            (Data.Foldable.foldr assemble1 (\ab -> ClosedExpression (abfr ab)) allValues (\_ -> error "missing value"))-      where-            -- assemble1 :: a -> ((a -> b) -> Expression a b f r) -> (a -> b) -> Expression a b f r-        assemble1 a0 aber x =-            OpenExpression-                a0-                (assemble-                     (\b0 ->-                          aber-                              (\a ->-                                   if a == a0-                                       then b0-                                       else x a)))--instance (Show a, Finite a, Show b) => Show (a -> b) where-    show f = "{" ++ (intercalate "," (fmap (\a -> (show a) ++ "->" ++ (show (f a))) allValues)) ++ "}"

@@ -8,6 +8,7 @@ import Test.Tasty.HUnit  import Data.Countable+import Data.Function.Eq () import Data.Searchable  import Golden

@@ -1,5 +1,6 @@ module Show where +import Data.Function.Show () import Data.Searchable  showFunction :: (Show a, Finite a, Show b) => (a -> b) -> String