Some ideas for dealing with partial functions for setting management

Partial.hs

module Control.Monad.Error.Restricted.Partial where
import Control.Applicative
import Data.Foldable (asum)
import qualified Data.HashMap.Strict as H
import Control.Monad hiding (msum)
import Data.Hashable
import Data.Foldable
import Data.Traversable
import Data.Monoid
import Data.Maybe
import Data.Set (Set(..))
import qualified Data.Set as S

newtype Partial a b = Partial { unPartial :: (a -> Maybe b) }

instance Functor (Partial a) where
    fmap f (Partial g) = Partial $ fmap f . g
    
instance Applicative (Partial a) where
    pure                        = Partial . const . Just
    (Partial f) <*> (Partial g) = Partial $ \x -> f x <*> g x
    
--Laws
-- Identity pure id <*> v 
--          (Partial (const (Just id))) <*> v
--          (Partial (const (Just id))) <*> (Partial g)
--          Partial $ \x -> (const (Just id)) x <*> g x
--                            (Just id) <*> g x
--                            id id $ gx
--
-- Composition  pure (.) <*> u <*> v <*> w = u <*> (v <*> w)
-- Partial (const (Just (.))) <*> u <*> v <*> w 
-- (Partial \x -> const (Just (.)) x <*> uf x) <*> v <*> w
-- '' <*> Partial fv
-- (Partial \y -> (\x -> const (Just (.)) x <*> fu x) y <*> fv y) <*> z
-- Partial \z -> (\y -> (\x -> Just (.) <*> fu x) y <*> fv y) z <*> fz z
--Case 1
--Partial \z -> (\y -> (\x -> Just (.) <*> Just fu') y <*> fv y) z <*> fz z
--Partial \z -> (\y -> fu' (.) y <*> fv y) z <*> fz z
 
-- Homomorphism pure f <*> pure x = pure (f x)
-- Interchange  u <*> pure y = pure ($ y) <*> u

--I want to see if I can understand the types
compP :: Partial a (b -> c) -> Partial        
compP v = pure (.) <*> v 


instance Alternative (Partial a) where
    empty                       = Partial $ const empty
    (Partial f) <|> (Partial g) = Partial $ \x -> f x <|> g x
    
combinePartials :: [Partial a b] -> Partial a b
combinePartials = asum

----------------------------------------------------------------------
data Restricted a b = Restricted (Set a) (Partial a b)

instance (Ord a) => Functor (Restricted a) where
    fmap f (Restricted dom x) = Restricted dom $ fmap f x

instance  (Ord a) => Applicative (Restricted a) where
    pure                                  = Restricted S.empty . pure
    (Restricted x f) <*> (Restricted y g) = Restricted (x `S.union` y) (f <*> g)
    
instance  (Ord a) => Alternative (Restricted a) where
    empty                                 = Restricted S.empty empty
    (Restricted x f) <|> (Restricted y g) = Restricted (x `S.union` y) (f <|> g)
    
instance  (Ord a) => Monoid (Restricted a b) where
    mempty  = empty
    mappend = (<|>) 
    
instance  (Ord a) => Foldable (Restricted a) where
    foldMap f (Restricted dom (Partial set)) =  
        mconcat $ catMaybes $ map (fmap f . set) $ S.toList dom

collapse :: (Ord c, Ord a) => Restricted c (Restricted a b) -> Restricted a b
collapse = fold 

expand :: (Ord b) => Restricted a c -> (a -> Set b) -> Restricted a (Restricted b c)
--expand (Restricted dom setting) f = Restricted dom $ 
--    Partial $ \a -> Restricted (f a) $ expandPartial setting a (f a)
expand = undefined

expandPartial :: (Eq b) => Partial a i -> a -> b -> Partial b i
expandPartial (Partial f) a b = Partial $ \x -> if x == b then f a else Nothing    

collapse1 :: (Ord c1, Ord c2, Ord a) => CategoryRestricted1 c1 c2 a b -> Restricted a b
collapse1 = fold . fold 

-------------------------------------------------------------------------
toRestricted :: (Eq a, Hashable a, Ord a) => Set a -> H.HashMap a b -> Restricted a b
toRestricted dom h = Restricted dom $ toPartial h

----------------------------------------------------------------------
toPartial :: (Eq a, Hashable a) => H.HashMap a b -> Partial a b
toPartial h = Partial $ \k -> H.lookup k h
          
        
type CategoryRestricted c a b = Restricted c (Restricted a b)
type CategoryRestricted1 c1 c0 a b = Restricted c1 (CategoryRestricted c0 a b)