{-# LANGUAGE GADTs #-}

module Data.IORef.Zoom where

import qualified Data.IORef as IO
import Control.Lens

data IORef a where 
  IORef :: IO.IORef x -> ALens' x a -> IORef a

newIORef :: a -> IO (IORef a)
newIORef a = IORef <$> IO.newIORef a <*> pure id

zoomIORef :: ALens' a b -> IORef a -> IORef b
zoomIORef l1 (IORef v l2) = IORef v . fusing $ cloneLens l2 . cloneLens l1

readIORef :: IORef a -> IO a
readIORef (IORef v l) = (^#l) <$> IO.readIORef v

modifyIORef :: IORef a -> (a -> a) -> IO ()
modifyIORef (IORef v l) f = IO.modifyIORef v $ l #%~ f

modifyIORef' :: IORef a -> (a -> a) -> IO ()
modifyIORef' (IORef v l) f = IO.modifyIORef' v $ l #%~ f

writeIORef :: IORef a -> a -> IO ()
writeIORef (IORef v l) a = IO.modifyIORef v $ l #~ a

atomicModifyIORef :: IORef a -> (a -> (a,b)) -> IO b
atomicModifyIORef (IORef v l) f = IO.atomicModifyIORef v g
  where g x = let (a, b) = f $ x^#l in (x & l #~ a, b)

atomicModifyIORef' :: IORef a -> (a -> (a,b)) -> IO b
atomicModifyIORef' (IORef v l) f = IO.atomicModifyIORef' v g
  where g x = let (a, b) = f $ x^#l in (x & l #~ a, b)

atomicWriteIORef :: IORef a -> a -> IO ()
atomicWriteIORef (IORef v l) a = IO.atomicModifyIORef' v f
  where f x = (x & l #~ a, ())