module Data.LazyHash.Category where
import Data.LazyHash.Class
import qualified Prelude as Hask hiding(foldl, sum, sequence)
import qualified Control.Applicative as Hask
import qualified Data.Foldable as Hask
import Data.Foldable (all, elem, toList, sum, foldr1)
import Control.Category.Constrained.Prelude hiding
((^), all, elem, sum, forM, Foldable(..), foldr1, Traversable, traverse)
import Control.Arrow.Constrained
import Control.Monad.Constrained hiding (forM)
import qualified Data.Hashable as SH
import Data.Tagged
instance Hash h => Category (LazilyHashableFunction h) where
type Object (LazilyHashableFunction h) a = Hashable h a
id = [fundamental'|id|]
LHF (Prehashed hf f) . LHF (Prehashed hg g)
= lhf ([shash|.|] # hf # hg) (f . g)
lhf :: h -> (a->b) -> LazilyHashableFunction h a b
lhf h = LHF . Prehashed h
instance Hash h => Cartesian (LazilyHashableFunction h) where
swap = [fundamental'|swap|]
attachUnit = [fundamental'|attachUnit|]
detachUnit = [fundamental'|detachUnit|]
regroup = [fundamental'|regroup|]
regroup' = [fundamental'|regroup'|]
instance Hash h => Curry (LazilyHashableFunction h) where
curry (LHF (Prehashed h f))
= LHF $ Prehashed ([shash|curry|]#h) $ LHF . Prehashed 0 . curry f
uncurry (LHF (Prehashed h f))
= LHF . Prehashed h . uncurry $ prehashedValue . getLHF . f
instance Hash h => CoCartesian (LazilyHashableFunction h) where
coSwap = [fundamental'|coSwap|]
attachZero = [fundamental'|attachZero|]
detachZero = [fundamental'|detachZero|]
coRegroup = [fundamental'|coRegroup|]
coRegroup' = [fundamental'|coRegroup'|]
maybeAsSum = [fundamental'|maybeAsSum|]
maybeFromSum = [fundamental'|maybeFromSum|]
boolAsSum = [fundamental'|boolAsSum|]
boolFromSum = [fundamental'|boolFromSum|]
instance Hash h => Morphism (LazilyHashableFunction h) where
LHF (Prehashed hf f) *** LHF (Prehashed hg g)
= lhf ([shash|***|] # hf # hg) (f *** g)
instance Hash h => PreArrow (LazilyHashableFunction h) where
LHF (Prehashed hf f) &&& LHF (Prehashed hg g)
= lhf ([shash|&&&|] # hf # hg) (f &&& g)
terminal = [fundamental'|terminal|]
fst = [fundamental'|fst|]
snd = [fundamental'|snd|]
instance Hash h => WellPointed (LazilyHashableFunction h) where
unit = Tagged ()
globalElement x = LHF . Prehashed ([shash|globalElement|] # x) $ const x
const x = LHF . Prehashed ([shash|const|] # x) $ const x
instance Hash h => EnhancedCat (->) (LazilyHashableFunction h) where
arr = prehashedValue . getLHF
instance Hash h
=> Functor (Prehashed h) (LazilyHashableFunction h) (LazilyHashableFunction h) where
fmap (LHF (Prehashed hf f)) = lhf hf $ \(Prehashed hx x) -> Prehashed (hf # hx) $ f x
instance Hash h
=> Monoidal (Prehashed h) (LazilyHashableFunction h) (LazilyHashableFunction h) where
pureUnit = LHF (Prehashed 0 (Prehashed $ hash()))
fzipWith (LHF (Prehashed hf f)) = lhf hf
$ \(Prehashed hx x, Prehashed hy y) -> Prehashed (hf # hx # hy) $ f (x,y)
instance Hash h
=> Applicative (Prehashed h) (LazilyHashableFunction h) (LazilyHashableFunction h) where
pure = LHF . Prehashed 0 $ \v -> Prehashed (hash v) v
instance Hash h => Monad (Prehashed h) (LazilyHashableFunction h) where
join = LHF . Prehashed 0 $ \(Prehashed h (Prehashed i a))
-> Prehashed (h # i) a