{-# LANGUAGE Arrows #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module Aztecs.Asset.AssetLoader
  ( MonadAssetLoader (..),
    AssetLoader,
    AssetLoaderT (..),
    load,
    loadQuery,
  )
where

import Aztecs.Asset.AssetLoader.Class
import Aztecs.Asset.AssetServer (AssetId (..), AssetServer (..), Handle (..))
import Aztecs.Asset.Class
import Aztecs.ECS
import qualified Aztecs.ECS.Query as Q
import qualified Aztecs.ECS.System as S
import Control.Arrow (returnA)
import Control.Concurrent (forkIO)
import Control.Monad.Identity (Identity)
import Control.Monad.State.Strict (MonadState (..), StateT, runState)
import Data.IORef (newIORef, writeIORef)
import qualified Data.Map.Strict as Map

type AssetLoader a o = AssetLoaderT a Identity o

newtype AssetLoaderT a m o = AssetLoaderT {forall a (m :: * -> *) o.
AssetLoaderT a m o -> StateT (AssetServer a) m o
unAssetLoader :: StateT (AssetServer a) m o}
  deriving newtype ((forall a b. (a -> b) -> AssetLoaderT a m a -> AssetLoaderT a m b)
-> (forall a b. a -> AssetLoaderT a m b -> AssetLoaderT a m a)
-> Functor (AssetLoaderT a m)
forall a b. a -> AssetLoaderT a m b -> AssetLoaderT a m a
forall a b. (a -> b) -> AssetLoaderT a m a -> AssetLoaderT a m b
forall a (m :: * -> *) a b.
Functor m =>
a -> AssetLoaderT a m b -> AssetLoaderT a m a
forall a (m :: * -> *) a b.
Functor m =>
(a -> b) -> AssetLoaderT a m a -> AssetLoaderT a m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a (m :: * -> *) a b.
Functor m =>
(a -> b) -> AssetLoaderT a m a -> AssetLoaderT a m b
fmap :: forall a b. (a -> b) -> AssetLoaderT a m a -> AssetLoaderT a m b
$c<$ :: forall a (m :: * -> *) a b.
Functor m =>
a -> AssetLoaderT a m b -> AssetLoaderT a m a
<$ :: forall a b. a -> AssetLoaderT a m b -> AssetLoaderT a m a
Functor, Functor (AssetLoaderT a m)
Functor (AssetLoaderT a m) =>
(forall a. a -> AssetLoaderT a m a)
-> (forall a b.
    AssetLoaderT a m (a -> b)
    -> AssetLoaderT a m a -> AssetLoaderT a m b)
-> (forall a b c.
    (a -> b -> c)
    -> AssetLoaderT a m a -> AssetLoaderT a m b -> AssetLoaderT a m c)
-> (forall a b.
    AssetLoaderT a m a -> AssetLoaderT a m b -> AssetLoaderT a m b)
-> (forall a b.
    AssetLoaderT a m a -> AssetLoaderT a m b -> AssetLoaderT a m a)
-> Applicative (AssetLoaderT a m)
forall a. a -> AssetLoaderT a m a
forall a b.
AssetLoaderT a m a -> AssetLoaderT a m b -> AssetLoaderT a m a
forall a b.
AssetLoaderT a m a -> AssetLoaderT a m b -> AssetLoaderT a m b
forall a b.
AssetLoaderT a m (a -> b)
-> AssetLoaderT a m a -> AssetLoaderT a m b
forall a b c.
(a -> b -> c)
-> AssetLoaderT a m a -> AssetLoaderT a m b -> AssetLoaderT a m c
forall a (m :: * -> *). Monad m => Functor (AssetLoaderT a m)
forall a (m :: * -> *) a. Monad m => a -> AssetLoaderT a m a
forall a (m :: * -> *) a b.
Monad m =>
AssetLoaderT a m a -> AssetLoaderT a m b -> AssetLoaderT a m a
forall a (m :: * -> *) a b.
Monad m =>
AssetLoaderT a m a -> AssetLoaderT a m b -> AssetLoaderT a m b
forall a (m :: * -> *) a b.
Monad m =>
AssetLoaderT a m (a -> b)
-> AssetLoaderT a m a -> AssetLoaderT a m b
forall a (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> AssetLoaderT a m a -> AssetLoaderT a m b -> AssetLoaderT a m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a (m :: * -> *) a. Monad m => a -> AssetLoaderT a m a
pure :: forall a. a -> AssetLoaderT a m a
$c<*> :: forall a (m :: * -> *) a b.
Monad m =>
AssetLoaderT a m (a -> b)
-> AssetLoaderT a m a -> AssetLoaderT a m b
<*> :: forall a b.
AssetLoaderT a m (a -> b)
-> AssetLoaderT a m a -> AssetLoaderT a m b
$cliftA2 :: forall a (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> AssetLoaderT a m a -> AssetLoaderT a m b -> AssetLoaderT a m c
liftA2 :: forall a b c.
(a -> b -> c)
-> AssetLoaderT a m a -> AssetLoaderT a m b -> AssetLoaderT a m c
$c*> :: forall a (m :: * -> *) a b.
Monad m =>
AssetLoaderT a m a -> AssetLoaderT a m b -> AssetLoaderT a m b
*> :: forall a b.
AssetLoaderT a m a -> AssetLoaderT a m b -> AssetLoaderT a m b
$c<* :: forall a (m :: * -> *) a b.
Monad m =>
AssetLoaderT a m a -> AssetLoaderT a m b -> AssetLoaderT a m a
<* :: forall a b.
AssetLoaderT a m a -> AssetLoaderT a m b -> AssetLoaderT a m a
Applicative, Applicative (AssetLoaderT a m)
Applicative (AssetLoaderT a m) =>
(forall a b.
 AssetLoaderT a m a
 -> (a -> AssetLoaderT a m b) -> AssetLoaderT a m b)
-> (forall a b.
    AssetLoaderT a m a -> AssetLoaderT a m b -> AssetLoaderT a m b)
-> (forall a. a -> AssetLoaderT a m a)
-> Monad (AssetLoaderT a m)
forall a. a -> AssetLoaderT a m a
forall a b.
AssetLoaderT a m a -> AssetLoaderT a m b -> AssetLoaderT a m b
forall a b.
AssetLoaderT a m a
-> (a -> AssetLoaderT a m b) -> AssetLoaderT a m b
forall a (m :: * -> *). Monad m => Applicative (AssetLoaderT a m)
forall a (m :: * -> *) a. Monad m => a -> AssetLoaderT a m a
forall a (m :: * -> *) a b.
Monad m =>
AssetLoaderT a m a -> AssetLoaderT a m b -> AssetLoaderT a m b
forall a (m :: * -> *) a b.
Monad m =>
AssetLoaderT a m a
-> (a -> AssetLoaderT a m b) -> AssetLoaderT a m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a (m :: * -> *) a b.
Monad m =>
AssetLoaderT a m a
-> (a -> AssetLoaderT a m b) -> AssetLoaderT a m b
>>= :: forall a b.
AssetLoaderT a m a
-> (a -> AssetLoaderT a m b) -> AssetLoaderT a m b
$c>> :: forall a (m :: * -> *) a b.
Monad m =>
AssetLoaderT a m a -> AssetLoaderT a m b -> AssetLoaderT a m b
>> :: forall a b.
AssetLoaderT a m a -> AssetLoaderT a m b -> AssetLoaderT a m b
$creturn :: forall a (m :: * -> *) a. Monad m => a -> AssetLoaderT a m a
return :: forall a. a -> AssetLoaderT a m a
Monad)

instance (Monad m, Asset a) => MonadAssetLoader a (AssetLoaderT a m) where
  asset :: FilePath -> AssetConfig a -> AssetLoaderT a m (Handle a)
asset FilePath
path AssetConfig a
cfg = StateT (AssetServer a) m (Handle a) -> AssetLoaderT a m (Handle a)
forall a (m :: * -> *) o.
StateT (AssetServer a) m o -> AssetLoaderT a m o
AssetLoaderT (StateT (AssetServer a) m (Handle a)
 -> AssetLoaderT a m (Handle a))
-> StateT (AssetServer a) m (Handle a)
-> AssetLoaderT a m (Handle a)
forall a b. (a -> b) -> a -> b
$ do
    AssetServer a
server <- StateT (AssetServer a) m (AssetServer a)
forall s (m :: * -> *). MonadState s m => m s
get
    let assetId :: AssetId
assetId = AssetServer a -> AssetId
forall a. AssetServer a -> AssetId
nextAssetId AssetServer a
server
        go :: IO (IORef (Maybe a))
go = do
          IORef (Maybe a)
v <- Maybe a -> IO (IORef (Maybe a))
forall a. a -> IO (IORef a)
newIORef Maybe a
forall a. Maybe a
Nothing
          ThreadId
_ <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
            a
a <- FilePath -> AssetConfig a -> IO a
forall a. Asset a => FilePath -> AssetConfig a -> IO a
loadAsset FilePath
path AssetConfig a
cfg
            IORef (Maybe a) -> Maybe a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe a)
v (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
          IORef (Maybe a) -> IO (IORef (Maybe a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IORef (Maybe a)
v
    AssetServer a -> StateT (AssetServer a) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (AssetServer a -> StateT (AssetServer a) m ())
-> AssetServer a -> StateT (AssetServer a) m ()
forall a b. (a -> b) -> a -> b
$
      AssetServer a
server
        { loadingAssets = Map.insert assetId (Left go) (loadingAssets server),
          nextAssetId = AssetId (unAssetId assetId + 1)
        }
    Handle a -> StateT (AssetServer a) m (Handle a)
forall a. a -> StateT (AssetServer a) m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle a -> StateT (AssetServer a) m (Handle a))
-> Handle a -> StateT (AssetServer a) m (Handle a)
forall a b. (a -> b) -> a -> b
$ AssetId -> Handle a
forall a. AssetId -> Handle a
Handle AssetId
assetId

loadQuery :: (Asset a, ArrowQuery arr) => AssetLoader a o -> arr () o
loadQuery :: forall a (arr :: * -> * -> *) o.
(Asset a, ArrowQuery arr) =>
AssetLoader a o -> arr () o
loadQuery AssetLoader a o
a = proc () -> do
  AssetServer a
assetServer <- arr () (AssetServer a)
forall a. Component a => arr () a
forall (arr :: * -> * -> *) a.
(ArrowQueryReader arr, Component a) =>
arr () a
Q.fetch -< ()
  let (o
o, AssetServer a
assetServer') = State (AssetServer a) o -> AssetServer a -> (o, AssetServer a)
forall s a. State s a -> s -> (a, s)
runState (AssetLoader a o -> State (AssetServer a) o
forall a (m :: * -> *) o.
AssetLoaderT a m o -> StateT (AssetServer a) m o
unAssetLoader AssetLoader a o
a) AssetServer a
assetServer
  arr (AssetServer a) (AssetServer a)
forall a. Component a => arr a a
forall (arr :: * -> * -> *) a.
(ArrowQuery arr, Component a) =>
arr a a
Q.set -< AssetServer a
assetServer'
  arr o o
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< o
o

load :: (ArrowQuery q, ArrowSystem q arr, Asset a) => AssetLoader a o -> arr () o
load :: forall (q :: * -> * -> *) (arr :: * -> * -> *) a o.
(ArrowQuery q, ArrowSystem q arr, Asset a) =>
AssetLoader a o -> arr () o
load AssetLoader a o
a = q () o -> arr () o
forall i a. q i a -> arr i a
forall (q :: * -> * -> *) (arr :: * -> * -> *) i a.
ArrowSystem q arr =>
q i a -> arr i a
S.mapSingle (q () o -> arr () o) -> q () o -> arr () o
forall a b. (a -> b) -> a -> b
$ AssetLoader a o -> q () o
forall a (arr :: * -> * -> *) o.
(Asset a, ArrowQuery arr) =>
AssetLoader a o -> arr () o
loadQuery AssetLoader a o
a