packages feed

open-witness 0.1.1 → 0.3.1

raw patch · 8 files changed

+459/−382 lines, 8 filesdep +hashabledep +randomdep +template-haskelldep −mtldep ~basedep ~witnessPVP ok

version bump matches the API change (PVP)

Dependencies added: hashable, random, template-haskell, transformers

Dependencies removed: mtl

Dependency ranges changed: base, witness

API changes (from Hackage documentation)

- Data.OpenWitness: instance Eq (OpenWitness s a)
- Data.OpenWitness: instance Functor (OW s)
- Data.OpenWitness: instance Monad (OW s)
- Data.OpenWitness: instance MonadFix (OW s)
- Data.OpenWitness: instance SimpleWitness (OpenWitness s)
- Data.OpenWitness: unsafeIOWitnessFromString :: String -> IOWitness a
- Data.OpenWitness.Dynamic: dynApp :: Dynamic -> Dynamic -> Dynamic
- Data.OpenWitness.Dynamic: dynApply :: Dynamic -> Dynamic -> Maybe Dynamic
- Data.OpenWitness.Dynamic: dynTypeRep :: Dynamic -> TypeRep
- Data.OpenWitness.Dynamic: fromDyn :: (Typeable a) => Dynamic -> a -> a
- Data.OpenWitness.Dynamic: fromDynamic :: (Typeable a) => Dynamic -> Maybe a
- Data.OpenWitness.Dynamic: toDyn :: (Typeable a) => a -> Dynamic
- Data.OpenWitness.Dynamic: type Dynamic = Any Rep
- Data.OpenWitness.Exception: instance Typeable ExnException
- Data.OpenWitness.Exception: type Exn = IOWitness
- Data.OpenWitness.Exception: unsafeExnFromString :: String -> Exn e
- Data.OpenWitness.Typeable: cast :: (Typeable a, Typeable b) => a -> Maybe b
- Data.OpenWitness.Typeable: class Typeable a
- Data.OpenWitness.Typeable: class Typeable1 t
- Data.OpenWitness.Typeable: class Typeable2 t
- Data.OpenWitness.Typeable: funResultTy :: TypeRep -> TypeRep -> Maybe TypeRep
- Data.OpenWitness.Typeable: gcast :: (Typeable a, Typeable b) => c a -> Maybe (c b)
- Data.OpenWitness.Typeable: instance (Typeable1 f, Typeable a) => Typeable (f a)
- Data.OpenWitness.Typeable: instance (Typeable2 f, Typeable a) => Typeable1 (f a)
- Data.OpenWitness.Typeable: instance Typeable2 (->)
- Data.OpenWitness.Typeable: mkAppTy :: TypeRep1 -> TypeRep -> TypeRep
- Data.OpenWitness.Typeable: mkAppTy1 :: TypeRep2 -> TypeRep -> TypeRep1
- Data.OpenWitness.Typeable: mkFunTy :: TypeRep -> TypeRep -> TypeRep
- Data.OpenWitness.Typeable: rep :: (Typeable a) => Rep a
- Data.OpenWitness.Typeable: rep1 :: (Typeable1 t) => Rep1 t
- Data.OpenWitness.Typeable: rep2 :: (Typeable2 t) => Rep2 t
- Data.OpenWitness.Typeable: type TypeRep = AnyWitness Rep
- Data.OpenWitness.Typeable: type TypeRep1 = AnyWitness1 Rep1
- Data.OpenWitness.Typeable: type TypeRep2 = AnyWitness2 Rep2
- Data.OpenWitness.Typeable: typeOf :: (Typeable t) => t -> TypeRep
- Data.OpenWitness.Typeable: typeOf1 :: (Typeable1 t) => t a -> TypeRep1
- Data.OpenWitness.Typeable: typeOf2 :: (Typeable2 t) => t a b -> TypeRep2
- Data.OpenWitness.Typeable.Rep: ApplyRep :: Rep1 p -> Rep a -> Rep (p a)
- Data.OpenWitness.Typeable.Rep: ApplyRep1 :: Rep2 p -> Rep a -> Rep1 (p a)
- Data.OpenWitness.Typeable.Rep: SimpleRep :: IOWitness a -> Rep a
- Data.OpenWitness.Typeable.Rep: SimpleRep1 :: IOWitness (p ()) -> Rep1 p
- Data.OpenWitness.Typeable.Rep: SimpleRep2 :: IOWitness (p () ()) -> Rep2 p
- Data.OpenWitness.Typeable.Rep: data Rep a
- Data.OpenWitness.Typeable.Rep: data Rep1 p
- Data.OpenWitness.Typeable.Rep: data Rep2 p
- Data.OpenWitness.Typeable.Rep: instance Eq1 Rep
- Data.OpenWitness.Typeable.Rep: instance SimpleWitness Rep
- Data.OpenWitness.Typeable.Rep: matchRep1 :: Rep1 a -> Rep1 b -> Maybe (EqualType (a ()) (b ()))
- Data.OpenWitness.Typeable.Rep: matchRep2 :: Rep2 a -> Rep2 b -> Maybe (EqualType (a () ()) (b () ()))
+ Data.OpenWitness: instance forall (k :: BOX) (k1 :: BOX) (s :: k1) (a :: k). GHC.Classes.Eq (Data.OpenWitness.OpenWitness s a)
+ Data.OpenWitness: instance forall (k :: BOX) (k1 :: BOX) (s :: k1). Data.Type.Equality.TestEquality (Data.OpenWitness.OpenWitness s)
+ Data.OpenWitness: instance forall (k :: BOX) (s :: k). Control.Monad.Fix.MonadFix (Data.OpenWitness.OW s)
+ Data.OpenWitness: instance forall (k :: BOX) (s :: k). GHC.Base.Applicative (Data.OpenWitness.OW s)
+ Data.OpenWitness: instance forall (k :: BOX) (s :: k). GHC.Base.Functor (Data.OpenWitness.OW s)
+ Data.OpenWitness: instance forall (k :: BOX) (s :: k). GHC.Base.Monad (Data.OpenWitness.OW s)
+ Data.OpenWitness: iowitness :: TypeQ -> Q Exp
+ Data.OpenWitness.Exception: data Exn (e :: *)
+ Data.OpenWitness.Exception: declexn :: TypeQ -> Q Exp
+ Data.OpenWitness.Exception: instance Data.Type.Equality.TestEquality Data.OpenWitness.Exception.Exn
+ Data.OpenWitness.Exception: instance GHC.Exception.Exception Data.OpenWitness.Exception.ExnException
+ Data.OpenWitness.Exception: instance GHC.Show.Show Data.OpenWitness.Exception.ExnException
- Data.OpenWitness: data OpenWitness s a
+ Data.OpenWitness: data OpenWitness s (a :: k)

Files

Data/OpenWitness.hs view
@@ -1,89 +1,134 @@+{-# OPTIONS -fno-warn-name-shadowing #-} module Data.OpenWitness (-	OpenWitness,-	RealWorld,IOWitness,newIOWitness,-	OW,newOpenWitnessOW,runOW,owToIO,---	unsafeIOWitnessFromInteger,-	unsafeIOWitnessFromString+    OpenWitness,+    RealWorld,IOWitness,newIOWitness,+    OW,newOpenWitnessOW,runOW,owToIO,+--    unsafeIOWitnessFromInteger,+--    unsafeIOWitnessFromString,+    iowitness ) where {-	import Data.Witness;-	import Unsafe.Coerce;-	import System.IO.Unsafe (unsafePerformIO);-	import Control.Concurrent.MVar;-	import Control.Monad.State;-	import Data.HashTable;+    import Prelude;+    import Data.List;+    import System.Random;+    import Language.Haskell.TH;+    import Unsafe.Coerce;+    import System.IO.Unsafe (unsafePerformIO);+    import Control.Concurrent.MVar;+    import Control.Monad.Fix;+    import Control.Monad.Trans.State;+    import Data.Functor.Identity;+    import Data.Traversable;+    import Data.Hashable;+    import Data.Witness; -	unsafeSameType :: EqualType a b;-	unsafeSameType = unsafeCoerce MkEqualType; -	-- | A witness type that can witness to any type.-	-- But values cannot be constructed; they can only be generated in 'IO' and certain other monads.-	;-	newtype OpenWitness s a = MkOpenWitness Integer deriving Eq;-	-	instance SimpleWitness (OpenWitness s) where-	{-		matchWitness (MkOpenWitness ua) (MkOpenWitness ub) = -			if ua == ub then Just unsafeSameType else Nothing;-	};+    unsafeSameType :: a :~: b;+    unsafeSameType = unsafeCoerce Refl; -	-- | The @s@ type for running 'OW' in 'IO'.-	;-	data RealWorld;+    -- | A witness type that can witness to any type.+    -- But values cannot be constructed; they can only be generated in 'IO' and certain other monads.+    ;+    newtype OpenWitness s (a :: k) = MkOpenWitness Integer deriving Eq; -	-- | An 'OpenWitness' for 'IO'.-	;-	type IOWitness = OpenWitness RealWorld;+    instance TestEquality (OpenWitness s) where+    {+        testEquality (MkOpenWitness ua) (MkOpenWitness ub) =+            if ua == ub then Just unsafeSameType else Nothing;+    }; -	ioWitnessSource :: MVar Integer;-	{-# NOINLINE ioWitnessSource #-};-	ioWitnessSource = unsafePerformIO (newMVar 0);+    -- | The @s@ type for running 'OW' in 'IO'.+    ;+    data RealWorld; -	-- | Generate a new 'IOWitness' in 'IO'.-	;-	newIOWitness :: forall a. IO (IOWitness a);-	newIOWitness = do-	{-		val <- takeMVar ioWitnessSource;-		putMVar ioWitnessSource (val + 1);-		return (MkOpenWitness val);-	};-	-	type OWState = Integer;-	-	-- | A runnable monad in which 'OpenWitness' values can be generated.-	-- The @s@ parameter plays the same role as it does in 'ST', preventing 'OpenWitness' values from one run being used in another.-	;-	newtype OW s a = MkOW (State OWState a) deriving (Functor,Monad,MonadFix);-	-	-- | Run an 'OW' computation.-	;-	runOW :: forall a. (forall s. OW s a) -> a;-	runOW uw = (\(MkOW st) -> evalState st 0) uw;-	-	-- | Generate a new 'OpenWitness' in 'OW'.-	;-	newOpenWitnessOW :: forall s a. OW s (OpenWitness s a);-	newOpenWitnessOW = MkOW (State (\val -> (MkOpenWitness val,val+1)));-	-	-- | Run an 'OW' computation in 'IO'.-	;-	owToIO :: OW RealWorld a -> IO a;-	owToIO (MkOW st) = modifyMVar ioWitnessSource (\start -> let-	{-		(a,count) = runState st start;-	} in return (count,a));-	-	-- | In the absence of open witness declarations, an unsafe hack to generate 'IOWitness' values.-	-- This is safe if you use a different integer each time, and if @a@ is a single type.-	;-	unsafeIOWitnessFromInteger :: Integer -> IOWitness a;-	unsafeIOWitnessFromInteger = MkOpenWitness;-	-	-- | In the absence of open witness declarations, an unsafe hack to generate 'IOWitness' values.-	-- This is safe if you use a different string each time (and 'hashString' doesn't collide), and if @a@ is a single type.-	;-	unsafeIOWitnessFromString :: String -> IOWitness a;-	unsafeIOWitnessFromString = unsafeIOWitnessFromInteger . fromIntegral . hashString;+    -- | An 'OpenWitness' for 'IO'.+    ;+    type IOWitness = OpenWitness RealWorld;++    ioWitnessSource :: MVar Integer;+    {-# NOINLINE ioWitnessSource #-};+    ioWitnessSource = unsafePerformIO (newMVar 0);++    -- | Generate a new 'IOWitness' in 'IO'.+    ;+    newIOWitness :: forall a. IO (IOWitness a);+    newIOWitness = do+    {+        val <- takeMVar ioWitnessSource;+        putMVar ioWitnessSource (val + 1);+        return (MkOpenWitness val);+    };++    type OWState = Integer;++    -- | A runnable monad in which 'OpenWitness' values can be generated.+    -- The @s@ parameter plays the same role as it does in 'ST', preventing 'OpenWitness' values from one run being used in another.+    ;+    newtype OW s a = MkOW (State OWState a) deriving (Functor,Applicative,Monad,MonadFix);++    -- | Run an 'OW' computation.+    ;+    runOW :: forall a. (forall s. OW s a) -> a;+    runOW uw = (\(MkOW st) -> evalState st 0) uw;++    -- | Generate a new 'OpenWitness' in 'OW'.+    ;+    newOpenWitnessOW :: forall s a. OW s (OpenWitness s a);+    newOpenWitnessOW = MkOW (StateT (\val -> Identity (MkOpenWitness val,val+1)));++    -- | Run an 'OW' computation in 'IO'.+    ;+    owToIO :: OW RealWorld a -> IO a;+    owToIO (MkOW st) = modifyMVar ioWitnessSource (\start -> let+    {+        (a,count) = runState st start;+    } in return (count,a));++    -- | An unsafe hack to generate 'IOWitness' values.+    -- This is safe if you use a different integer each time, and if @a@ is a single type.+    ;+    unsafeIOWitnessFromInteger :: Integer -> IOWitness a;+    unsafeIOWitnessFromInteger = MkOpenWitness;++    -- | An unsafe hack to generate 'IOWitness' values.+    -- This is safe if you use a different string each time (and 'hashString' doesn't collide), and if @a@ is a single type.+    ;+    unsafeIOWitnessFromString :: String -> IOWitness a;+    unsafeIOWitnessFromString = unsafeIOWitnessFromInteger . fromIntegral . hash;++    -- | Template Haskell function to declare 'IOWitness' values.+    ;+    iowitness :: TypeQ -> Q Exp;+    iowitness qt = do+    {+        t <- qt;+        _ <- forM (freevarsType t) (\v -> reportError ("Type variable "++(show v)++" free in iowitness type"));+        l <- location;+        rnd :: Integer <- runIO randomIO;+        key <- return ((showLoc l) ++ "/" ++ (show rnd));+        keyExpr <- return (LitE (StringL key));+        untypedWitExpr <- [| unsafeIOWitnessFromString $(return keyExpr) |];+        [| $(return untypedWitExpr) :: IOWitness $(return t) |];+    } where+    {+        showLoc :: Loc -> String;+        showLoc l = (loc_filename l) ++ "=" ++ (loc_package l) ++ ":" ++ (loc_module l) ++ (show (loc_start l)) ++ (show (loc_end l));++        unionList :: (Eq a) => [[a]] -> [a];+        unionList [] = [];+        unionList (l:ls) = union l (unionList ls);++        bindingvarTVB :: TyVarBndr -> Name;+        bindingvarTVB (PlainTV n) = n;+        bindingvarTVB (KindedTV n _) = n;++        freevarsType :: Language.Haskell.TH.Type -> [Name];+        freevarsType (ForallT tvbs ps t) =+         (union (freevarsType t) (unionList (fmap freevarsType ps))) \\ (fmap bindingvarTVB tvbs);+        freevarsType (VarT name) = [name];+        freevarsType (AppT t1 t2) = union (freevarsType t1) (freevarsType t2);+        freevarsType (SigT t _) = freevarsType t;+        freevarsType _ = [];+    }; }
Data/OpenWitness/Dynamic.hs view
@@ -1,53 +1,56 @@ -- | This is an approximate re-implementation of "Data.Dynamic" using open witnesses. module Data.OpenWitness.Dynamic where {-	import Data.Witness;-	import Data.OpenWitness.Typeable;+{-+    import Data.Witness;+    import Data.OpenWitness.OpenRep;+    import Data.OpenWitness.Typeable; -	-- * The @Dynamic@ type-	;+    -- * The @Dynamic@ type+    ; -	type Dynamic = Any Rep;+    type Dynamic = Any OpenRep; -	-- * Converting to and from @Dynamic@-	;+    -- * Converting to and from @Dynamic@+    ; -	toDyn :: Typeable a => a -> Dynamic;-	toDyn = MkAny rep;+    toDyn :: Typeable a => a -> Dynamic;+    toDyn = MkAny rep; -	fromDyn :: Typeable a => Dynamic -> a -> a;-	fromDyn dyn def = case fromDynamic dyn of-	{-		Just a -> a;-		_ -> def;-	};+    fromDyn :: Typeable a => Dynamic -> a -> a;+    fromDyn dyn def = case fromDynamic dyn of+    {+        Just a -> a;+        _ -> def;+    }; -	fromDynamic :: forall a. Typeable a => Dynamic -> Maybe a;-	fromDynamic (MkAny uq a) = do-	{-		MkEqualType <- matchWitness uq (rep :: Rep a);-		return a;-	};+    fromDynamic :: forall a. Typeable a => Dynamic -> Maybe a;+    fromDynamic (MkAny uq a) = do+    {+        MkEqualType <- testEquality uq (rep :: OpenRep a);+        return a;+    }; -	-- * Applying functions of dynamic type-	;+    -- * Applying functions of dynamic type+    ; -	dynApply :: Dynamic -> Dynamic -> Maybe Dynamic;-	dynApply (MkAny (ApplyRep (ApplyRep1 repFn' rx') ry) f) (MkAny rx x) = do-	{-		MkEqualType <- matchRep2 repFn' (rep2 :: Rep2 (->));-		MkEqualType <- matchWitness rx' rx;-		return (MkAny ry (f x));-	};-	dynApply _ _ = Nothing;+    dynApply :: Dynamic -> Dynamic -> Maybe Dynamic;+    dynApply (MkAny (ApplyOpenRep (ApplyOpenRep1 repFn' rx') ry) f) (MkAny rx x) = do+    {+        MkEqualType <- matchOpenRep2 repFn' (rep2 :: OpenRep2 (->));+        MkEqualType <- testEquality rx' rx;+        return (MkAny ry (f x));+    };+    dynApply _ _ = Nothing; -	dynApp :: Dynamic -> Dynamic -> Dynamic;-	dynApp a b = case (dynApply a b) of-	{-		Just d -> d;-		_ -> error "Type error in dynamic application.\nCan't apply function to argument";-	};+    dynApp :: Dynamic -> Dynamic -> Dynamic;+    dynApp a b = case (dynApply a b) of+    {+        Just d -> d;+        _ -> error "Type error in dynamic application.\nCan't apply function to argument";+    }; -	dynTypeRep :: Dynamic -> TypeRep;-	dynTypeRep (MkAny r _) = MkAnyWitness r;+    dynTypeRep :: Dynamic -> TypeRep;+    dynTypeRep (MkAny r _) = MkAnyWitness r;+-} }
Data/OpenWitness/Exception.hs view
@@ -1,39 +1,48 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# OPTIONS -fno-warn-unused-matches #-} module Data.OpenWitness.Exception (-	Exn, unsafeExnFromString, throw, catch+    Exn, declexn, throw, catch ) where {-	import Data.OpenWitness;-	import Data.Witness;-	import Data.Maybe;-	import Data.Typeable;-	import Control.Exception (throwDyn,catchDyn);-	import Prelude(IO,String);+    import Data.OpenWitness;+    import Data.Witness;+    import Data.Maybe;+    import Data.Typeable;+    import Language.Haskell.TH;+    import qualified Control.Exception as CE (Exception,throw,catch);+    import Prelude(IO,Show(..)); -	-- | A key to match exceptions. The type variable is the data the exception carries.-	;-	type Exn = IOWitness;+    -- | A key to match exceptions. The type variable is the data the exception carries.+    ;+    newtype Exn (e :: *) = MkExn (IOWitness e); -	newtype ExnException = MkExnException (Any Exn);-	-	-- | In the absence of open witness declarations, an unsafe hack to generate 'Exn' exception keys.-	-- This is safe if you use a different string each time (and 'hashString' doesn't collide), and if @e@ is a single type.-	;-	unsafeExnFromString :: String -> Exn e;-	unsafeExnFromString = unsafeIOWitnessFromString;-	-	instance Typeable ExnException where-	{-		typeOf _ = mkTyConApp (mkTyCon "Data.OpenWitness.Exception.ExnException") [];-	};-	-	throw :: Exn e -> e -> a;-	throw exn e = throwDyn (MkExnException (MkAny exn e));-	-	catch :: IO a -> Exn e -> (e -> IO a) -> IO a;-	catch foo exn catcher = catchDyn foo (\ex@(MkExnException cell) -> case matchAny exn cell of-	{-		Just e -> catcher e;-		_ -> throwDyn ex;-	});+    instance TestEquality Exn where+    {+        testEquality (MkExn a) (MkExn b) = testEquality a b;+    };++    newtype ExnException = MkExnException (Any Exn) deriving Typeable;++    -- | Template Haskell function to declare 'Exn' exception keys.+    ;+    declexn :: TypeQ -> Q Exp;+    declexn te = [| MkExn $(iowitness te) |];++    instance Show ExnException where+    {+        show _ = "ExnException";+    };++    instance CE.Exception ExnException;++    throw :: Exn e -> e -> a;+    throw exn e = CE.throw (MkExnException (MkAny exn e));++    catch :: IO a -> Exn e -> (e -> IO a) -> IO a;+    catch foo exn catcher = CE.catch foo (\ex@(MkExnException cell) -> case matchAny exn cell of+    {+        Just e -> catcher e;+        _ -> CE.throw ex;+    }); }
+ Data/OpenWitness/OpenRep.hs view
@@ -0,0 +1,70 @@+module Data.OpenWitness.OpenRep where+{+--    import Data.Witness;+--    import Data.OpenWitness;+--    import Data.Maybe;+{-+        data T2 (a :: * -> * -> *);++    data OpenRep2 p where+    {+        SimpleOpenRep2 :: IOWitness (T2 p) -> OpenRep2 p;+--        ApplyOpenRep2 :: OpenRep3 p -> OpenRep a -> OpenRep2 (p a);+    };++    matchOpenRep2 :: OpenRep2 a -> OpenRep2 b -> Maybe (EqualType (T2 a) (T2 b));+    matchOpenRep2 (SimpleOpenRep2 wa) (SimpleOpenRep2 wb) = testEquality wa wb;+{-+    matchOpenRep2 (ApplyOpenRep1 tfa ta) (ApplyOpenRep1 tfb tb) = do+    {+        MkEqualType <- matchOpenRep2 tfa tfb;+        MkEqualType <- testEquality ta tb;+        return MkEqualType;+    };+    matchOpenRep2 _ _ = Nothing;+-}++        data T1 (a :: * -> *);++    data OpenRep1 p where+    {+        SimpleOpenRep1 :: IOWitness (T1 p) -> OpenRep1 p;+        ApplyOpenRep1 :: OpenRep2 p -> OpenRep a -> OpenRep1 (p a);+    };++    matchOpenRep1 :: OpenRep1 a -> OpenRep1 b -> Maybe (EqualType (T1 a) (T1 b));+    matchOpenRep1 (SimpleOpenRep1 wa) (SimpleOpenRep1 wb) = testEquality wa wb;+    matchOpenRep1 (ApplyOpenRep1 tfa ta) (ApplyOpenRep1 tfb tb) = do+    {+        MkEqualType <- matchOpenRep2 tfa tfb;+        MkEqualType <- testEquality ta tb;+        return MkEqualType;+    };+    matchOpenRep1 _ _ = Nothing;+-}++{-+    data OpenRep :: k -> * where+    {+        SimpleOpenRep :: IOWitness a -> OpenRep a;+        ApplyOpenRep :: OpenRep p -> OpenRep a -> OpenRep (p a);+    };++    instance TestEquality OpenRep where+    {+        testEquality (SimpleOpenRep wa) (SimpleOpenRep wb) = testEquality wa wb;+        testEquality (ApplyOpenRep tfa ta) (ApplyOpenRep tfb tb) = do+        {+            MkEqualType <- testEquality tfa tfb;+            MkEqualType <- testEquality ta tb;+            return MkEqualType;+        };+        testEquality _ _ = Nothing;+    };++    instance Eq1 OpenRep where+    {+        equals1 r1 r2 = isJust (testEquality r1 r2);+    };+-}+}
Data/OpenWitness/ST.hs view
@@ -1,57 +1,59 @@ -- | This is an approximate re-implementation of "Control.Monad.ST" and "Data.STRef" using open witnesses. module Data.OpenWitness.ST (-	-- * The @ST@ Monad-	ST,runST,fixST,-	-- * Converting @ST@ to @OW@ and @IO@-	stToOW,RealWorld,stToIO,-	-- * STRefs-	STRef,newSTRef,readSTRef,writeSTRef,modifySTRef+    -- * The @ST@ Monad+    ST,runST,fixST,+    -- * Converting @ST@ to @OW@ and @IO@+    stToOW,RealWorld,stToIO,+    -- * STRefs+    STRef,newSTRef,readSTRef,writeSTRef,modifySTRef ) where {-	import Data.OpenWitness;-	import Data.Witness.WitnessDict;-	import Control.Monad.State;-	-	type ST s = StateT (WitnessDict (OpenWitness s)) (OW s);+    import Data.OpenWitness;+    import Data.Witness.WitnessDict;+    import Control.Monad.Trans.State;+    import Control.Monad.Trans.Class;+    import Control.Monad.Fix; -	stToOW :: ST s a -> OW s a;-	stToOW st = evalStateT st emptyWitnessDict;+    type ST s = StateT (WitnessDict (OpenWitness s)) (OW s); -	runST :: (forall s . ST s a) -> a;-	runST st = runOW (stToOW st);-	-	fixST :: (a -> ST s a) -> ST s a;-	fixST = mfix;+    stToOW :: ST s a -> OW s a;+    stToOW st = evalStateT st emptyWitnessDict; -	type STRef = OpenWitness;-	-	newSTRef :: a -> ST s (STRef s a);-	newSTRef a = do-	{-		wit <- lift newOpenWitnessOW;-		dict <- get;-		put (witnessDictAdd wit a dict);-		return wit;-	};-	-	readSTRef :: STRef s a -> ST s a;-	readSTRef key = do-	{-		dict <- get;-		case witnessDictLookup key dict of-		{-			Just a -> return a;-			_ -> fail "ref not found";-		};-	};-	-	writeSTRef :: forall s a. STRef s a -> a -> ST s ();-	writeSTRef key newa = modify (witnessDictReplace key newa);-	-	modifySTRef :: forall s a. STRef s a -> (a -> a) -> ST s ();-	modifySTRef key amap = modify (witnessDictModify key amap);-	-	stToIO :: ST RealWorld a -> IO a;-	stToIO = owToIO . stToOW;+    runST :: (forall s . ST s a) -> a;+    runST st = runOW (stToOW st);++    fixST :: (a -> ST s a) -> ST s a;+    fixST = mfix;++    type STRef = OpenWitness;++    newSTRef :: a -> ST s (STRef s a);+    newSTRef a = do+    {+        wit <- lift newOpenWitnessOW;+        dict <- get;+        put (witnessDictAdd wit a dict);+        return wit;+    };++    readSTRef :: STRef s a -> ST s a;+    readSTRef key = do+    {+        dict <- get;+        case witnessDictLookup key dict of+        {+            Just a -> return a;+            _ -> fail "ref not found";+        };+    };++    writeSTRef :: forall s a. STRef s a -> a -> ST s ();+    writeSTRef key newa = modify (witnessDictReplace key newa);++    modifySTRef :: forall s a. STRef s a -> (a -> a) -> ST s ();+    modifySTRef key amap = modify (witnessDictModify key amap);++    stToIO :: ST RealWorld a -> IO a;+    stToIO = owToIO . stToOW; }
Data/OpenWitness/Typeable.hs view
@@ -1,109 +1,102 @@ -- | This is an approximate re-implementation of "Data.Typeable" using open witnesses.-module Data.OpenWitness.Typeable-(-	module Data.OpenWitness.Typeable.Rep,-	module Data.OpenWitness.Typeable-) where+module Data.OpenWitness.Typeable where {-	import Data.OpenWitness.Typeable.Rep;-	import Data.OpenWitness;-	import Data.Witness;-	import Data.Maybe;+{-+    import Data.OpenWitness.OpenRep;+    import Data.OpenWitness;+    import Data.Witness; -	-- | types of kind @*@ with a representation-	;-	class Typeable a where-	{-		rep :: Rep a;-	};+    -- | types of kind @*@ with a representation+    ;+    class Typeable a where+    {+        rep :: OpenRep a;+    }; -	-- | types of kind @* -> *@ with a representation-	;-	class Typeable1 t where-	{-		rep1 :: Rep1 t;-	};+    -- | types of kind @* -> *@ with a representation+    ;+    class Typeable1 t where+    {+        rep1 :: OpenRep1 t;+    }; -	-- | types of kind @* -> * -> *@ with a representation-	;-	class Typeable2 t where-	{-		rep2 :: Rep2 t;-	};+    -- | types of kind @* -> * -> *@ with a representation+    ;+    class Typeable2 t where+    {+        rep2 :: OpenRep2 t;+    }; -	instance (Typeable1 f,Typeable a) => Typeable (f a) where-	{-		rep = ApplyRep rep1 rep;-	};+    instance (Typeable1 f,Typeable a) => Typeable (f a) where+    {+        rep = ApplyOpenRep rep1 rep;+    }; -	instance (Typeable2 f,Typeable a) => Typeable1 (f a) where-	{-		rep1 = ApplyRep1 rep2 rep;-	};+    instance (Typeable2 f,Typeable a) => Typeable1 (f a) where+    {+        rep1 = ApplyOpenRep1 rep2 rep;+    }; -	instance Typeable2 (->) where-	{-		rep2 = SimpleRep2 witFn where-		{-			witFn :: IOWitness (() -> ()); -- <- newIOWitness;-			witFn = unsafeIOWitnessFromString "Data.OpenWitness.Typeable.witFn";-		};-	};+    instance Typeable2 (->) where+    {+        rep2 = SimpleOpenRep2 $(iowitness [t|T2 (->)|]);+    }; -	cast :: forall a b. (Typeable a,Typeable b) => a -> Maybe b;-	cast a = do-	{-		MkEqualType :: EqualType a b <- matchWitness rep rep;-		return a;-	};+    cast :: forall a b. (Typeable a,Typeable b) => a -> Maybe b;+    cast a = do+    {+        MkEqualType :: EqualType a b <- testEquality rep rep;+        return a;+    }; -	gcast :: forall a b c. (Typeable a,Typeable b) => c a -> Maybe (c b);-	gcast ca = do-	{-		MkEqualType :: EqualType a b <- matchWitness rep rep;-		return ca;-	};+    gcast :: forall a b c. (Typeable a,Typeable b) => c a -> Maybe (c b);+    gcast ca = do+    {+        MkEqualType :: EqualType a b <- testEquality rep rep;+        return ca;+    }; -	-- | represents a type of kind @*@-	;-	type TypeRep = AnyWitness Rep;+    -- | represents a type of kind @*@+    ;+    type TypeRep = AnyWitness OpenRep; -	typeOf :: forall t. (Typeable t) => t -> TypeRep;-	typeOf _ = MkAnyWitness (rep :: Rep t);-	-	-- | represents a type of kind @* -> *@-	;-	type TypeRep1 = AnyWitness1 Rep1;+    typeOf :: forall t. (Typeable t) => t -> TypeRep;+    typeOf _ = MkAnyWitness (rep :: OpenRep t); -	typeOf1 :: forall t a. (Typeable1 t) => t a -> TypeRep1;-	typeOf1 _ = MkAnyWitness1 (rep1 :: Rep1 t);-	-	-- | represents a type of kind @* -> * -> *@-	;-	type TypeRep2 = AnyWitness2 Rep2;+    -- | represents a type of kind @* -> *@+    ;+    type TypeRep1 = AnyWitness1 OpenRep1; -	typeOf2 :: forall t a b. (Typeable2 t) => t a b -> TypeRep2;-	typeOf2 _ = MkAnyWitness2 (rep2 :: Rep2 t);-	-	-- | given representations of @a@ and @b@, make a representation of @a -> b@-	;-	mkFunTy :: TypeRep -> TypeRep -> TypeRep;-	mkFunTy (MkAnyWitness ta) (MkAnyWitness tb) = MkAnyWitness (ApplyRep (ApplyRep1 (rep2 :: Rep2 (->)) ta) tb);+    typeOf1 :: forall t a. (Typeable1 t) => t a -> TypeRep1;+    typeOf1 _ = MkAnyWitness1 (rep1 :: OpenRep1 t); -	-- | given representations of @a -> b@ and @a@, make a representation of @b@ (otherwise not)-	;-	funResultTy :: TypeRep -> TypeRep -> Maybe TypeRep;-	funResultTy (MkAnyWitness (ApplyRep (ApplyRep1 repFn' ta') tb')) (MkAnyWitness ta) = do-	{-		MkEqualType <- matchRep2 repFn' (rep2 :: Rep2 (->));-		MkEqualType <- matchWitness ta' ta;-		return (MkAnyWitness tb');-	};-	funResultTy _ _ = Nothing;-	-	mkAppTy :: TypeRep1 -> TypeRep -> TypeRep;-	mkAppTy (MkAnyWitness1 tf) (MkAnyWitness ta) = MkAnyWitness (ApplyRep tf ta);-	-	mkAppTy1 :: TypeRep2 -> TypeRep -> TypeRep1;-	mkAppTy1 (MkAnyWitness2 tf) (MkAnyWitness ta) = MkAnyWitness1 (ApplyRep1 tf ta);+    -- | represents a type of kind @* -> * -> *@+    ;+    type TypeRep2 = AnyWitness2 OpenRep2;++    typeOf2 :: forall t a b. (Typeable2 t) => t a b -> TypeRep2;+    typeOf2 _ = MkAnyWitness2 (rep2 :: OpenRep2 t);++    -- | given representations of @a@ and @b@, make a representation of @a -> b@+    ;+    mkFunTy :: TypeRep -> TypeRep -> TypeRep;+    mkFunTy (MkAnyWitness ta) (MkAnyWitness tb) = MkAnyWitness (ApplyOpenRep (ApplyOpenRep1 (rep2 :: OpenRep2 (->)) ta) tb);++    -- | given representations of @a -> b@ and @a@, make a representation of @b@ (otherwise not)+    ;+    funResultTy :: TypeRep -> TypeRep -> Maybe TypeRep;+    funResultTy (MkAnyWitness (ApplyOpenRep (ApplyOpenRep1 repFn' ta') tb')) (MkAnyWitness ta) = do+    {+        MkEqualType <- matchOpenRep2 repFn' (rep2 :: OpenRep2 (->));+        MkEqualType <- testEquality ta' ta;+        return (MkAnyWitness tb');+    };+    funResultTy _ _ = Nothing;++    mkAppTy :: TypeRep1 -> TypeRep -> TypeRep;+    mkAppTy (MkAnyWitness1 tf) (MkAnyWitness ta) = MkAnyWitness (ApplyOpenRep tf ta);++    mkAppTy1 :: TypeRep2 -> TypeRep -> TypeRep1;+    mkAppTy1 (MkAnyWitness2 tf) (MkAnyWitness ta) = MkAnyWitness1 (ApplyOpenRep1 tf ta);+-} }
− Data/OpenWitness/Typeable/Rep.hs
@@ -1,62 +0,0 @@-module Data.OpenWitness.Typeable.Rep where-{-	import Data.Witness;-	import Data.OpenWitness;-	import Data.Maybe;--	data Rep2 p where-	{-		SimpleRep2 :: IOWitness (p () ()) -> Rep2 p;---		ApplyRep2 :: TypeRep3 p -> Rep a -> Rep2 (p a);-	};--	matchRep2 :: Rep2 a -> Rep2 b -> Maybe (EqualType (a () ()) (b () ()));-	matchRep2 (SimpleRep2 wa) (SimpleRep2 wb) = matchWitness wa wb;-{--	matchRep2 (ApplyRep1 tfa ta) (ApplyRep1 tfb tb) = do-	{-		MkEqualType <- matchRep2 tfa tfb;-		MkEqualType <- matchWitness ta tb;-		return MkEqualType;-	};-	matchRep2 _ _ = Nothing;--}-	data Rep1 p where-	{-		SimpleRep1 :: IOWitness (p ()) -> Rep1 p;-		ApplyRep1 :: Rep2 p -> Rep a -> Rep1 (p a);-	};--	matchRep1 :: Rep1 a -> Rep1 b -> Maybe (EqualType (a ()) (b ()));-	matchRep1 (SimpleRep1 wa) (SimpleRep1 wb) = matchWitness wa wb;-	matchRep1 (ApplyRep1 tfa ta) (ApplyRep1 tfb tb) = do-	{-		MkEqualType <- matchRep2 tfa tfb;-		MkEqualType <- matchWitness ta tb;-		return MkEqualType;-	};-	matchRep1 _ _ = Nothing;--	data Rep a where-	{-		SimpleRep :: IOWitness a -> Rep a;-		ApplyRep :: Rep1 p -> Rep a -> Rep (p a);-	};--	instance SimpleWitness Rep where-	{-		matchWitness (SimpleRep wa) (SimpleRep wb) = matchWitness wa wb;-		matchWitness (ApplyRep tfa ta) (ApplyRep tfb tb) = do-		{-			MkEqualType <- matchRep1 tfa tfb;-			MkEqualType <- matchWitness ta tb;-			return MkEqualType;-		};-		matchWitness _ _ = Nothing;-	};--	instance Eq1 Rep where-	{-		equals1 r1 r2 = isJust (matchWitness r1 r2);-	};-}
open-witness.cabal view
@@ -1,32 +1,49 @@-name:			open-witness-version:		0.1.1-license:		BSD3-license-file:	LICENSE-author:			Ashley Yakeley <ashley@semantic.org>-maintainer:		Ashley Yakeley <ashley@semantic.org>-build-depends:	base>=2.0, mtl>=1.1, witness==0.1-category:		Data-synopsis:		open witnesses+cabal-version:  >=1.14+name:           open-witness+version:        0.3.1+x-follows-version-policy:+license:        BSD3+license-file:   LICENSE+copyright:      Ashley Yakeley <ashley@semantic.org>+author:         Ashley Yakeley <ashley@semantic.org>+maintainer:     Ashley Yakeley <ashley@semantic.org>+homepage:       https://github.com/AshleyYakeley/open-witness+bug-reports:    https://github.com/AshleyYakeley/open-witness/issues+synopsis:       open witnesses description:-	Open witnesses are witnesses that can witness to any type. However, they cannot be constructed, they can only be generated in the IO monad.+    Open witnesses are witnesses that can witness to any type. However, they cannot be constructed, they can only be generated in the IO monad.+    See the paper /Witnesses and Open Witnesses/ (<http://semantic.org/stuff/Open-Witnesses.pdf>).+category:       Data+build-type:     Simple -	See the paper /Witnesses and Open Witnesses/ (<http://semantic.org/stuff/Open-Witnesses.pdf>).-build-type:		Simple-extensions:-	RankNTypes-	EmptyDataDecls-	GeneralizedNewtypeDeriving-	ScopedTypeVariables-	GADTs-	PatternSignatures-	FlexibleContexts-	FlexibleInstances-	MultiParamTypeClasses-exposed-modules:-	Data.OpenWitness-	Data.OpenWitness.ST-	Data.OpenWitness.Typeable-	Data.OpenWitness.Typeable.Rep-	Data.OpenWitness.Dynamic-	Data.OpenWitness.Exception-other-modules:+library+    hs-source-dirs: .+    default-language: Haskell2010+    default-extensions:+        MultiParamTypeClasses+        RankNTypes+        FlexibleContexts+        TypeOperators+        FlexibleInstances+        EmptyDataDecls+        KindSignatures+        TemplateHaskell+        GeneralizedNewtypeDeriving+        GADTs+        PolyKinds+        ScopedTypeVariables+    build-depends:+        base >= 4.8 && < 5,+        random,+        template-haskell,+        transformers,+        hashable,+        witness >= 0.3+    exposed-modules:+        Data.OpenWitness+        Data.OpenWitness.Dynamic+        Data.OpenWitness.Exception+        Data.OpenWitness.OpenRep+        Data.OpenWitness.ST+        Data.OpenWitness.Typeable+    ghc-options: -Wall