{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE CPP #-} module Foundation.Collection.Copy ( Copy(..) ) where import GHC.ST (runST) import Basement.Compat.Base ((>>=)) import Basement.Nat import Basement.Types.OffsetSize import qualified Basement.Block as BLK import qualified Basement.UArray as UA import qualified Basement.BoxedArray as BA import qualified Basement.String as S #if MIN_VERSION_base(4,9,0) import qualified Basement.Sized.Block as BLKN import qualified Basement.Sized.List as LN #endif class Copy a where copy :: a -> a instance Copy [ty] where copy :: [ty] -> [ty] copy [ty] a = [ty] a instance UA.PrimType ty => Copy (BLK.Block ty) where copy :: Block ty -> Block ty copy Block ty blk = (forall s. ST s (Block ty)) -> Block ty forall a. (forall s. ST s a) -> a runST (Block ty -> ST s (MutableBlock ty (PrimState (ST s))) forall (prim :: * -> *) ty. (PrimMonad prim, PrimType ty) => Block ty -> prim (MutableBlock ty (PrimState prim)) BLK.thaw Block ty blk ST s (MutableBlock ty s) -> (MutableBlock ty s -> ST s (Block ty)) -> ST s (Block ty) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= MutableBlock ty s -> ST s (Block ty) forall (prim :: * -> *) ty. PrimMonad prim => MutableBlock ty (PrimState prim) -> prim (Block ty) BLK.unsafeFreeze) instance UA.PrimType ty => Copy (UA.UArray ty) where copy :: UArray ty -> UArray ty copy = UArray ty -> UArray ty forall ty. PrimType ty => UArray ty -> UArray ty UA.copy instance Copy (BA.Array ty) where copy :: Array ty -> Array ty copy = Array ty -> Array ty forall ty. Array ty -> Array ty BA.copy instance Copy S.String where copy :: String -> String copy = String -> String S.copy #if MIN_VERSION_base(4,9,0) instance Copy (LN.ListN n ty) where copy :: ListN n ty -> ListN n ty copy ListN n ty a = ListN n ty a instance (Countable ty n, UA.PrimType ty, KnownNat n) => Copy (BLKN.BlockN n ty) where copy :: BlockN n ty -> BlockN n ty copy BlockN n ty blk = (forall s. ST s (BlockN n ty)) -> BlockN n ty forall a. (forall s. ST s a) -> a runST (BlockN n ty -> ST s (MutableBlockN n ty (PrimState (ST s))) forall (n :: Nat) (prim :: * -> *) ty. (KnownNat n, PrimMonad prim, PrimType ty) => BlockN n ty -> prim (MutableBlockN n ty (PrimState prim)) BLKN.thaw BlockN n ty blk ST s (MutableBlockN n ty s) -> (MutableBlockN n ty s -> ST s (BlockN n ty)) -> ST s (BlockN n ty) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= MutableBlockN n ty s -> ST s (BlockN n ty) forall (prim :: * -> *) ty (n :: Nat). (PrimMonad prim, PrimType ty, Countable ty n) => MutableBlockN n ty (PrimState prim) -> prim (BlockN n ty) BLKN.freeze) #endif