-- |
--   Module      :  Data.Edison.Prelude
--   Copyright   :  Copyright (c) 1998 Chris Okasaki
--   License     :  BSD3; see COPYRIGHT file for terms and conditions
--
--   Maintainer  :  robdockins AT fastmail DOT fm
--   Stability   :  stable
--   Portability :  GHC, Hugs (MPTC and FD)
--
--   This module is a central depository of common definitions
--   used throughout Edison.

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Data.Edison.Prelude (
-- * Hashing classes
  Hash (..)
, UniqueHash
, ReversibleHash (..)
, Measured (..)
-- * Pure MonadFail
,  runFail_
) where

import Control.Monad.Fail
import Data.Monoid

-- | This class represents hashable objects. If obeys the 
--   following invariant:
--
-- @forall x,y :: a. (x == y) implies (hash x == hash y)@

class Eq a => Hash a where
  hash :: a -> Int


-- | This class represents hashable objects where the hash function
--   is /unique/ (injective).  There are no new methods, just a 
--   stronger invariant:
--
-- @forall x,y :: a. (x == y) iff (hash x == hash y)@

class Hash a => UniqueHash a


-- | This class represents hashable objects where the hash is
--   reversible.
--
-- @forall x :: a. unhash (hash x) == x@
--
--  Note that:
--
-- @hash (unhash i) == i@
--
-- does not necessarily hold because 'unhash' is not necessarily
-- defined for all @i@, only for all @i@ in the range of hash.

class UniqueHash a => ReversibleHash a where
  unhash :: Int -> a


-- | This class represents a quantity that can be measured.  It is
--   calculated by an associative function with a unit (hence the
--   @Monoid@ superclass, and by a function which gives the measurement
--   for an individual item.  Some datastructures are able to speed up
--   the calculation of a measure by caching intermediate values of
--   the computation.
class (Monoid v) => Measured v a | a -> v where
  measure :: a -> v

-- From Agda source code: src/full/Agda/Utils/Fail.hs
-- | A pure MonadFail.
newtype Fail a = Fail { forall a. Fail a -> Either String a
runFail :: Either String a }
  deriving (forall a b. a -> Fail b -> Fail a
forall a b. (a -> b) -> Fail a -> Fail b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Fail b -> Fail a
$c<$ :: forall a b. a -> Fail b -> Fail a
fmap :: forall a b. (a -> b) -> Fail a -> Fail b
$cfmap :: forall a b. (a -> b) -> Fail a -> Fail b
Functor, Functor Fail
forall a. a -> Fail a
forall a b. Fail a -> Fail b -> Fail a
forall a b. Fail a -> Fail b -> Fail b
forall a b. Fail (a -> b) -> Fail a -> Fail b
forall a b c. (a -> b -> c) -> Fail a -> Fail b -> Fail c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Fail a -> Fail b -> Fail a
$c<* :: forall a b. Fail a -> Fail b -> Fail a
*> :: forall a b. Fail a -> Fail b -> Fail b
$c*> :: forall a b. Fail a -> Fail b -> Fail b
liftA2 :: forall a b c. (a -> b -> c) -> Fail a -> Fail b -> Fail c
$cliftA2 :: forall a b c. (a -> b -> c) -> Fail a -> Fail b -> Fail c
<*> :: forall a b. Fail (a -> b) -> Fail a -> Fail b
$c<*> :: forall a b. Fail (a -> b) -> Fail a -> Fail b
pure :: forall a. a -> Fail a
$cpure :: forall a. a -> Fail a
Applicative, Applicative Fail
forall a. a -> Fail a
forall a b. Fail a -> Fail b -> Fail b
forall a b. Fail a -> (a -> Fail b) -> Fail b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Fail a
$creturn :: forall a. a -> Fail a
>> :: forall a b. Fail a -> Fail b -> Fail b
$c>> :: forall a b. Fail a -> Fail b -> Fail b
>>= :: forall a b. Fail a -> (a -> Fail b) -> Fail b
$c>>= :: forall a b. Fail a -> (a -> Fail b) -> Fail b
Monad)

instance MonadFail Fail where
  fail :: forall a. String -> Fail a
fail = forall a. Either String a -> Fail a
Fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left

runFail_ :: Fail a -> a
runFail_ :: forall a. Fail a -> a
runFail_ = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasCallStack => String -> a
error forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fail a -> Either String a
runFail