-- | Defines instances of Show, Eq, and Ord for functions.
-- Limitations:
-- * Only works for functions that have a small finite number of possible
--   inputs (e.g., inputs are all @Bool@); this module defines a new 'Finite'
--   class for this
-- * Does not work for functions that could result in undefined for defined
--   inputs
-- * Does not test strictness - e.g., @(&&) == flip (&&)@ gives @True@, even
--   though they give different results if one of the inputs is undefined
-- * Equality and ordering on other types are assumed to work correctly;
--   otherwise it may give incorrect results.  In particular,
--   @const (0/0) /= const (0/0)@, and if infinite lists (or similar) are
--   returned from both functions, (==) will enter an infinite loop.
-- * Only works with monomorphic types.  ghci seems to sometimes replace 
--   type variables with @()@, which could give surprising results, e.g.,
--   typing @(==) == const (const True)@ in ghci will show @True@, because it
--   assumes @(==) :: () -> () -> Bool@ (which is always true)
{-# OPTIONS_GHC -fno-warn-tabs #-}
module FuncEq (Finite(..), funcToList, listToFunc, l2f, inverse) where

import Data.Int
import Data.Word
import Data.Maybe
import Data.Function
import Data.List
import qualified Data.Map as M

default (Int8, Double)

-- | Types where all possible values of the type can be listed in a finite list
class Finite a where
	-- | A list of all possible values
	everything :: [a]

instance Finite () where
	everything = [()]
instance Finite Bool where
	everything = [False,True]
instance Finite Ordering where
	everything = [LT,EQ,GT]
instance Finite Char where
	everything = ['\0'..]
instance Finite Word8 where
	everything = [minBound..]
instance Finite Word16 where
	everything = [minBound..]
instance Finite Word32 where
	everything = [minBound..]
instance Finite Int8 where
	everything = [minBound..]
instance Finite Int16 where
	everything = [minBound..]
instance Finite Int32 where
	everything = [minBound..]

instance Finite a => Finite (Maybe a) where
	everything = Nothing : (map Just everything)
instance (Finite a, Finite b) => Finite (Either a b) where
	everything = (map Left everything) ++ (map Right everything)
instance (Finite a, Finite b) => Finite (a,b) where
	everything = [(x,y) | x <- everything, y <- everything]
instance (Finite a, Finite b, Finite c) => Finite (a,b,c) where
	everything = [(x,y,z) | x <- everything, y <- everything, z <- everything]
instance (Finite a, Finite b, Finite c, Finite d) => Finite (a,b,c,d) where
	everything = [(x,y,z,w) | x <- everything, y <- everything, z <- everything,
	                          w <- everything]

--listToFunc :: Ord a => [(a,b)] -> a -> b
--listToFunc m = fromJust . flip M.lookup (M.fromList m)
-- | Convert a list of (input,result) pairs to a function
listToFunc :: Eq a => [(a,b)] -> a -> b
listToFunc [] _ = undefined
listToFunc ((x,y):xs) x' | x==x' = y
                         | otherwise = listToFunc xs x'

-- | Synonym for listToFunc so the output of show can be more compact and still be a valid
-- Haskell expression
l2f :: Eq a => [(a,b)] -> a -> b
l2f = listToFunc

-- | Convert a function to a list of (input,result) pairs.
funcToList :: Finite a => (a -> b) -> [(a,b)]
funcToList f = map (\x -> (x, f x)) everything

instance (Finite a, Eq a, Finite b) => Finite (a -> b) where
	everything = map listToFunc $ allLists everything
	             where allLists [] = [[]]
	                   --allLists (x:xs) = map ((:allLists xs).(\y->(x,y))) everything
	                   allLists (x:xs) = [r:rs | r <- map (\y->(x,y)) everything,
	                                             rs <- allLists xs]

instance (Finite a, Eq b) => Eq (a -> b) where
	f == g = all (\x -> f x == g x) everything
instance (Finite a, Show a, Show b) => Show (a -> b) where
	-- showsPrec p f = showParen (p > 10) $ showString "l2f " . shows (funcToList f)
	show f = "(\\x -> case x of " ++ intercalate "; " (map (\(k,v) -> show k ++ " -> " ++ show v) (funcToList f)) ++ ")"
instance (Finite a, Ord a, Ord b) => Ord (a -> b) where
	compare = compare `on` funcToList

inverse :: (Finite a, Eq b) => (a -> b) -> (b -> a)
inverse = listToFunc . map (\(x,y)->(y,x)) . funcToList