[Haskell-cafe] ANN: unsafely, Flexible access control for unsafe operations and instances
Hiromi ISHII
konn.jinro at gmail.com
Sun Jan 19 05:30:37 UTC 2014
Yesterday, I uploaded the library `unsafely` to Hackage:
http://hackage.haskell.org/package/unsafely
This package provides you the functionality for access control for unsafe operations and instances.
This purpose is somewhat similar to GHC's `NullaryTypeClasses`[^1] extension, but permits more flexible access control.
With this package, you can tag functions and type-class instances as *unsafe* in type constraint.
This library is useful when:
* You want to restrict the access to *unsafe* operations by type constraint
* You have to provide some *unsafe* type-instances for practical reasons.
For example, when writing computer algebra system with type-classes, `Double` type doesn't even form a semi ring,
but we need the instance `Semiring Double` if we want to combine the symbolic computations and the numerical methods.
A simple example:
```haskell
{-# LANGUAGE FlexibleContexts, FlexibleInstances, RankNTypes #-}
{-# LANGUAGE UndecidableInstances #-}
module Main where
import Data.Constraint.Unsafely
import Data.IORef
import Data.Proxy
import System.IO.Unsafe
saferUnsafePerformIO :: Unsafely IO => IO a -> a
saferUnsafePerformIO = unsafePerformIO
global :: Unsafely IO => IORef Int
global = saferUnsafePerformIO $ newIORef 0
unsafelyIO :: (Unsafely IO => a) -> a
unsafelyIO = unsafely (Proxy :: Proxy IO)
main :: IO ()
main = do
unsafelyIO $ readIORef global
-- | uncommenting following line causes type-error!
-- readIORef global
return ()
```
For more detail, please read Haddock[^2].
[^1]: https://ghc.haskell.org/trac/ghc/ticket/7642
[^2]: http://hackage.haskell.org/package/unsafely-0.1.0.0.1/docs/Data-Constraint-Unsafely.html
-- Hiromi ISHII
konn.jinro at gmail.com
More information about the Haskell-Cafe
mailing list