{-# LANGUAGE GADTs #-}

module Data.MultiSTRef (
    MultiSTRef(..)
  , loosenSTRef
  , makeMultiSTRef
  , zoomMultiSTRef
  , newMultiSTRef
  , readMultiSTRef
  , readMultiSTRefList
  , readMultiSTRefHead
  , modifyMultiSTRef, modifyMultiSTRef'
  , writeMultiSTRef
) where

import Data.STRef.Zoom

import Control.Lens 
import Control.Monad.ST

data MultiSTRef s a where
   MultiSTRef :: STRef s x -> ATraversal' x a -> MultiSTRef s a

loosenSTRef :: STRef s a -> MultiSTRef s a
loosenSTRef v = MultiSTRef v id

makeMultiSTRef :: ATraversal' x a -> STRef s x -> MultiSTRef s a
makeMultiSTRef = flip MultiSTRef

zoomMultiSTRef :: ATraversal' a b -> MultiSTRef s a -> MultiSTRef s b
zoomMultiSTRef t1 (MultiSTRef v t2) = MultiSTRef v . confusing $ cloneTraversal t2 . cloneTraversal t1

newMultiSTRef :: a -> ST s (MultiSTRef s a)
newMultiSTRef a = MultiSTRef <$> newSTRef a <*> pure id

readMultiSTRef :: Monoid a => MultiSTRef s a -> ST s a
readMultiSTRef (MultiSTRef v t) = (^. cloneTraversal t) <$> readSTRef v 

readMultiSTRefList :: MultiSTRef s a -> ST s [a]
readMultiSTRefList (MultiSTRef v t) = (^.. cloneTraversal t) <$> readSTRef v

readMultiSTRefHead :: MultiSTRef s a -> ST s (Maybe a)
readMultiSTRefHead (MultiSTRef v t) = (^? cloneTraversal t) <$> readSTRef v

modifyMultiSTRef :: MultiSTRef s a -> (a -> a) -> ST s ()
modifyMultiSTRef (MultiSTRef v t) f = modifySTRef v $ cloneTraversal t %~ f

modifyMultiSTRef' :: MultiSTRef s a -> (a -> a) -> ST s ()
modifyMultiSTRef' (MultiSTRef v t) f = modifySTRef' v $ cloneTraversal t %~ f

writeMultiSTRef :: MultiSTRef s a -> a -> ST s ()
writeMultiSTRef (MultiSTRef v t) a = modifySTRef' v $ cloneTraversal t .~ a