{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Data.GI.Gio.ListModel.SeqStore
  ( SeqStore (..),
    seqStoreNew,
    seqStoreFromList,
    empty,
    replaceList,
    seqStoreLookup,
    getSeq,
  )
where

import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.GI.Base.BasicTypes
import Data.GI.Base.Overloading (HasParentTypes, ParentTypes)
import Data.GI.Gio.ListModel.CustomStore (CustomStore (..), CustomStoreImpl (..), customStoreGetPrivate, customStoreNew)
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import GI.Gio.Interfaces.ListModel (ListModel, listModelItemsChanged)

-- | Imlementation of 'CustomStore' backed by 'IORef (Seq a)'.
newtype SeqStore a = SeqStore (ManagedPtr (CustomStore (IORef (Seq a)) a))

instance TypedObject (SeqStore a) where
  glibType :: IO GType
glibType = TypedObject ListModel => IO GType
forall a. TypedObject a => IO GType
glibType @ListModel

instance GObject (SeqStore a)

instance HasParentTypes (SeqStore a)

type instance ParentTypes (SeqStore a) = '[ListModel]

-- | Create a new 'SeqStore' from a given 'Seq'.
seqStoreNew :: MonadIO m => Seq a -> m (SeqStore a)
seqStoreNew :: Seq a -> m (SeqStore a)
seqStoreNew Seq a
list = IO (SeqStore a) -> m (SeqStore a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SeqStore a) -> m (SeqStore a))
-> IO (SeqStore a) -> m (SeqStore a)
forall a b. (a -> b) -> a -> b
$ do
  IORef (Seq a)
listRef <- Seq a -> IO (IORef (Seq a))
forall a. a -> IO (IORef a)
newIORef Seq a
list
  let getLength :: IO Word16
getLength = Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> (Seq a -> Int) -> Seq a -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq a -> Int
forall a. Seq a -> Int
Seq.length (Seq a -> Word16) -> IO (Seq a) -> IO Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (Seq a) -> IO (Seq a)
forall a. IORef a -> IO a
readIORef IORef (Seq a)
listRef
      getNthItem :: Word16 -> IO (Maybe a)
getNthItem Word16
n = Int -> Seq a -> Maybe a
forall a. Int -> Seq a -> Maybe a
Seq.lookup (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
n) (Seq a -> Maybe a) -> IO (Seq a) -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (Seq a) -> IO (Seq a)
forall a. IORef a -> IO a
readIORef IORef (Seq a)
listRef
      con :: CustomStore (IORef (Seq a)) a -> SeqStore a
con (CustomStore ManagedPtr (CustomStore (IORef (Seq a)) a)
ptr) = ManagedPtr (CustomStore (IORef (Seq a)) a) -> SeqStore a
forall a. ManagedPtr (CustomStore (IORef (Seq a)) a) -> SeqStore a
SeqStore ManagedPtr (CustomStore (IORef (Seq a)) a)
ptr
  IORef (Seq a)
-> CustomStoreImpl SeqStore a
-> (CustomStore (IORef (Seq a)) a -> SeqStore a)
-> IO (SeqStore a)
forall (m :: * -> *) private (model :: * -> *) a.
MonadIO m =>
private
-> CustomStoreImpl model a
-> (CustomStore private a -> model a)
-> m (model a)
customStoreNew IORef (Seq a)
listRef CustomStoreImpl :: forall (model :: * -> *) a.
IO Word16 -> (Word16 -> IO (Maybe a)) -> CustomStoreImpl model a
CustomStoreImpl {IO Word16
Word16 -> IO (Maybe a)
getNthItem :: Word16 -> IO (Maybe a)
getLength :: IO Word16
getNthItem :: Word16 -> IO (Maybe a)
getLength :: IO Word16
..} CustomStore (IORef (Seq a)) a -> SeqStore a
forall a. CustomStore (IORef (Seq a)) a -> SeqStore a
con

-- | Create a new 'SeqStore' from a given list.
seqStoreFromList :: MonadIO m => [a] -> m (SeqStore a)
seqStoreFromList :: [a] -> m (SeqStore a)
seqStoreFromList = Seq a -> m (SeqStore a)
forall (m :: * -> *) a. MonadIO m => Seq a -> m (SeqStore a)
seqStoreNew (Seq a -> m (SeqStore a))
-> ([a] -> Seq a) -> [a] -> m (SeqStore a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList

-- | Create a new empty 'SeqStore'.
empty :: MonadIO m => m (SeqStore a)
empty :: m (SeqStore a)
empty = Seq a -> m (SeqStore a)
forall (m :: * -> *) a. MonadIO m => Seq a -> m (SeqStore a)
seqStoreNew Seq a
forall a. Monoid a => a
mempty

-- | Replace all elements in a 'SeqStore' with elements from a list. This causes
-- @itemsChanged@ event to be emitted.
replaceList :: MonadIO m => SeqStore a -> [a] -> m ()
replaceList :: SeqStore a -> [a] -> m ()
replaceList store :: SeqStore a
store@(SeqStore ManagedPtr (CustomStore (IORef (Seq a)) a)
customStorePtr) [a]
newList = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  IORef (Seq a)
priv <- CustomStore (IORef (Seq a)) a -> IO (IORef (Seq a))
forall (m :: * -> *) private a.
MonadIO m =>
CustomStore private a -> m private
customStoreGetPrivate (ManagedPtr (CustomStore (IORef (Seq a)) a)
-> CustomStore (IORef (Seq a)) a
forall private a.
ManagedPtr (CustomStore private a) -> CustomStore private a
CustomStore ManagedPtr (CustomStore (IORef (Seq a)) a)
customStorePtr)
  Seq a
oldSeq <- IORef (Seq a) -> IO (Seq a)
forall a. IORef a -> IO a
readIORef IORef (Seq a)
priv
  let newSeq :: Seq a
newSeq = [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList [a]
newList
  IORef (Seq a) -> Seq a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Seq a)
priv Seq a
newSeq
  SeqStore a -> Word32 -> Word32 -> Word32 -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsListModel a) =>
a -> Word32 -> Word32 -> Word32 -> m ()
listModelItemsChanged SeqStore a
store Word32
0 (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Seq a -> Int
forall a. Seq a -> Int
Seq.length Seq a
oldSeq) (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Seq a -> Int
forall a. Seq a -> Int
Seq.length Seq a
newSeq)

-- | Get element at a given position, uses 'Seq.lookup'.
seqStoreLookup :: MonadIO m => SeqStore a -> Int -> m (Maybe a)
seqStoreLookup :: SeqStore a -> Int -> m (Maybe a)
seqStoreLookup SeqStore a
store Int
n = Int -> Seq a -> Maybe a
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
n (Seq a -> Maybe a) -> m (Seq a) -> m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SeqStore a -> m (Seq a)
forall (m :: * -> *) a. MonadIO m => SeqStore a -> m (Seq a)
getSeq SeqStore a
store

-- | Get the 'Seq' out of the 'SeqStore'.
getSeq :: MonadIO m => SeqStore a -> m (Seq a)
getSeq :: SeqStore a -> m (Seq a)
getSeq store :: SeqStore a
store@(SeqStore ManagedPtr (CustomStore (IORef (Seq a)) a)
customStorePtr) =
  IO (Seq a) -> m (Seq a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Seq a) -> m (Seq a)) -> IO (Seq a) -> m (Seq a)
forall a b. (a -> b) -> a -> b
$ IORef (Seq a) -> IO (Seq a)
forall a. IORef a -> IO a
readIORef (IORef (Seq a) -> IO (Seq a)) -> IO (IORef (Seq a)) -> IO (Seq a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CustomStore (IORef (Seq a)) a -> IO (IORef (Seq a))
forall (m :: * -> *) private a.
MonadIO m =>
CustomStore private a -> m private
customStoreGetPrivate (ManagedPtr (CustomStore (IORef (Seq a)) a)
-> CustomStore (IORef (Seq a)) a
forall private a.
ManagedPtr (CustomStore private a) -> CustomStore private a
CustomStore ManagedPtr (CustomStore (IORef (Seq a)) a)
customStorePtr)