open-witness 0.6 → 0.7
raw patch · 8 files changed
+71/−56 lines, 8 filesdep −mtldep ~basedep ~constraintsdep ~witness
Dependencies removed: mtl
Dependency ranges changed: base, constraints, witness
Files
- changelog.md +4/−0
- open-witness.cabal +47/−41
- src/Data/Type/OpenWitness.hs +4/−2
- src/Data/Type/OpenWitness/Exception.hs +1/−3
- src/Data/Type/OpenWitness/ST.hs +9/−7
- src/Data/Type/OpenWitness/Witnessed.hs +3/−1
- test/Main.hs +2/−2
- test/Object.hs +1/−0
changelog.md view
@@ -1,3 +1,7 @@+## [0.7] - 2024-12-15+- update for witness-0.7+- fix for GHC 9.8, 9.10+ ## [0.6] - 2022-05-10 - update for witness-0.6 - move module hierarchy
open-witness.cabal view
@@ -1,25 +1,32 @@ cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.34.4.+-- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack name: open-witness-version: 0.6+version: 0.7 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. See the 2008 draft paper /Witnesses and Open Witnesses/ (<https://semantic.org/wp-content/uploads/Open-Witnesses.pdf>). category: Data-homepage: https://github.com/AshleyYakeley/open-witness+homepage: https://github.com/AshleyYakeley/open-witness#readme bug-reports: https://github.com/AshleyYakeley/open-witness/issues author: Ashley Yakeley maintainer: <ashley@semantic.org>-copyright: (c) 2017-2022 Ashley Yakeley+copyright: (c) 2017-2024 Ashley Yakeley license: BSD-2-Clause license-file: LICENSE build-type: Simple-extra-source-files:+tested-with:+ GHC == 9.8.4+ , GHC == 9.10.1+extra-doc-files: changelog.md +source-repository head+ type: git+ location: https://github.com/AshleyYakeley/open-witness+ library exposed-modules: Data.Type.OpenWitness@@ -35,57 +42,39 @@ default-extensions: AllowAmbiguousTypes Arrows- ConstraintKinds DataKinds DefaultSignatures- EmptyCase- EmptyDataDecls- ExistentialQuantification- FlexibleContexts- FlexibleInstances- ForeignFunctionInterface+ DerivingStrategies FunctionalDependencies- GADTs- GeneralizedNewtypeDeriving ImplicitParams NoImplicitPrelude- InstanceSigs- KindSignatures LambdaCase- MultiParamTypeClasses OverloadedLabels OverloadedStrings PartialTypeSignatures- PatternGuards PatternSynonyms- PolyKinds- RankNTypes+ QuantifiedConstraints RecordWildCards RecursiveDo RoleAnnotations- ScopedTypeVariables- StandaloneDeriving NoStarIsType TemplateHaskell- TypeApplications+ TypeAbstractions TypeFamilies TypeFamilyDependencies- TypeInType- TypeOperators- TypeSynonymInstances UndecidableInstances UndecidableSuperClasses ViewPatterns- ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wcompat -Wnoncanonical-monad-instances+ ghc-options: -Weverything -Wno-missing-import-lists -Wno-missing-export-lists -Wno-unsafe -Wno-missing-safe-haskell-mode -Wno-missing-kind-signatures -Wno-partial-type-signatures -Wno-missing-role-annotations -Wno-monomorphism-restriction -Wno-missing-local-signatures -Wno-partial-fields -Wno-all-missed-specialisations -Wno-missed-specialisations build-depends:- base >=4.15 && <5- , constraints >=0.13+ base >=4.19 && <5+ , constraints >=0.14 , hashable >=1.3 , random >=1.2 , template-haskell >=2.17 , transformers >=0.5- , witness >=0.6- default-language: Haskell2010+ , witness >=0.7+ default-language: GHC2021 test-suite tests type: exitcode-stdio-1.0@@ -95,19 +84,36 @@ hs-source-dirs: test default-extensions:- RankNTypes- EmptyDataDecls- GeneralizedNewtypeDeriving- ScopedTypeVariables- GADTs- FlexibleContexts- MultiParamTypeClasses+ AllowAmbiguousTypes+ Arrows+ DataKinds+ DefaultSignatures+ DerivingStrategies+ FunctionalDependencies+ ImplicitParams+ NoImplicitPrelude+ LambdaCase+ OverloadedLabels+ OverloadedStrings+ PartialTypeSignatures+ PatternSynonyms+ QuantifiedConstraints+ RecordWildCards+ RecursiveDo+ RoleAnnotations+ NoStarIsType TemplateHaskell+ TypeAbstractions+ TypeFamilies+ TypeFamilyDependencies+ UndecidableInstances+ UndecidableSuperClasses+ ViewPatterns+ ghc-options: -Weverything -Wno-missing-import-lists -Wno-missing-export-lists -Wno-unsafe -Wno-missing-safe-haskell-mode -Wno-missing-kind-signatures -Wno-partial-type-signatures -Wno-missing-role-annotations -Wno-monomorphism-restriction -Wno-missing-local-signatures -Wno-partial-fields -Wno-all-missed-specialisations -Wno-missed-specialisations build-depends:- base >=4.15 && <5- , mtl+ base >=4.19 && <5 , open-witness , tasty , tasty-hunit , witness- default-language: Haskell2010+ default-language: GHC2021
src/Data/Type/OpenWitness.hs view
@@ -24,7 +24,7 @@ import Data.Traversable import Data.Type.Witness import Language.Haskell.TH hiding (Type)-import qualified Language.Haskell.TH+import Language.Haskell.TH qualified import Prelude import System.IO.Unsafe (unsafePerformIO) import System.Random@@ -67,6 +67,7 @@ data RealWorld -- | An 'OpenWitness' for 'IO'.+type IOWitness :: forall k. k -> Type type IOWitness = OpenWitness RealWorld ioWitnessSource :: MVar Int64@@ -84,9 +85,10 @@ -- | 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.+type OW :: forall k. k -> Type -> Type newtype OW s a = MkOW (State OWState a)- deriving (Functor, Applicative, Monad, MonadFix)+ deriving newtype (Functor, Applicative, Monad, MonadFix) -- | Run an 'OW' computation. runOW :: forall a. (forall s. OW s a) -> a
src/Data/Type/OpenWitness/Exception.hs view
@@ -8,11 +8,10 @@ , catch ) where -import qualified Control.Exception as CE (Exception, catch, throw)+import Control.Exception qualified as CE (Exception, catch, throw) import Data.Kind import Data.Type.OpenWitness import Data.Type.Witness-import Data.Typeable import Language.Haskell.TH hiding (Type) import Prelude @@ -25,7 +24,6 @@ newtype ExnException = MkExnException (SomeOf Exn)- deriving (Typeable) -- | Template Haskell function to declare 'Exn' exception keys. declexn :: TypeQ -> Q Exp
src/Data/Type/OpenWitness/ST.hs view
@@ -21,13 +21,14 @@ import Control.Monad.Trans.Class import Control.Monad.Trans.State import Data.Type.OpenWitness-import Data.Type.Witness.Specific.WitnessMap.Of+import Data.Type.Witness.Specific.OrderedWitnessMap.Of import Prelude+import Data.Kind -type ST s = StateT (WitnessMapOf (OpenWitness s)) (OW s)+type ST s = StateT (OrderedWitnessMapOf (OpenWitness s)) (OW s) stToOW :: ST s a -> OW s a-stToOW st = evalStateT st emptyWitnessMapOf+stToOW st = evalStateT st emptyOrderedWitnessMapOf runST :: (forall s. ST s a) -> a runST st = runOW (stToOW st)@@ -35,27 +36,28 @@ fixST :: (a -> ST s a) -> ST s a fixST = mfix +type STRef :: forall k. Type -> k -> Type type STRef s = OpenWitness s newSTRef :: a -> ST s (STRef s a) newSTRef a = do wit <- lift newOpenWitnessOW dict <- get- put (witnessMapOfAdd wit a dict)+ put (orderedWitnessMapOfAdd wit a dict) return wit readSTRef :: STRef s a -> ST s a readSTRef key = do dict <- get- case witnessMapOfLookup key dict of+ case orderedWitnessMapOfLookup key dict of Just a -> return a _ -> error "ref not found" writeSTRef :: forall s a. STRef s a -> a -> ST s ()-writeSTRef key newa = modify (witnessMapOfReplace key newa)+writeSTRef key newa = modify (orderedWitnessMapOfReplace key newa) modifySTRef :: forall s a. STRef s a -> (a -> a) -> ST s ()-modifySTRef key amap = modify (witnessMapOfModify key amap)+modifySTRef key amap = modify (orderedWitnessMapOfModify key amap) stToIO :: ST RealWorld a -> IO a stToIO = owToIO . stToOW
src/Data/Type/OpenWitness/Witnessed.hs view
@@ -10,8 +10,10 @@ import Data.Type.OpenWitness import Data.Type.Witness import Prelude+import Data.Kind -type Witnessed = PairType IOWitness+type Witnessed :: forall k. (k -> Type) -> k -> Type+type Witnessed @k = PairType @k IOWitness unWitnessed :: Witnessed f a -> f a unWitnessed (MkPairType _ fa) = fa
test/Main.hs view
@@ -33,7 +33,7 @@ = NotCaught | IntCaught Int | StringCaught String- deriving (Eq, Show)+ deriving stock (Eq, Show) getCaught :: IO a -> IO Caught getCaught f =@@ -56,7 +56,7 @@ testGroup "test" [ testST- , testCaught "return" NotCaught $ return "hello"+ , testCaught "return" NotCaught $ return ("hello" :: String) , testCaught "throw intExn 3" (IntCaught 3) $ throw intExn 3 , testCaught "throw stringExn text" (StringCaught "text") $ throw stringExn "text" , testCaught "throw intExn 67" (IntCaught 67) $ throw intExn 67
test/Object.hs view
@@ -2,6 +2,7 @@ import Data.Type.OpenWitness import Data.Type.Witness+import Prelude data Object s = forall a. MkObject (OpenWitness s a)