enumerate-function (empty) → 0.0.0

raw patch · 21 files changed

+1497/−0 lines, 21 filesdep +MemoTriedep +QuickCheckdep +basesetup-changed

Dependencies added: MemoTrie, QuickCheck, base, containers, criterion, deepseq, doctest, enumerate, enumerate-function, exceptions, hspec, semigroups

Files

• .gitignore +34/−0
• .travis.yml +14/−0
• HLint.hs +9/−0
• LICENSE +31/−0
• README.md +6/−0
• Setup.hs +3/−0
• benchmarks/Bench.hs +10/−0
• enumerate-function.cabal +165/−0
• executables/Main.hs +4/−0
• sources/Enumerate/Function.hs +69/−0
• sources/Enumerate/Function/Example.hs +100/−0
• sources/Enumerate/Function/Extra.hs +135/−0
• sources/Enumerate/Function/Invert.hs +231/−0
• sources/Enumerate/Function/Map.hs +303/−0
• sources/Enumerate/Function/Reify.hs +161/−0
• sources/Enumerate/Function/Types.hs +92/−0
• sources/Enumerate/Orphans/Function.hs +91/−0
• stack.yaml +10/−0
• tests/DocTest.hs +21/−0
• tests/Enumerate/Test.hs +6/−0
• tests/UnitTest.hs +2/−0

@@ -0,0 +1,34 @@+# my+ignore/+notes+goals+TODO+cbits/main+.projectile++# Haskell+dist+cabal-dev+*.o+*.hi+*.chi+*.chs.h+.virtualenv+.hsenv+.cabal-sandbox/+cabal.sandbox.config+cabal.config+report.html+.stack-work/++# Emacs+\#*+*~+.#*+\#*\#+*.log+TAGS++# OS X+.DS_Store+

@@ -0,0 +1,14 @@+# https://docs.travis-ci.com/user/languages/haskell++#   - 8.0+ghc:+  - 7.10+  - 7.8++# install: stack install++# script: stack test++notifications:+  email:+    - samboosalis@gmail.com

@@ -0,0 +1,9 @@+{-# LANGUAGE PackageImports, TemplateHaskell #-}+import "hint" HLint.Default+import "hint" HLint.Dollar+import "hint" HLint.Generalise+ignore "Use unwords"+ignore "Use map once"+ignore "Use =<<"+ignore "Functor law"+

@@ -0,0 +1,31 @@+Copyright Spiros Boosalis (c) 2015++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Spiros Boosalis nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+

@@ -0,0 +1,6 @@+[![Build Status](https://secure.travis-ci.org/sboosali/enumerate-function.svg)](http://travis-ci.org/sboosali/enumerate-function)+[![Hackage](https://img.shields.io/hackage/v/enumerate-function.svg)](https://hackage.haskell.org/package/enumerate-function)++# enumerate-function++TODO

@@ -0,0 +1,3 @@+import Distribution.Simple+main = defaultMain+

@@ -0,0 +1,10 @@+import Enumerate()+import Criterion.Main++main = defaultMain [+  bgroup "Enumerate"+    [ bench "1" $ nf   length [1..1000::Int]+    , bench "2" $ whnf length [1..1000::Int]+    ]+  ]+

@@ -0,0 +1,165 @@+name:                enumerate-function+version:             0.0.0+synopsis:            TODO+description:         TODO+homepage:            http://github.com/sboosali/enumerate-function#readme+license:             BSD3+license-file:        LICENSE+author:              Spiros Boosalis+maintainer:          samboosalis@gmail.com+copyright:           2016 Spiros Boosalis+category:            TODO+build-type:          Simple+cabal-version:       >=1.10++-- $ stack new PACKAGE spirosboosalis.hsfiles -p "module:MODULE"++extra-source-files:+  README.md+  .gitignore+  .travis.yml+  HLint.hs+  stack.yaml++--data-files:++--  data/++source-repository head+  type:     git+  location: https://github.com/sboosali/enumerate-function+++library+ hs-source-dirs:      sources+ default-language:    Haskell2010+ ghc-options:         -Wall -fno-warn-unticked-promoted-constructors+ default-extensions: AutoDeriveTypeable DeriveDataTypeable DeriveGeneric+                     DeriveFunctor DeriveFoldable DeriveTraversable+                     LambdaCase EmptyCase TypeOperators PostfixOperators+                     ViewPatterns BangPatterns KindSignatures+                     NamedFieldPuns RecordWildCards TupleSections+                     MultiWayIf DoAndIfThenElse EmptyDataDecls+                     MultiParamTypeClasses FlexibleContexts FlexibleInstances+                     TypeFamilies FunctionalDependencies+                     ScopedTypeVariables StandaloneDeriving++ exposed-modules:+  Enumerate.Function+  Enumerate.Function.Types+  Enumerate.Function.Map+  Enumerate.Function.Reify+  Enumerate.Function.Invert++  Enumerate.Orphans.Function++ -- (for doctest / haddocks / exectuable) other-modules:+  Enumerate.Function.Extra+  Enumerate.Function.Example++ build-depends:+    base >=4.7 && <5++  , enumerate +   -- >=0.2.2++  , containers >=0.5+++  , semigroups >=0.18+  , exceptions >=0.8+  , MemoTrie >=0.6+  , deepseq >= 1.3++  -- ,+  -- , transformers+  -- , mtl+  -- , bytestring+  -- , stm+  -- , template-haskell++  -- ,+  -- , lens+  -- , exceptions+  -- , free+  -- , bifunctors+  -- , profunctors+  -- , either+  -- , pipes+  -- , formatting+  -- , servant+  -- , Earley+  -- , split+  -- , interpolatedstring-perl6+  -- , wl-pprint-text+  -- , text+  -- , aeson+  -- , hashable+  -- , unordered-containers+  -- , async+  -- , parallel+++-- $ stack build && stack exec -- example-enumerate-function+executable example-enumerate-function+ hs-source-dirs:      executables+ main-is:             Main.hs++ default-language:    Haskell2010+ ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N++ build-depends:+    base+  , enumerate-function+++-- $ stack test doctest+test-suite doctest+ hs-source-dirs:      tests+ main-is:             DocTest.hs+ type:                exitcode-stdio-1.0++ default-language:    Haskell2010+ ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N++ build-depends:+    base+  , enumerate-function+  , doctest+++-- $ stack test unittest+test-suite unittest+ hs-source-dirs:      tests+ main-is:             UnitTest.hs+ type:                exitcode-stdio-1.0++ default-language:    Haskell2010+ ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N++ other-modules:+  Enumerate.Test++ build-depends:+    base+  , enumerate-function+  , hspec ==2.2.*+  , QuickCheck ==2.8.*+  -- , tasty+  -- , tasty-quickcheck+++-- $ stack bench+benchmark command+ hs-source-dirs:      benchmarks+ main-is:             Bench.hs+ type:                exitcode-stdio-1.0++ default-language: Haskell2010+ ghc-options:      -Wall -threaded -rtsopts -with-rtsopts=-N++ build-depends:+    base+  , enumerate-function+  , criterion+  , deepseq

@@ -0,0 +1,4 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+import qualified Enumerate.Function.Example++main = Enumerate.Function.Example.main

@@ -0,0 +1,69 @@+{-|++e.g.++1. given:++@+data Edit = Edit Action Slice Region+ deriving (Show,Read,Eq,Ord,Generic,Enumerable)++data Action+ = Transpose+ | Copy+ | Delete+ deriving (Show,Read,Eq,Ord,Enum,Bounded,Generic,Enumerable)++data Slice+ = Whole+ | Backwards+ | Forwards+ deriving (Show,Read,Eq,Ord,Enum,Bounded,Generic,Enumerable)++data Region+ = Character+ | Token+ | Line+ deriving (Show,Read,Eq,Ord,Enum,Bounded,Generic,Enumerable)+@++we can enumerate every possible editing action:++@+> 'enumerated' :: [Edit]+@++2. given a mapping to keyboard shortcuts within emacs:++@+type KeyBinding = [String]+emacsEdit :: Edit -> KeyBinding+@++the `enumerate-function` package can:++* verify that @emacsEdit@ doesn't map different editing actions+to the same keybindings, which would mean that one would shadow the other+i.e. it has no collisions; i.e. it's is injective.+* TODO verify that @emacsEdit@ maps every editing action to some keybinding,+which asserts that the relevant application supports `Edit`ing in its entirety.+(e.g. `Emacs` can, `Chrome` can't); i.e. it's is surjective.+* detect whether @emacsEdit@ is actually total; i.e.+free of bottoms. Haskell's exhaustivity checker (enable `-Wall`) can verify the+totality of @emacsEdit@, assuming no partial functions.+* serialize @emacsEdit@ into a mapping,+from which `elisp` source can be extracted.++(also see the source of "Enumerate.Function.Example")++-}+module Enumerate.Function+ ( module Enumerate.Function.Types+ , module Enumerate.Function.Reify+ , module Enumerate.Function.Map+ , module Enumerate.Function.Invert+ ) where+import Enumerate.Function.Types+import Enumerate.Function.Reify+import Enumerate.Function.Map+import Enumerate.Function.Invert

@@ -0,0 +1,100 @@+{-# LANGUAGE DeriveAnyClass, DeriveGeneric, LambdaCase #-}+{-|++-}+module Enumerate.Function.Example where+import Enumerate.Types+import Enumerate.Function.Extra+import Enumerate.Function++{-+stack build && stack exec -- enumerate-function-example+-}+main = do++  putStrLn "\nenumerating domain...\n"+  traverse_ print (enumerated :: [Edit])++  putStrLn "\nserializing function...\n"+  putStrLn $ displayFunction emacsEdit++  putStrLn "\nserializing inverse...\n"+  traverse_ putStrLn $ displayInjective emacsEdit++  putStrLn "\ndetecting jectivity..."+  case isInjective emacsEdit of+    Nothing             -> print $ "`emacsEdit` is non-injective"+    Just fromKeyBinding -> do+      putStrLn $ "`emacsEdit` is injective:\n"++      let aKeyBinding = ["C-<spc>","M-b","C-w"]+      let anEdit = fromKeyBinding aKeyBinding+      putStrLn $ intercalate " " ["", show aKeyBinding, "<-", show anEdit]++  -- no instance (Enumerable KeyBinding)+  -- case isSurjective emacsEdit of+  --   Nothing             -> do+  --     print $ "`emacsEdit` is non-surjective (there are infinitely many strings)"+  --   Just fromKeyBinding -> do+  --     putStrLn $ "`emacsEdit` is surjective:\n"++data Edit = Edit Action Slice Region+ deriving (Show,Read,Eq,Ord,Generic,Enumerable)++data Action+ = Cut+ | Delete+ | Transpose+ deriving (Show,Read,Eq,Ord,Enum,Bounded,Generic,Enumerable)++data Slice+ = Whole+ | Backwards+ | Forwards+ deriving (Show,Read,Eq,Ord,Enum,Bounded,Generic,Enumerable)++data Region+ = Character+ | Token+ | Line+ deriving (Show,Read,Eq,Ord,Enum,Bounded,Generic,Enumerable)++type KeyBinding = [String]++emacsEdit :: Edit -> KeyBinding+emacsEdit = \case+ Edit Transpose _     region -> emacsTranspose region+ Edit Cut       slice region -> emacsSelect region slice ++ ["C-w"]+ Edit Delete    slice region -> emacsSelect region slice ++ ["<del>"]++emacsTranspose :: Region -> KeyBinding+emacsTranspose = \case+ Character -> ["C-t"]+ Token     -> ["M-t"]+ Line      -> ["C-x-t"]++emacsSelect :: Region -> Slice -> KeyBinding+emacsSelect region = \case+ Whole     -> emacsBeginRegion region ++ emacsMark ++ emacsEndRegion region+ Backwards -> emacsMark ++ emacsBeginRegion region+ Forwards  -> emacsMark ++ emacsEndRegion region+ where+ emacsMark = ["C-<spc>"]++emacsBeginRegion :: Region -> KeyBinding+emacsBeginRegion = \case+ Character -> ["<left>"]+ Token     -> ["M-b"]+ Line      -> ["C-a"]++emacsEndRegion :: Region -> KeyBinding+emacsEndRegion = \case+ Character -> ["<right>"]+ Token     -> ["M-f"]+ Line      -> ["C-e"]++-- chromeEdit :: Partial Edit KeyBinding+-- chromeEdit = maybe2throw <<< \case+--  Edit Transpose _     region -> Nothing+--  Edit Cut       slice region -> chromeSelect region slice ++ ["M-c"]+--  Edit Delete    slice region -> chromeSelect region slice ++ ["<del>"]

@@ -0,0 +1,135 @@+{-# LANGUAGE RankNTypes, LambdaCase, ScopedTypeVariables #-}+module Enumerate.Function.Extra+ ( module Enumerate.Function.Extra++ , module Control.DeepSeq+ , module Data.Semigroup++ , module GHC.Generics+ , module Data.Data+ , module Control.Arrow++ , module Data.Function+ , module Data.List+ , module Data.Foldable+ ) where++import Data.Semigroup (Semigroup)+import Control.DeepSeq (NFData(..), deepseq)+import Control.Monad.Catch (MonadThrow(..), SomeException(..))++import GHC.Generics (Generic)+import Data.Data (Data)+import Control.Arrow ((>>>),(<<<))+import System.IO.Unsafe (unsafePerformIO)+import Control.Exception (catches, throwIO, Handler(..), AsyncException, ArithException, ArrayException, ErrorCall, PatternMatchFail)++import Data.Function ((&))+import Data.List (intercalate)+import Data.Foldable (traverse_)+++nothing :: (Monad m) => m ()+nothing = return ()++maybe2bool :: Maybe a -> Bool+maybe2bool = maybe False (const True)++either2maybe :: Either e a -> Maybe a+either2maybe = either (const Nothing) Just++either2bool :: Either e a -> Bool+either2bool = either (const False) (const True)++{-| @failed = 'throwM' . 'userError'@++-}+failed ::  (MonadThrow m) => String -> m a+failed = throwM . userError++-- | generalize a function that fails with @Nothing@.+maybe2throw :: (a -> Maybe b) -> (forall m. MonadThrow m => a -> m b)+maybe2throw f = f >>> \case+ Nothing -> failed "Nothing"+ Just x  -> return x++-- | generalize a function that fails with @[]@.+list2throw :: (a -> [b]) -> (forall m. MonadThrow m => a -> m b)+list2throw f = f >>> \case+ []    -> failed "[]"++ (x:_) -> return x++-- | generalize a function that fails with @Left@.+either2throw :: (a -> Either SomeException b) -> (forall m. MonadThrow m => a -> m b)+either2throw f = f >>> \case+ Left  e -> throwM e+ Right x -> return x++{-| specialization -}+throw2maybe :: (forall m. MonadThrow m => a -> m b) -> (a -> Maybe b)+throw2maybe = id++{-| specialization -}+throw2either :: (forall m. MonadThrow m => a -> m b) -> (a -> Either SomeException b)+throw2either = id++{-| specialization -}+throw2list :: (forall m. MonadThrow m => a -> m b) -> (a -> [b])+throw2list = id++{-| makes an *unsafely*-partial function+(i.e. a function that throws exceptions or+that has inexhaustive pattern matching)+into a *safely*-partial function+(i.e. that explicitly returns in a monad that supports failure).++-}+totalizeFunction :: (NFData b, MonadThrow m) => (a -> b) -> (a -> m b)+totalizeFunction f = g+ where g x = spoonWith defaultPartialityHandlers (f x)++{-| handles the following exceptions:++* 'ArithException'+* 'ArrayException'+* 'ErrorCall'+* 'PatternMatchFail'++-}+defaultPartialityHandlers :: (MonadThrow m) => [Handler (m a)]+defaultPartialityHandlers =+    [ Handler $ \(e :: AsyncException)   -> throwIO e -- TODO I hope they are tried in order+    , Handler $ \(e :: ArithException)   -> return (throwM e)+    , Handler $ \(e :: ArrayException)   -> return (throwM e)+    , Handler $ \(e :: ErrorCall)        -> return (throwM e)+    , Handler $ \(e :: PatternMatchFail) -> return (throwM e)+    , Handler $ \(e :: SomeException)    -> return (throwM e) -- TODO is catchall okay? why is this here?+    ]+{-# INLINEABLE defaultPartialityHandlers #-}++{-| Evaluate a value to normal form and 'throwM' any exceptions are thrown+during evaluation. For any error-free value, @spoon = Just@.++(taken from the+<https://hackage.haskell.org/package/spoon-0.3.1/docs/Control-Spoon.html spoon>+package.)++-}+spoonWith :: (NFData a, MonadThrow m) => [Handler (m a)] -> a -> m a+spoonWith handlers a = unsafePerformIO $ do+ (a `deepseq` (return `fmap` return a)) `catches` handlers+{-# INLINEABLE spoonWith #-}++{- | the eliminator as a function and the introducer as a string++helper for declaring Show instances of datatypes without+visible constructors (like @Map@ which is shown as a list).++-}+showsPrecWith :: (Show b) => String -> (a -> b) -> Int -> a -> ShowS+showsPrecWith stringFrom functionInto p x = showParen (p > 10) $+  showString stringFrom . showString " " . shows (functionInto x)+-- showsPrecWith :: (Show a, Show b) => Name -> (a -> b) -> Int -> a -> ShowS+-- showsPrecWith nameFrom functionInto p x = showParen (p > 10) $+--   showString (nameBase nameFrom) . showString " " . shows (functionInto x)

@@ -0,0 +1,231 @@+{-# LANGUAGE RankNTypes #-}+module Enumerate.Function.Invert where+import Enumerate.Types+import Enumerate.Function.Types+import Enumerate.Function.Reify++import           Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as NonEmpty+import Data.Semigroup                   ((<>))++import qualified Data.Map as Map+import           Data.Map (Map)+import qualified Data.Set as Set+import           Data.Set (Set)+import           Data.Maybe (fromJust, mapMaybe, listToMaybe)+++{- | convert a total function to a map.++@+>>> fromFunction not  -- Prelude 'not'+fromList [(False,True),(True,False)]++@++-}+fromFunction :: (Enumerable a, Ord a) => (a -> b) -> Map a b+fromFunction f = fromFunctionM (return.f)+{-# INLINABLE fromFunction #-}++{- | convert a (safely-)partial function to a map.++wraps 'reifyFunctionM'.++-}+fromFunctionM :: (Enumerable a, Ord a) => (Partial a b) -> Map a b+fromFunctionM f = Map.fromList (reifyFunctionM f)+{-# INLINABLE fromFunctionM #-}++{-| does the map contain every key in its domain?++>>> isMapTotal (Map.fromList [(False,True),(True,False)])+True++>>> isMapTotal (Map.fromList [('a',0)])+False++-}+isMapTotal :: (Enumerable a, Ord a) => Map a b -> Bool+isMapTotal m = all (\x -> Map.member x m) enumerated++{-| safely invert any map.++-}+invertMap :: (Ord a, Ord b) => Map a b -> Map b (NonEmpty a)+invertMap m = Map.fromListWith (<>) [(b, a:|[]) | (a, b) <- Map.toList m]++{-| the <https://en.wikipedia.org/wiki/Partial_function#Basic_concepts domain> of a partial function+is the subset of the 'enumerated' input where it's defined.++i.e. when @x \`member\` (domainM f)@ then @fromJust (f x)@ is defined.++>>> domainM uppercasePartial+['a','b','z']++-}+domainM :: (Enumerable a) => (Partial a b) -> [a]+domainM f = foldMap go enumerated+ where+ go a = case f a of+   Nothing -> []+   Just{}  -> [a]++{-| (right name?)++@corange _ = enumerated@++-}+corange :: (Enumerable a) => (a -> b) -> [a]+corange _ = enumerated++{-|++@corangeM _ = enumerated@++-}+corangeM :: (Enumerable a) => (Partial a b) -> [a]+corangeM _ = enumerated++{-| the image of a total function.++@imageM f = map f 'enumerated'@++includes duplicates.++-}+image :: (Enumerable a) => (a -> b) -> [b]+image f = map f enumerated++{-| the image (not the 'codomain') of a partial function.++@imageM f = mapMaybe f 'enumerated'@++includes duplicates.++-}+imageM :: (Enumerable a) => (Partial a b) -> [b]+imageM f = mapMaybe f enumerated++{-| the codomain of a function. it contains the 'image'.++@codomain _ = enumerated@++-}+codomain :: (Enumerable b) => (a -> b) -> [b]+codomain _ = enumerated++codomainM :: (Enumerable b) => (Partial a b) -> [b]+codomainM _ = enumerated++{-| invert a total function.++@(invert f) b@ is:++* @[]@ wherever @f@ is not surjective+* @[y]@ wherever @f@ is uniquely defined+* @(_:_)@ wherever @f@ is not injective++@invert f = 'invertM' (return.f)@++-}+invert :: (Enumerable a, Ord a, Ord b) => (a -> b) -> (b -> [a])+invert f = invertM (return.f)++{-| invert a partial function.++@(invertM f) b@ is:++* @[]@ wherever @f@ is partial+* @[]@ wherever @f@ is not surjective+* @[y]@ wherever @f@ is uniquely defined+* @(_:_)@ wherever @f@ is not injective++a @Map@ is stored internally, with as many keys as the 'image' of @f@.++see also 'isBijectiveM'.++-}+invertM :: (Enumerable a, Ord a, Ord b) => (Partial a b) -> (b -> [a])+invertM f = g+ where+ g b = maybe [] NonEmpty.toList (Map.lookup b m)+ m = invertMap (fromFunctionM f) -- share the map++{-|++-}+getJectivityM :: (Enumerable a, Enumerable b, Ord a, Ord b) => (Partial a b) -> Maybe Jectivity+getJectivityM f+ = case isBijectiveM f of       -- TODO pick the right Monoid, whose append picks the first non-nothing+    Just{}  -> Just Bijective+    Nothing -> case isInjectiveM f of+                Just{}  -> Just Injective+                Nothing -> case isSurjectiveM f of+                            Just{}  -> Just Surjective+                            Nothing -> Nothing+++isInjective :: (Enumerable a, Ord a, Ord b) => (a -> b) -> Maybe (b -> Maybe a)+isInjective f = isInjectiveM (return.f)++{-| returns the inverse of the injection, if injective.++refines @(b -> [a])@ (i.e. the type of 'invertM') to @(b -> Maybe a)@.++unlike 'isBijectiveM', doesn't need an @(Enumerable b)@ constraint. this helps when you want to ensure a function into an infinite type (e.g. 'show') is injective. and still reasonably efficient, given the @(Ord b)@ constraint.++-}+isInjectiveM :: (Enumerable a, Ord a, Ord b) => (Partial a b) -> Maybe (b -> Maybe a)+isInjectiveM f = do             -- TODO make it "correct by construction", rather than explicit validation+ _bs <- isUnique (imageM f)   -- Map.fromListWith (<>) [(b, a:|[]) | (a, b) <- Map.toList m]+ return g+ where+ g = listToMaybe . invertM f+-- can short-circuit.++{-| converts the list into a set, if it has no duplicates.++-}+isUnique :: (Ord a) => [a] -> Maybe (Set a)+isUnique l = if length l == length s then Nothing else Just s -- TODO make efficient, maybe single pass with Control.Foldl+ where+ s = Set.fromList l++isSurjective :: (Enumerable a, Enumerable b, Ord a, Ord b) => (a -> b) -> Maybe (b -> NonEmpty a)+isSurjective f = isSurjectiveM (return.f)++{-| returns the inverse of the surjection, if surjective.+i.e. when a function's 'codomainM' equals its 'imageM'.++refines @(b -> [a])@ (i.e. the type of 'invertM') to @(b -> NonEmpty a)@.++can short-circuit.++-}+isSurjectiveM :: (Enumerable a, Enumerable b, Ord a, Ord b) => (Partial a b) -> Maybe (b -> NonEmpty a)+isSurjectiveM f =  -- TODO make it "correct by construction", rather than explicit validation+ if (Set.fromList (codomainM f)) `Set.isSubsetOf` (Set.fromList (imageM f))  -- the reverse always holds, no need to check+ then Just g+ else Nothing+ where+ g = NonEmpty.fromList . invertM f  -- safe, by validation+++isBijective :: (Enumerable a, Enumerable b, Ord a, Ord b) => (a -> b) -> Maybe (b -> a)+isBijective f = isBijectiveM (return.f)++{-| returns the inverse of the bijection, if bijective.++refines @(b -> [a])@ (i.e. the type of 'invertM') to @(b -> a)@.++can short-circuit.++-}+isBijectiveM :: (Enumerable a, Enumerable b, Ord a, Ord b) => (Partial a b) -> Maybe (b -> a)+isBijectiveM f = do+ fIn    <- isInjectiveM f+ _fSur  <- isSurjectiveM f --   TODO avoid re-computing invertM. isInjectiveWithM isSurjectiveWithM+ let fBi = (fromJust . fIn)  -- safe, because the intersection of "zero or one" with "one or more" is "one"+ return fBi+-- let fOp = invertMap (fromFunctionM f) -- share the map

@@ -0,0 +1,303 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes, LambdaCase, TupleSections #-}+{-| converting between partial functions and maps.++@(for doctest)@++>>> :set +m+>>> :set -XLambdaCase+>>> :{+let uppercasePartial :: (MonadThrow m) => Char -> m Char  -- :: Partial Char Char+    uppercasePartial = \case+     'a' -> return 'A'+     'b' -> return 'B'+     'z' -> return 'Z'+     _   -> failed "uppercasePartial"+:}++a (safely-)partial function is isomorphic with a @Map@:++@+'fromFunctionM' . 'toFunctionM' = 'id'+'toFunctionM' . 'fromFunctionM' = 'id'+@++modulo the error thrown.++-}+module Enumerate.Function.Map where+import Enumerate.Types+import Enumerate.Function.Extra+import Enumerate.Function.Types+import Enumerate.Function.Reify+import Enumerate.Function.Invert++import Control.Monad.Catch (MonadThrow(..))++-- import GHC.TypeLits (Nat, type (^))+import qualified Data.Map as Map+import           Data.Map (Map)+import           Control.Exception(PatternMatchFail(..))+import           Data.Proxy+import           Numeric.Natural+import           Data.Maybe (fromJust)+++{- | convert a map to a function, if the map is total.++>>> let (Just not_) = toFunction (Map.fromList [(False,True),(True,False)])+>>> not_ False+True++-}+toFunction :: (Enumerable a, Ord a) => Map a b -> Maybe (a -> b)+toFunction m = if isMapTotal m then Just f else Nothing+ where f = unsafeToFunction m -- the fromJust is safe when the map is total+{-# INLINABLE toFunction #-}++{- | convert a (safely-)partial function to a map.++lookup failures are 'throwM'n as a 'PatternMatchFail'.++>>> let idPartial = toFunctionM (Map.fromList [(True,True)])+>>> idPartial True+True++>>> idPartial False+*** Exception: toFunctionM++-}+toFunctionM :: (Enumerable a, Ord a) => Map a b -> (Partial a b)+toFunctionM m = f+ where+ f x = maybe (throwM (PatternMatchFail "toFunctionM")) return (Map.lookup x m)+{-# INLINABLE toFunctionM #-}++{-| wraps 'Map.lookup'++-}+unsafeToFunction :: (Ord a) => Map a b -> (a -> b)+unsafeToFunction m x = fromJust (Map.lookup x m)+{-# INLINABLE unsafeToFunction #-}+++{-| refines the partial function, if total.++>>> :{+let myNotM :: Monad m => Bool -> m Bool+    myNotM False = return True+    myNotM True  = return False+:}+>>> let (Just myNot) = isTotalM myNotM+>>> myNot False+True++-}+isTotalM :: (Enumerable a, Ord a) => (Partial a b) -> Maybe (a -> b)+isTotalM f = (toFunction) (fromFunctionM f)++--------------------------------------------------------------------------------+{-| wraps 'Map.lookup'++>>> (unsafeFromList [(False,True),(True,False)]) False+True+>>> (unsafeFromList [(False,True),(True,False)]) True+False++-}+unsafeFromList+ :: (Ord a)+ => [(a,b)]+ -> (a -> b)+unsafeFromList+ = unsafeToFunction . Map.fromList+{-# INLINABLE unsafeFromList #-}++{-| see 'mappingEnumeratedAt' -}+functionEnumerated+ :: (Enumerable a, Enumerable b, Ord a, Ord b)+ => [a -> b]+functionEnumerated = functions+ where+ functions = (unsafeToFunction . Map.fromList) <$> mappings+ mappings = mappingEnumeratedAt enumerated enumerated++-- | @|b| ^ |a|@+functionCardinality+ :: forall a b proxy. (Enumerable a, Enumerable b)+ => proxy (a -> b)+ -> Natural+functionCardinality _+ = cardinality (Proxy :: Proxy b) ^ cardinality (Proxy :: Proxy a)+{-# INLINABLE functionCardinality #-}++-- | are all pairs of outputs the same for the same input? (short-ciruits).+extensionallyEqual+ :: (Enumerable a, Eq b)+ => (a -> b)+ -> (a -> b)+ -> Bool+extensionallyEqual f g+ = all ((==) <$> f <*> g) enumerated+{-# INLINABLE extensionallyEqual #-}++-- | is any pair of outputs different for the same input? (short-ciruits).+extensionallyUnequal+ :: (Enumerable a, Eq b)+ => (a -> b)+ -> (a -> b)+ -> Bool+extensionallyUnequal f g+ = any ((/=) <$> f <*> g) enumerated+{-# INLINABLE extensionallyUnequal #-}++-- | show all inputs and their outputs, as @unsafeFromList [...]@.+functionShowsPrec+ :: (Enumerable a, Show a, Show b)+ => Int+ -> (a -> b)+ -> ShowS+functionShowsPrec+ = showsPrecWith "unsafeFromList" reifyFunction+{-# INLINABLE functionShowsPrec #-}++-- | show all inputs and their outputs, as @\case ...@.+displayFunction+  :: (Enumerable a, Show a, Show b)+  => (a -> b)+  -> String+displayFunction+    = reifyFunction+  >>> fmap displayCase+  >>> ("\\case":)+  >>> intercalate "\n"+ where+ displayCase (x,y) = intercalate " " ["", show x, "->", show y]++-- displayPartialFunction+--  :: (Enumerable a, Show a, Show b)+--  => (Partial a b)+--  -> String++displayInjective+ :: (Enumerable a, Ord a, Ord b, Show a, Show b)+ => (a -> b)+ -> Maybe String+displayInjective f = case isInjective f of+  Nothing -> Nothing+  Just{}  -> Just (go f)+  where+  go   = reifyFunction+     >>> fmap displayCase+     >>> (["\\case"]++)+     >>> (++[" _ <- Nothing"])+     >>> intercalate "\n"+  displayCase (x,y) = intercalate " " ["", show y, "<-", show (Just x)]++  -- displayInjective f = go <$> isInjective f+  --+  --   where+  --   go   = reifyFunction+  --      >>> fmap displayCase+  --      >>> ("\\case":)+  --      >>> intercalate "\n"+  --   displayCase = \case+  --    (y, Nothing) ->+  --    (y, Just x)  -> intercalate " " ["", show y, " <- ", show x]++{-| @[(a,b)]@ is a mapping, @[[(a,b)]]@ is a list of mappings.++>>> let orderingPredicates = mappingEnumeratedAt [LT,EQ,GT] [False,True]+>>> print $ length orderingPredicates+8+>>> printMappings $ orderingPredicates+<BLANKLINE>+(LT,False)+(EQ,False)+(GT,False)+<BLANKLINE>+(LT,False)+(EQ,False)+(GT,True)+<BLANKLINE>+(LT,False)+(EQ,True)+(GT,False)+<BLANKLINE>+(LT,False)+(EQ,True)+(GT,True)+<BLANKLINE>+(LT,True)+(EQ,False)+(GT,False)+<BLANKLINE>+(LT,True)+(EQ,False)+(GT,True)+<BLANKLINE>+(LT,True)+(EQ,True)+(GT,False)+<BLANKLINE>+(LT,True)+(EQ,True)+(GT,True)++where the (total) mapping:++@+(LT,False)+(EQ,False)+(GT,True)+@++is equivalent to the function:++@+\\case+ LT -> False+ EQ -> False+ GT -> True+@++-}+mappingEnumeratedAt :: [a] -> [b] -> [[(a,b)]]           -- TODO diagonalize? performance?+mappingEnumeratedAt as bs = go (crossProduct as bs)+ where+ go [] = []+ go [somePairs] = do+  pair <- somePairs+  return$ [pair]+ go (somePairs:theProduct) = do+  pair <- somePairs+  theExponent <- go theProduct+  return$ pair : theExponent++{-|++>>> let crossOrderingBoolean = crossProduct [LT,EQ,GT] [False,True]+>>> printMappings $ crossOrderingBoolean+<BLANKLINE>+(LT,False)+(LT,True)+<BLANKLINE>+(EQ,False)+(EQ,True)+<BLANKLINE>+(GT,False)+(GT,True)++the length of the outer list is the size of the first set, and+the length of the inner list is the size of the second set.++>>> print $ length crossOrderingBoolean+3+>>> print $ length (head crossOrderingBoolean)+2++-}+crossProduct :: [a] -> [b] -> [[(a,b)]]+crossProduct [] _ = []+crossProduct (aValue:theDomain) theCodomain =+ fmap (aValue,) theCodomain : crossProduct theDomain theCodomain

@@ -0,0 +1,161 @@+{-# LANGUAGE RankNTypes, LambdaCase #-}+{-| see 'reifyFunctionAtM'.++@-- doctest@++>>> :set +m++-}+module Enumerate.Function.Reify where+import Enumerate.Types+import Enumerate.Function.Types+import Enumerate.Function.Extra++import Control.Monad.Catch (MonadThrow(..), SomeException(..))+import Control.DeepSeq (NFData)++import Control.Arrow ((&&&))+++{- | reify a total function.++@++>>> reifyFunction not  -- Prelude 'not'+[(False,True),(True,False)]++@++-}+reifyFunction :: (Enumerable a) => (a -> b) -> [(a,b)]+reifyFunction f = reifyFunctionM (return . f)+{-# INLINABLE reifyFunction #-}++-- | reify a total function at any subset of the domain.+reifyFunctionAt :: [a] -> (a -> b) -> [(a,b)]+reifyFunctionAt domain f = reifyFunctionAtM domain (return . f)+{-# INLINABLE reifyFunctionAt #-}++-- | reify a (safely-)partial function into a map (which is implicitly partial, where @Map.lookup@ is like @($)@.+reifyFunctionM :: (Enumerable a) => (forall m. MonadThrow m => a -> m b) -> [(a,b)]+reifyFunctionM = reifyFunctionAtM enumerated+{-# INLINABLE reifyFunctionM #-}++{- | reify a (safely-)partial function at any domain.++use the functions suffixed with @M@ when your function is explicitly partial,+i.e. of type @(forall m. MonadThrow m => a -> m b)@.+when inside a function arrow, like:++@+reifyFunctionAtM :: [a] -> (forall m. MonadThrow m => a -> m b) -> [(a,b)]+reifyFunctionAtM domain f = ...+@++the @Rank2@ type (and non-concrete types) means that @f@ can only use+parametric polymorphic functions, or the methods of the @MonadThrow@ class+(namely 'throwM'), or methods of @MonadThrow@ superclasses (namely 'return', et cetera).++'MonadThrow' is a class from the @exceptions@ package that generalizes failibility.+it has instances for @Maybe@, @Either@, @[]@, @IO@, and more.++use the functions suffixed with @At@ when your domain isn't 'Enumerable',+or when you want to restrict the domain.++the most general function in this module.++>>> :{+let uppercasePartial :: (MonadThrow m) => Char -> m Char+    uppercasePartial c = case c of+     'a' -> return 'A'+     'b' -> return 'B'+     'z' -> return 'Z'+     _   -> failed "uppercasePartial"+:}++@++>>> reifyFunctionAtM ['a'..'c'] uppercasePartial+[('a','A'),('b','B')]++@++if your function doesn't fail under 'MonadThrow', see:++* 'reifyFunctionAtMaybe'+* 'reifyFunctionAtList'+* 'reifyFunctionAtEither'++-}+reifyFunctionAtM :: [a] -> (Partial a b) -> [(a,b)]+-- reifyFunctionAtM :: (MonadThrow m) => [a] -> (a -> m b) -> m (Map a b)+reifyFunctionAtM domain f+ = concatMap (bitraverse pure id)+ . fmap (id &&& f)+ $ domain+ where+ bitraverse g h (x,y) = (,) <$> g x <*> h y  -- avoid bifunctors dependency++-- | @reifyPredicateAt = 'flip' 'filter'@+reifyPredicateAt :: [a] -> (a -> Bool) -> [a]+reifyPredicateAt = flip filter+-- reifyPredicateAtM domain p = map fst (reifyFunctionAtM domain f)+--  where+--  f x = if p x then return x else throwM (ErrorCall "False")++-- MonadThrow Maybe+-- (e ~ SomeException) => MonadThrow (Either e)+-- MonadThrow []++-- | reify a (safely-)partial function that fails specifically under @Maybe@.+reifyFunctionMaybeAt :: [a] -> (a -> Maybe b) -> [(a, b)]+reifyFunctionMaybeAt domain f = reifyFunctionAtM domain (maybe2throw f)+{-# INLINABLE reifyFunctionMaybeAt #-}++-- | reify a (safely-)partial function that fails specifically under @[]@.+reifyFunctionListAt :: [a] -> (a -> [b]) -> [(a, b)]+reifyFunctionListAt domain f = reifyFunctionAtM domain (list2throw f)+{-# INLINABLE reifyFunctionListAt #-}++-- | reify a (safely-)partial function that fails specifically under @Either SomeException@.+reifyFunctionEitherAt :: [a] -> (a -> Either SomeException b) -> [(a, b)]+reifyFunctionEitherAt domain f = reifyFunctionAtM domain (either2throw f)+{-# INLINABLE reifyFunctionEitherAt #-}++{-| reifies an *unsafely*-partial function (i.e. a function that throws exceptions or that has inexhaustive pattern matching).++forces the function to be strict.++>>> import Data.Ratio (Ratio)++>>> fmap (1/) [0..3 :: Ratio Integer]+[*** Exception: Ratio has zero denominator++>>> let (1/) = reciprocal+>>> reifyFunctionSpoonAt [0..3 :: Ratio Integer] reciprocal+[(1 % 1,1 % 1),(2 % 1,1 % 2),(3 % 1,1 % 3)]++normal caveats from violating purity (via @unsafePerformIO@) and from catchalls (via @(e :: SomeExceptions -> _)@) apply.++-}+reifyFunctionSpoonAt :: (NFData b) => [a] -> (a -> b) -> [(a, b)]+reifyFunctionSpoonAt domain f = reifyFunctionMaybeAt domain (totalizeFunction f)++-- | reify a binary total function+reifyFunction2 :: (Enumerable a, Enumerable b) => (a -> b -> c) -> [(a,[(b,c)])]+reifyFunction2 f = reifyFunction2At enumerated enumerated f+{-# INLINABLE reifyFunction2 #-}++-- | reify a binary total function at some domain+reifyFunction2At :: [a] -> [b] -> (a -> b -> c) -> [(a,[(b,c)])]+reifyFunction2At as bs f = reifyFunction2AtM as bs (\x y -> pure (f x y))+{-# INLINABLE reifyFunction2At #-}++-- | reify a binary (safely-)partial function+reifyFunction2M :: (Enumerable a, Enumerable b) => (forall m. MonadThrow m => a -> b -> m c) -> [(a,[(b,c)])]+reifyFunction2M f = reifyFunction2AtM enumerated enumerated f+{-# INLINABLE reifyFunction2M #-}++-- | reify a binary (safely-)partial function at some domain+reifyFunction2AtM :: [a] -> [b] -> (forall m. MonadThrow m => a -> b -> m c) -> [(a,[(b,c)])]+reifyFunction2AtM as bs f = reifyFunctionAt as (\a -> reifyFunctionAtM bs (f a))

@@ -0,0 +1,92 @@+{-# LANGUAGE RankNTypes, DeriveAnyClass, TypeOperators #-}+module Enumerate.Function.Types where+import Enumerate.Types+import Enumerate.Function.Extra++import Control.Monad.Catch (MonadThrow)+import Control.DeepSeq++import Data.Ix (Ix)+++{-| see "Enumerate.Function.Reify.getJectivityM"++-}+data Jectivity = Injective | Surjective | Bijective+ deriving (Show,Read,Eq,Ord,Enum,Bounded,Ix,Generic,Data+          ,NFData,Enumerable)++{- with proof:++the signature of the inverse of (a -> b)++data Jectivity a b+ = Unjective  (b -> [a])+ | Injective  (b -> Maybe a)+ | Surjective (b -> NonEmpty a)+ | Bijective  (b -> a)++data Jectivity_ = Injective_ | Surjective_ | Bijective_++jectivity :: () => (a -> b) -> Jectivity a b++jectivity_ :: Jectivity -> Maybe Jectivity_++OR++newtype Injection  a b = Injection  (a -> b) (b -> Maybe a)+newtype Surjection a b = Surjection (a -> b) (b -> NonEmpty a)+newtype Bijection  a b = Bijection  (a -> b) (b -> a)++-- | each input has zero-or-one output+newtype a :?->: b = Injection  (a -> b) (b -> Maybe a)+-- | each input has one-or-more output+newtype a :+->: b = Surjection (a -> b) (b -> NonEmpty a)+-- | each input has one output+newtype a :<->: b = Bijection  (a -> b) (b -> a)++toInjection  :: (a -> b) -> Maybe (Injection  a b)+toSurjection :: (a -> b) -> Maybe (Surjection a b)+toBijection  :: (a -> b) -> Maybe (Bijection  a b)++asInjection :: (a :<->: b) -> (a :?->: b)+asInjection (Bijection f g) = Injection f (Just <$> g) -- pure++asSurjection :: (a :<->: b) -> (a :+->: b)+asSurjection (Bijection f g) = Surjection f ((:|[]) <$> g) -- pure+++-}++{-| a (safely-)partial function. i.e. a function that:++* fails only via the 'throwM' method of 'MonadThrow'+* succeeds only via the 'return' method of 'Monad'++-}+type Partial a b = (forall m. MonadThrow m => a -> m b)++type (a -?> b) = Partial a b++--------------------------------------------------------------------------------+ -- (by necessity) @'KnownNat' ('Cardinality' a)@+ --class (KnownNat (Cardinality a)) => Enumerable a where++  -- type Cardinality a :: Nat -- TODO+  {- too much boilerplate++   e.g.++  instance Enumerable Jectivity++  errors with:++  No instance for (KnownNat (Cardinality Jectivity))+   arising from the superclasses of an instance declaration+  In the instance declaration for `Enumerable Jectivity'++  would need:++  instance (KnownNat (Cardinality Jectivity)) => Enumerable Jectivity++  -}

@@ -0,0 +1,91 @@+{-# LANGUAGE TypeFamilies, ExplicitNamespaces, DataKinds, UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-| orphan instances, of 'Enumerate'\/'Eq'\/'Show', for functions:++* @instance (Enumerable a, Enumerable b, Ord a,  Ord b)  => Enumerable (a -> b)@+* @instance (Enumerable a,               Eq b)           => Eq         (a -> b)@+* @instance (Enumerable a,               Show a, Show b) => Show       (a -> b)@++see:++* 'functionEnumerated', 'functionCardinality'+* 'extensionallyEqual', 'extensionallyUnequal'+* 'functionShowsPrec'++(that are included for completeness, but not exported by default+(i.e. by "Enumerate").+you probably want build-time instance-resolution errors,+rather than possible runtime non-termination).+++@-- doctest@++>>> :set -XLambdaCase++-}+module Enumerate.Orphans.Function where+import Enumerate.Types+import Enumerate.Function.Map+++{-| the exponential type.++the 'cardinality' is the cardinality of @b@ raised to the cardinality @a@, i.e. @|b|^|a|@.++warning: it grows very quickly.++might be useful for generating random functions on small types,+like to fuzz test type class laws.++the 'cardinality' call is efficient (depending on the efficiency of the base type's call).+you should be able to safely (WRT performance) call 'enumerateBelow',+unless the arithmetic itself becomes too expensive.++@+instance ('Enumerable' a, Enumerable b, 'Ord' a, Ord b) => Enumerable (a -> b) where+ enumerated = 'functionEnumerated'+@++-}+instance (Enumerable a, Enumerable b, Ord a, Ord b) => Enumerable (a -> b) where --TODO, no (oprhan) instance, just the standalone function/type-instance?+ -- -- type Cardinality (a -> b) = (Cardinality b) ^ (Cardinality a)+ enumerated  = functionEnumerated+ cardinality = functionCardinality++{-| brute-force function extensionality.++warning: the size of the domain grows exponentially in the number of arguments.++>>> (\case LT -> False; EQ -> False; GT -> False) == const False+True+>>> (\case LT -> False; EQ -> False; GT -> False) == const True+False++because functions are curried, the instance is recursive,+and it works on functions of any arity:++> -- De Morgan's laws+>>> (\x y -> not (x && y)) == (\x y -> not x || not y)+True+>>> (\x y -> not (x || y)) == (\x y -> not x && not y)+True++-}+instance (Enumerable a, Eq b) => Eq (a -> b) where+ (==) = extensionallyEqual+ (/=) = extensionallyUnequal++{-|++-- >>> not+-- unsafeFromList [(False,True),(True,False)]++because functions are curried, the instance is recursive,+and it works on functions of any arity:++-- >>> (&&)+-- unsafeFromList [(False,unsafeFromList [(False,False),(True,False)]),(True,unsafeFromList [(False,False),(True,True)])]++-}+instance (Enumerable a, Show a, Show b) => Show (a -> b) where+ showsPrec = functionShowsPrec

@@ -0,0 +1,10 @@+resolver: lts-8.11+compiler: ghc-8.0.2++packages:+- .+- ../enumerate++extra-deps: +- spiros-0.0.0+- enumerate-0.2.2

@@ -0,0 +1,21 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+import Test.DocTest++main = do+ return()++    -- split up because some modules only succeed when they have the interpreter to themselves.+    -- seems like there's incompatibility between the Data.Enumerate.Types a module is *built* with,+    -- and they types that are present when it is *interpreted*.+ -- + -- doctest+ --  [+ --  ]++ -- doctest+ --  [ "sources/Enumerate/Function/Reify.hs" -- freezes+ --  ]++--  doctest+--   [ "sources/Enumerate/Map.hs" -- freezes+--   ]

@@ -0,0 +1,6 @@+module Enumerate.Test where+import Enumerate++main = do+ print "Enumerate"+

@@ -0,0 +1,2 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+