{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UnliftedDatatypes #-}

module Mischief.Assets.Internal.Asset where

import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.State (MonadState (get, put), State, runState)
import Data.Data
import Data.Foldable (for_)
import Data.HashTable.IO qualified as H
import Data.Kind (Type)
import Data.Maybe
import Data.Set (Set)
import Data.Set qualified as Set
import Data.String (IsString)
import Data.Text (Text)
import Data.Text qualified as T
import GHC.Exts (IsString (..))
import KDL (DecodeValue (valueDecoder))
import KDL qualified
import Mischief.Assets.Internal.Path
import Mischief.ECS
import Mischief.ECS.Entities
import Mischief.ECS.Resources
import Path (Path)
import Path qualified

class (Component a) => Asset a where
  type Loadable a :: Bool
  type Loadable a = True

  type Saveable a :: Bool
  type Saveable a = True

  loadAsset :: FilePath -> Text -> IO (Either Text a)
  default loadAsset :: (Loadable a ~ False) => FilePath -> Text -> IO (Either Text a)
  loadAsset FilePath
_ Text
_ = Either Text a -> IO (Either Text a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text a -> IO (Either Text a))
-> Either Text a -> IO (Either Text a)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Either Text a) -> Text -> Either Text a
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text
forall a. Show a => a -> Text
T.show (Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a -> TypeRep) -> Proxy a -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" does not implement a load function!"

  saveAsset :: a -> FilePath -> Text -> IO (Either Text ())
  default saveAsset :: (Saveable a ~ False) => a -> FilePath -> Text -> IO (Either Text ())
  saveAsset a
_ FilePath
_ Text
_ = Either Text () -> IO (Either Text ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text () -> IO (Either Text ()))
-> Either Text () -> IO (Either Text ())
forall a b. (a -> b) -> a -> b
$ Text -> Either Text ()
forall a b. a -> Either a b
Left (Text -> Either Text ()) -> Text -> Either Text ()
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text
forall a. Show a => a -> Text
T.show (Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a -> TypeRep) -> Proxy a -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" does not implement a save function!"

  rec :: a -> Rec ()
  rec = Rec () -> a -> Rec ()
forall a b. a -> b -> a
const (Rec () -> a -> Rec ()) -> Rec () -> a -> Rec ()
forall a b. (a -> b) -> a -> b
$ () -> Rec ()
forall a. a -> StateT RecAssets Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

data RecAsset where
  RecAsset :: AssetRef a -> RecAsset

data LoadRec = LoadRec deriving (Typeable LoadRec
[HookRel LoadRec]
[Hook LoadRec]
Set DefaultComponentType
IsExclusive (IsExclusiveRel LoadRec)
(Typeable LoadRec, IsExclusive (IsExclusiveRel LoadRec)) =>
Set DefaultComponentType
-> [Hook LoadRec]
-> [Hook LoadRec]
-> [Hook LoadRec]
-> [HookRel LoadRec]
-> [HookRel LoadRec]
-> [HookRel LoadRec]
-> Component LoadRec
forall c.
(Typeable c, IsExclusive (IsExclusiveRel c)) =>
Set DefaultComponentType
-> [Hook c]
-> [Hook c]
-> [Hook c]
-> [HookRel c]
-> [HookRel c]
-> [HookRel c]
-> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$conAdd :: [Hook LoadRec]
onAdd :: [Hook LoadRec]
$conSet :: [Hook LoadRec]
onSet :: [Hook LoadRec]
$conRemove :: [Hook LoadRec]
onRemove :: [Hook LoadRec]
$conAddRel :: [HookRel LoadRec]
onAddRel :: [HookRel LoadRec]
$conSetRel :: [HookRel LoadRec]
onSetRel :: [HookRel LoadRec]
$conRemoveRel :: [HookRel LoadRec]
onRemoveRel :: [HookRel LoadRec]
Component)

newtype RecAssets = RecAssets [RecAsset]

type Rec = State RecAssets

addRec :: AssetRef a -> Rec ()
addRec :: forall a. AssetRef a -> Rec ()
addRec AssetRef a
a' = do
  RecAssets a <- StateT RecAssets Identity RecAssets
forall s (m :: * -> *). MonadState s m => m s
get
  put $ RecAssets $ RecAsset a' : a

type RelativePath = Text

data Loading = Loading deriving (Typeable Loading
[HookRel Loading]
[Hook Loading]
Set DefaultComponentType
IsExclusive (IsExclusiveRel Loading)
(Typeable Loading, IsExclusive (IsExclusiveRel Loading)) =>
Set DefaultComponentType
-> [Hook Loading]
-> [Hook Loading]
-> [Hook Loading]
-> [HookRel Loading]
-> [HookRel Loading]
-> [HookRel Loading]
-> Component Loading
forall c.
(Typeable c, IsExclusive (IsExclusiveRel c)) =>
Set DefaultComponentType
-> [Hook c]
-> [Hook c]
-> [Hook c]
-> [HookRel c]
-> [HookRel c]
-> [HookRel c]
-> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$conAdd :: [Hook Loading]
onAdd :: [Hook Loading]
$conSet :: [Hook Loading]
onSet :: [Hook Loading]
$conRemove :: [Hook Loading]
onRemove :: [Hook Loading]
$conAddRel :: [HookRel Loading]
onAddRel :: [HookRel Loading]
$conSetRel :: [HookRel Loading]
onSetRel :: [HookRel Loading]
$conRemoveRel :: [HookRel Loading]
onRemoveRel :: [HookRel Loading]
Component)

data Loaded = Loaded deriving (Typeable Loaded
[HookRel Loaded]
[Hook Loaded]
Set DefaultComponentType
IsExclusive (IsExclusiveRel Loaded)
(Typeable Loaded, IsExclusive (IsExclusiveRel Loaded)) =>
Set DefaultComponentType
-> [Hook Loaded]
-> [Hook Loaded]
-> [Hook Loaded]
-> [HookRel Loaded]
-> [HookRel Loaded]
-> [HookRel Loaded]
-> Component Loaded
forall c.
(Typeable c, IsExclusive (IsExclusiveRel c)) =>
Set DefaultComponentType
-> [Hook c]
-> [Hook c]
-> [Hook c]
-> [HookRel c]
-> [HookRel c]
-> [HookRel c]
-> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$conAdd :: [Hook Loaded]
onAdd :: [Hook Loaded]
$conSet :: [Hook Loaded]
onSet :: [Hook Loaded]
$conRemove :: [Hook Loaded]
onRemove :: [Hook Loaded]
$conAddRel :: [HookRel Loaded]
onAddRel :: [HookRel Loaded]
$conSetRel :: [HookRel Loaded]
onSetRel :: [HookRel Loaded]
$conRemoveRel :: [HookRel Loaded]
onRemoveRel :: [HookRel Loaded]
Component)

data AssetEntity = AssetEntity deriving (Typeable AssetEntity
[HookRel AssetEntity]
[Hook AssetEntity]
Set DefaultComponentType
IsExclusive (IsExclusiveRel AssetEntity)
(Typeable AssetEntity, IsExclusive (IsExclusiveRel AssetEntity)) =>
Set DefaultComponentType
-> [Hook AssetEntity]
-> [Hook AssetEntity]
-> [Hook AssetEntity]
-> [HookRel AssetEntity]
-> [HookRel AssetEntity]
-> [HookRel AssetEntity]
-> Component AssetEntity
forall c.
(Typeable c, IsExclusive (IsExclusiveRel c)) =>
Set DefaultComponentType
-> [Hook c]
-> [Hook c]
-> [Hook c]
-> [HookRel c]
-> [HookRel c]
-> [HookRel c]
-> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$conAdd :: [Hook AssetEntity]
onAdd :: [Hook AssetEntity]
$conSet :: [Hook AssetEntity]
onSet :: [Hook AssetEntity]
$conRemove :: [Hook AssetEntity]
onRemove :: [Hook AssetEntity]
$conAddRel :: [HookRel AssetEntity]
onAddRel :: [HookRel AssetEntity]
$conSetRel :: [HookRel AssetEntity]
onSetRel :: [HookRel AssetEntity]
$conRemoveRel :: [HookRel AssetEntity]
onRemoveRel :: [HookRel AssetEntity]
Component)

loadByRelPath :: forall a. (Asset a, Bundle a) => Text -> System Entity
loadByRelPath :: forall a. (Asset a, Bundle a) => Text -> System Entity
loadByRelPath !Text
path' = do
  path <- Text -> System (Path Abs File)
forall w (m :: * -> *).
MonadSystem w m =>
Text -> m (Path Abs File)
relAssetToAbsFile Text
path'
  loadByAbsPath @a path path'

loadByAbsPath :: forall a. (Asset a, Bundle a) => Path Path.Abs Path.File -> Text -> System Entity
loadByAbsPath :: forall a.
(Asset a, Bundle a) =>
Path Abs File -> Text -> System Entity
loadByAbsPath !Path Abs File
path !Text
relPath = do
  a <- forall a. Asset a => Path Abs File -> System (Maybe Entity)
tryFindAsset @a Path Abs File
path
  relDir <- T.pack . Path.toFilePath . Path.parent <$> Path.parseRelFile (T.unpack relPath)

  case a of
    Just Entity
a -> Entity -> System Entity
forall a. a -> System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Entity
a
    Maybe Entity
Nothing -> do
      entity <- (AssetEntity, Loading, AssetType, AssetFilePath) -> System Entity
forall b. (HasCallStack, Bundle b) => b -> System Entity
spawn (AssetEntity
AssetEntity, Loading
Loading, Proxy a -> AssetType
forall b. Asset b => Proxy b -> AssetType
AssetType (Proxy a -> AssetType) -> Proxy a -> AssetType
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a, AssetFilePath {absFilePath :: Path Abs File
absFilePath = Path Abs File
path, relFilePath :: Text
relFilePath = Text
relPath})

      Just (AssetRegistry registry) <- res @(AssetRegistry a)
      AssetTypeRegistry typeRegistry <- resOrInsertM @AssetTypeRegistry $ AssetTypeRegistry <$> liftIO H.new
      void $ liftIO $ H.mutate typeRegistry path $ \case
        Just Set AssetType
x -> (Set AssetType -> Maybe (Set AssetType)
forall a. a -> Maybe a
Just (Set AssetType -> Maybe (Set AssetType))
-> Set AssetType -> Maybe (Set AssetType)
forall a b. (a -> b) -> a -> b
$ AssetType -> Set AssetType -> Set AssetType
forall a. Ord a => a -> Set a -> Set a
Set.insert (Proxy a -> AssetType
forall b. Asset b => Proxy b -> AssetType
AssetType (Proxy a -> AssetType) -> Proxy a -> AssetType
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) Set AssetType
x, Path Abs File
path)
        Maybe (Set AssetType)
Nothing -> (Set AssetType -> Maybe (Set AssetType)
forall a. a -> Maybe a
Just (Set AssetType -> Maybe (Set AssetType))
-> Set AssetType -> Maybe (Set AssetType)
forall a b. (a -> b) -> a -> b
$ AssetType -> Set AssetType
forall a. a -> Set a
Set.singleton (Proxy a -> AssetType
forall b. Asset b => Proxy b -> AssetType
AssetType (Proxy a -> AssetType) -> Proxy a -> AssetType
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a), Path Abs File
path)

      liftIO $ H.insert registry path entity

      runAfter
        ( do
            loadAsset @a (Path.toFilePath path) relDir
        )
        ( \(!Either Text a
assetData) -> do
            case Either Text a
assetData of
              Left Text
t -> Text -> System ()
forall w (m :: * -> *).
(HasCallStack, MonadSystem w m) =>
Text -> m ()
err [i|Error when loading asset: #{t}|]
              Right a
assetData -> do
                Just loadRec <- Query System Bool -> System (Maybe Bool)
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m (Maybe out)
single [q|entity. Has LoadRec|]

                remove (C @Loading, C @LoadRec) entity
                insert (assetData, Loaded) entity
                trigger (OnLoad @a entity)

                when loadRec $ handleLoadRec assetData (Set.singleton $ typeRep $ Proxy @a)
        )

      pure entity

handleLoadRec :: (Asset a) => a -> Set TypeRep -> System ()
handleLoadRec :: forall a. Asset a => a -> Set TypeRep -> System ()
handleLoadRec a
a Set TypeRep
prev = do
  let (()
_, RecAssets [RecAsset]
recs) = Rec () -> RecAssets -> ((), RecAssets)
forall s a. State s a -> s -> (a, s)
runState (a -> Rec ()
forall a. Asset a => a -> Rec ()
rec a
a) ([RecAsset] -> RecAssets
RecAssets [])
  [RecAsset] -> (RecAsset -> System ()) -> System ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [RecAsset]
recs ((RecAsset -> System ()) -> System ())
-> (RecAsset -> System ()) -> System ()
forall a b. (a -> b) -> a -> b
$ \(RecAsset AssetRef a
a) -> System (Maybe a) -> System ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (System (Maybe a) -> System ()) -> System (Maybe a) -> System ()
forall a b. (a -> b) -> a -> b
$ AssetRef a -> Bool -> Set TypeRep -> System (Maybe a)
forall a. AssetRef a -> Bool -> Set TypeRep -> System (Maybe a)
getAsset AssetRef a
a Bool
True Set TypeRep
prev

data AssetFilePath = AssetFilePath {AssetFilePath -> Path Abs File
absFilePath :: Path Path.Abs Path.File, AssetFilePath -> Text
relFilePath :: Text} deriving (Typeable AssetFilePath
[HookRel AssetFilePath]
[Hook AssetFilePath]
Set DefaultComponentType
IsExclusive (IsExclusiveRel AssetFilePath)
(Typeable AssetFilePath,
 IsExclusive (IsExclusiveRel AssetFilePath)) =>
Set DefaultComponentType
-> [Hook AssetFilePath]
-> [Hook AssetFilePath]
-> [Hook AssetFilePath]
-> [HookRel AssetFilePath]
-> [HookRel AssetFilePath]
-> [HookRel AssetFilePath]
-> Component AssetFilePath
forall c.
(Typeable c, IsExclusive (IsExclusiveRel c)) =>
Set DefaultComponentType
-> [Hook c]
-> [Hook c]
-> [Hook c]
-> [HookRel c]
-> [HookRel c]
-> [HookRel c]
-> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$conAdd :: [Hook AssetFilePath]
onAdd :: [Hook AssetFilePath]
$conSet :: [Hook AssetFilePath]
onSet :: [Hook AssetFilePath]
$conRemove :: [Hook AssetFilePath]
onRemove :: [Hook AssetFilePath]
$conAddRel :: [HookRel AssetFilePath]
onAddRel :: [HookRel AssetFilePath]
$conSetRel :: [HookRel AssetFilePath]
onSetRel :: [HookRel AssetFilePath]
$conRemoveRel :: [HookRel AssetFilePath]
onRemoveRel :: [HookRel AssetFilePath]
Component)

reloadByRelPath :: forall a. (Asset a, Bundle a) => Text -> System Entity
reloadByRelPath :: forall a. (Asset a, Bundle a) => Text -> System Entity
reloadByRelPath !Text
path' = do
  path <- Text -> System (Path Abs File)
forall w (m :: * -> *).
MonadSystem w m =>
Text -> m (Path Abs File)
relAssetToAbsFile Text
path'
  reloadByAbsPath @a path path'

reloadByAbsPath :: forall a. (Asset a, Bundle a) => Path Path.Abs Path.File -> Text -> System Entity
reloadByAbsPath :: forall a.
(Asset a, Bundle a) =>
Path Abs File -> Text -> System Entity
reloadByAbsPath !Path Abs File
path !Text
relPath = do
  a <- forall a. Asset a => Path Abs File -> System (Maybe Entity)
tryFindAsset @a Path Abs File
path
  relDir <- T.pack . Path.toFilePath . Path.parent <$> Path.parseRelFile (T.unpack relPath)

  entity <- case a of
    Just Entity
a -> Entity -> System Entity
forall a. a -> System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Entity
a
    Maybe Entity
Nothing -> do
      (AssetEntity, Loading, AssetType, AssetFilePath) -> System Entity
forall b. (HasCallStack, Bundle b) => b -> System Entity
spawn (AssetEntity
AssetEntity, Loading
Loading, Proxy a -> AssetType
forall b. Asset b => Proxy b -> AssetType
AssetType (Proxy a -> AssetType) -> Proxy a -> AssetType
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a, AssetFilePath {absFilePath :: Path Abs File
absFilePath = Path Abs File
path, relFilePath :: Text
relFilePath = Text
relPath})

  Just (AssetRegistry registry) <- res @(AssetRegistry a)
  AssetTypeRegistry typeRegistry <- resOrInsertM @AssetTypeRegistry $ AssetTypeRegistry <$> liftIO H.new
  void $ liftIO $ H.mutate typeRegistry path $ \case
    Just Set AssetType
x -> (Set AssetType -> Maybe (Set AssetType)
forall a. a -> Maybe a
Just (Set AssetType -> Maybe (Set AssetType))
-> Set AssetType -> Maybe (Set AssetType)
forall a b. (a -> b) -> a -> b
$ AssetType -> Set AssetType -> Set AssetType
forall a. Ord a => a -> Set a -> Set a
Set.insert (Proxy a -> AssetType
forall b. Asset b => Proxy b -> AssetType
AssetType (Proxy a -> AssetType) -> Proxy a -> AssetType
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) Set AssetType
x, Path Abs File
path)
    Maybe (Set AssetType)
Nothing -> (Set AssetType -> Maybe (Set AssetType)
forall a. a -> Maybe a
Just (Set AssetType -> Maybe (Set AssetType))
-> Set AssetType -> Maybe (Set AssetType)
forall a b. (a -> b) -> a -> b
$ AssetType -> Set AssetType
forall a. a -> Set a
Set.singleton (Proxy a -> AssetType
forall b. Asset b => Proxy b -> AssetType
AssetType (Proxy a -> AssetType) -> Proxy a -> AssetType
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a), Path Abs File
path)

  liftIO $ H.insert registry path entity

  runAfter
    ( do
        loadAsset @a (Path.toFilePath path) relDir
    )
    ( \(!Either Text a
assetData) -> do
        case Either Text a
assetData of
          Left Text
t -> Text -> System ()
forall w (m :: * -> *).
(HasCallStack, MonadSystem w m) =>
Text -> m ()
err [i|Error when loading asset: #{t}|]
          Right a
assetData -> do
            C Loading -> Entity -> System ()
forall c. Collectable c ToRemove => c -> Entity -> System ()
remove (forall a. C a
forall {k} (a :: k). C a
C @Loading) Entity
entity
            forall b. (HasCallStack, Bundle b) => b -> Entity -> System ()
(a, Loaded) -> Entity -> System ()
forall b. Bundle b => b -> Entity -> System ()
insert (a
assetData, Loaded
Loaded) Entity
entity
            OnLoad a -> System ()
forall e. Event e => e -> System ()
trigger (forall a. Entity -> OnLoad a
forall {k} (a :: k). Entity -> OnLoad a
OnLoad @a Entity
entity)
    )

  pure entity

-- retrieve' :: forall a. (Asset a) => Text -> System (Maybe a)
-- retrieve' !path' = do
--   e <- retrieveE @a path'
--   case e of
--     Nothing -> pure Nothing
--     Just e -> single [q|e. a|]

-- retrieveE :: forall a. (Asset a) => Text -> System (Maybe Entity)
-- retrieveE !path' = do
--   path <- relAssetToAbsFile path'
--   tryFindAsset @a path

store :: forall a. (Asset a, Bundle a) => Text -> a -> System Entity
store :: forall a. (Asset a, Bundle a) => Text -> a -> System Entity
store !Text
path' !a
a = do
  path <- Text -> System (Path Abs File)
forall w (m :: * -> *).
MonadSystem w m =>
Text -> m (Path Abs File)
relAssetToAbsFile Text
path'
  a' <- tryFindAsset @a path

  entity <- case a' of
    Just Entity
e -> do
      a -> Entity -> System ()
forall b. (HasCallStack, Bundle b) => b -> Entity -> System ()
forall b. Bundle b => b -> Entity -> System ()
insert a
a Entity
e
      Entity -> System Entity
forall a. a -> System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Entity
e
    Maybe Entity
Nothing -> do
      entity <- BundleData ErasedComponent -> System Entity
forall b. (HasCallStack, Bundle b) => b -> System Entity
spawn (BundleData ErasedComponent -> System Entity)
-> BundleData ErasedComponent -> System Entity
forall a b. (a -> b) -> a -> b
$ (AssetEntity, Loading, AssetType, a) -> BundleData ErasedComponent
forall b. Bundle b => b -> BundleData ErasedComponent
bundle (AssetEntity
AssetEntity, Loading
Loading, Proxy a -> AssetType
forall b. Asset b => Proxy b -> AssetType
AssetType (Proxy a -> AssetType) -> Proxy a -> AssetType
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a, a
a)
      when (T.head path' /= '!') $ insert AssetFilePath {absFilePath = path, relFilePath = path'} entity

      Just (AssetRegistry registry) <- res @(AssetRegistry a)
      liftIO $ H.insert registry path entity

      AssetTypeRegistry typeRegistry <- resOrInsertM @AssetTypeRegistry $ AssetTypeRegistry <$> liftIO H.new
      void $ liftIO $ H.mutate typeRegistry path $ \case
        Just Set AssetType
x -> (Set AssetType -> Maybe (Set AssetType)
forall a. a -> Maybe a
Just (Set AssetType -> Maybe (Set AssetType))
-> Set AssetType -> Maybe (Set AssetType)
forall a b. (a -> b) -> a -> b
$ AssetType -> Set AssetType -> Set AssetType
forall a. Ord a => a -> Set a -> Set a
Set.insert (Proxy a -> AssetType
forall b. Asset b => Proxy b -> AssetType
AssetType (Proxy a -> AssetType) -> Proxy a -> AssetType
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) Set AssetType
x, Path Abs File
path)
        Maybe (Set AssetType)
Nothing -> (Set AssetType -> Maybe (Set AssetType)
forall a. a -> Maybe a
Just (Set AssetType -> Maybe (Set AssetType))
-> Set AssetType -> Maybe (Set AssetType)
forall a b. (a -> b) -> a -> b
$ AssetType -> Set AssetType
forall a. a -> Set a
Set.singleton (Proxy a -> AssetType
forall b. Asset b => Proxy b -> AssetType
AssetType (Proxy a -> AssetType) -> Proxy a -> AssetType
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a), Path Abs File
path)

      pure entity

  trigger (OnLoad @a entity)
  pure entity

save :: forall a. (Asset a) => Entity -> System ()
save :: forall a. Asset a => Entity -> System ()
save Entity
e = do
  t <- Query System (a, AssetFilePath)
-> System (Maybe (a, AssetFilePath))
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m (Maybe out)
single [q|e. a, AssetFilePath|]
  case t of
    Maybe (a, AssetFilePath)
Nothing -> Text -> System ()
forall w (m :: * -> *).
(HasCallStack, MonadSystem w m) =>
Text -> m ()
warn (Text -> System ()) -> Text -> System ()
forall a b. (a -> b) -> a -> b
$ Text
"Asset of type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TypeRep -> Text
forall a. Show a => a -> Text
T.show (Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a -> TypeRep) -> Proxy a -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" not found at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Entity -> Text
forall a. Show a => a -> Text
T.show Entity
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
    Just (a
a, AssetFilePath {absFilePath :: AssetFilePath -> Path Abs File
absFilePath = Path Abs File
path, relFilePath :: AssetFilePath -> Text
relFilePath = Text
relPath}) -> do
      IO (Either Text ()) -> (Either Text () -> System ()) -> System ()
forall w (m :: * -> *) a.
MonadSystem w m =>
IO a -> (a -> System ()) -> m ()
runAfter
        ( do
            a -> FilePath -> Text -> IO (Either Text ())
forall a. Asset a => a -> FilePath -> Text -> IO (Either Text ())
saveAsset a
a (Path Abs File -> FilePath
forall b t. Path b t -> FilePath
Path.toFilePath Path Abs File
path) Text
relPath
        )
        ( \case
            Left Text
t -> Text -> System ()
forall w (m :: * -> *).
(HasCallStack, MonadSystem w m) =>
Text -> m ()
warn Text
t
            Either Text ()
_ -> () -> System ()
forall a. a -> System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        )

tryFindAsset :: forall a. (Asset a) => Path Path.Abs Path.File -> System (Maybe Entity)
tryFindAsset :: forall a. Asset a => Path Abs File -> System (Maybe Entity)
tryFindAsset !Path Abs File
path = do
  AssetRegistry registry <- forall r. (Component r, Bundle r) => System r -> System r
resOrInsertM @(AssetRegistry a) (HashTable RealWorld (Path Abs File) Entity -> AssetRegistry a
HashMap (Path Abs File) Entity -> AssetRegistry a
forall {k} (a :: k).
HashMap (Path Abs File) Entity -> AssetRegistry a
AssetRegistry (HashTable RealWorld (Path Abs File) Entity -> AssetRegistry a)
-> System (HashTable RealWorld (Path Abs File) Entity)
-> System (AssetRegistry a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (HashTable RealWorld (Path Abs File) Entity)
-> System (HashTable RealWorld (Path Abs File) Entity)
forall a. IO a -> System a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (HashTable RealWorld (Path Abs File) Entity)
IO (HashMap (Path Abs File) Entity)
forall (h :: * -> * -> * -> *) k v.
HashTable h =>
IO (IOHashTable h k v)
H.new)
  liftIO $ H.lookup registry path

-- newtype Path = Path AssetPath deriving anyclass (Component)

newtype OnLoad a = OnLoad {forall {k} (a :: k). OnLoad a -> Entity
entity :: Entity}
  deriving anyclass (Typeable (OnLoad a)
Typeable (OnLoad a) =>
(OnLoad a -> ErasedEvent) -> Event (OnLoad a)
OnLoad a -> ErasedEvent
forall e. Typeable e => (e -> ErasedEvent) -> Event e
forall k (a :: k). (Typeable a, Typeable k) => Typeable (OnLoad a)
forall k (a :: k).
(Typeable a, Typeable k) =>
OnLoad a -> ErasedEvent
$ceraseEvent :: forall k (a :: k).
(Typeable a, Typeable k) =>
OnLoad a -> ErasedEvent
eraseEvent :: OnLoad a -> ErasedEvent
Event)
  deriving stock (Int -> OnLoad a -> ShowS
[OnLoad a] -> ShowS
OnLoad a -> FilePath
(Int -> OnLoad a -> ShowS)
-> (OnLoad a -> FilePath)
-> ([OnLoad a] -> ShowS)
-> Show (OnLoad a)
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
forall k (a :: k). Int -> OnLoad a -> ShowS
forall k (a :: k). [OnLoad a] -> ShowS
forall k (a :: k). OnLoad a -> FilePath
$cshowsPrec :: forall k (a :: k). Int -> OnLoad a -> ShowS
showsPrec :: Int -> OnLoad a -> ShowS
$cshow :: forall k (a :: k). OnLoad a -> FilePath
show :: OnLoad a -> FilePath
$cshowList :: forall k (a :: k). [OnLoad a] -> ShowS
showList :: [OnLoad a] -> ShowS
Show)

data AssetType where
  AssetType :: (Asset a) => Proxy a -> AssetType
  deriving (Typeable AssetType
[HookRel AssetType]
[Hook AssetType]
Set DefaultComponentType
IsExclusive (IsExclusiveRel AssetType)
(Typeable AssetType, IsExclusive (IsExclusiveRel AssetType)) =>
Set DefaultComponentType
-> [Hook AssetType]
-> [Hook AssetType]
-> [Hook AssetType]
-> [HookRel AssetType]
-> [HookRel AssetType]
-> [HookRel AssetType]
-> Component AssetType
forall c.
(Typeable c, IsExclusive (IsExclusiveRel c)) =>
Set DefaultComponentType
-> [Hook c]
-> [Hook c]
-> [Hook c]
-> [HookRel c]
-> [HookRel c]
-> [HookRel c]
-> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$conAdd :: [Hook AssetType]
onAdd :: [Hook AssetType]
$conSet :: [Hook AssetType]
onSet :: [Hook AssetType]
$conRemove :: [Hook AssetType]
onRemove :: [Hook AssetType]
$conAddRel :: [HookRel AssetType]
onAddRel :: [HookRel AssetType]
$conSetRel :: [HookRel AssetType]
onSetRel :: [HookRel AssetType]
$conRemoveRel :: [HookRel AssetType]
onRemoveRel :: [HookRel AssetType]
Component)

instance Eq AssetType where
  AssetType Proxy a
a == :: AssetType -> AssetType -> Bool
== AssetType Proxy a
b = Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
a TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
b

instance Ord AssetType where
  compare :: AssetType -> AssetType -> Ordering
compare (AssetType Proxy a
a) (AssetType Proxy a
b) = TypeRep -> TypeRep -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
a) (Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
b)

type HashMap k v = H.BasicHashTable k v

newtype AssetRegistry a = AssetRegistry (HashMap (Path Path.Abs Path.File) Entity) deriving anyclass (Typeable (AssetRegistry a)
[HookRel (AssetRegistry a)]
[Hook (AssetRegistry a)]
Set DefaultComponentType
IsExclusive (IsExclusiveRel (AssetRegistry a))
(Typeable (AssetRegistry a),
 IsExclusive (IsExclusiveRel (AssetRegistry a))) =>
Set DefaultComponentType
-> [Hook (AssetRegistry a)]
-> [Hook (AssetRegistry a)]
-> [Hook (AssetRegistry a)]
-> [HookRel (AssetRegistry a)]
-> [HookRel (AssetRegistry a)]
-> [HookRel (AssetRegistry a)]
-> Component (AssetRegistry a)
forall c.
(Typeable c, IsExclusive (IsExclusiveRel c)) =>
Set DefaultComponentType
-> [Hook c]
-> [Hook c]
-> [Hook c]
-> [HookRel c]
-> [HookRel c]
-> [HookRel c]
-> Component c
forall k (a :: k).
(Typeable a, Typeable k) =>
Typeable (AssetRegistry a)
forall k (a :: k).
(Typeable a, Typeable k) =>
[HookRel (AssetRegistry a)]
forall k (a :: k).
(Typeable a, Typeable k) =>
[Hook (AssetRegistry a)]
forall k (a :: k).
(Typeable a, Typeable k) =>
Set DefaultComponentType
forall k (a :: k).
(Typeable a, Typeable k) =>
IsExclusive (IsExclusiveRel (AssetRegistry a))
$crequired :: forall k (a :: k).
(Typeable a, Typeable k) =>
Set DefaultComponentType
required :: Set DefaultComponentType
$conAdd :: forall k (a :: k).
(Typeable a, Typeable k) =>
[Hook (AssetRegistry a)]
onAdd :: [Hook (AssetRegistry a)]
$conSet :: forall k (a :: k).
(Typeable a, Typeable k) =>
[Hook (AssetRegistry a)]
onSet :: [Hook (AssetRegistry a)]
$conRemove :: forall k (a :: k).
(Typeable a, Typeable k) =>
[Hook (AssetRegistry a)]
onRemove :: [Hook (AssetRegistry a)]
$conAddRel :: forall k (a :: k).
(Typeable a, Typeable k) =>
[HookRel (AssetRegistry a)]
onAddRel :: [HookRel (AssetRegistry a)]
$conSetRel :: forall k (a :: k).
(Typeable a, Typeable k) =>
[HookRel (AssetRegistry a)]
onSetRel :: [HookRel (AssetRegistry a)]
$conRemoveRel :: forall k (a :: k).
(Typeable a, Typeable k) =>
[HookRel (AssetRegistry a)]
onRemoveRel :: [HookRel (AssetRegistry a)]
Component)

newtype AssetTypeRegistry = AssetTypeRegistry (HashMap (Path Path.Abs Path.File) (Set AssetType)) deriving anyclass (Typeable AssetTypeRegistry
[HookRel AssetTypeRegistry]
[Hook AssetTypeRegistry]
Set DefaultComponentType
IsExclusive (IsExclusiveRel AssetTypeRegistry)
(Typeable AssetTypeRegistry,
 IsExclusive (IsExclusiveRel AssetTypeRegistry)) =>
Set DefaultComponentType
-> [Hook AssetTypeRegistry]
-> [Hook AssetTypeRegistry]
-> [Hook AssetTypeRegistry]
-> [HookRel AssetTypeRegistry]
-> [HookRel AssetTypeRegistry]
-> [HookRel AssetTypeRegistry]
-> Component AssetTypeRegistry
forall c.
(Typeable c, IsExclusive (IsExclusiveRel c)) =>
Set DefaultComponentType
-> [Hook c]
-> [Hook c]
-> [Hook c]
-> [HookRel c]
-> [HookRel c]
-> [HookRel c]
-> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$conAdd :: [Hook AssetTypeRegistry]
onAdd :: [Hook AssetTypeRegistry]
$conSet :: [Hook AssetTypeRegistry]
onSet :: [Hook AssetTypeRegistry]
$conRemove :: [Hook AssetTypeRegistry]
onRemove :: [Hook AssetTypeRegistry]
$conAddRel :: [HookRel AssetTypeRegistry]
onAddRel :: [HookRel AssetTypeRegistry]
$conSetRel :: [HookRel AssetTypeRegistry]
onSetRel :: [HookRel AssetTypeRegistry]
$conRemoveRel :: [HookRel AssetTypeRegistry]
onRemoveRel :: [HookRel AssetTypeRegistry]
Component)

data AssetRef a where
  Ref :: (Asset a, Bundle a) => Text -> AssetRef a
  EntityRef :: (Asset a, Bundle a) => Entity -> AssetRef a
  SubRef :: AssetRef b -> (b -> a) -> AssetRef a
  TransRef :: forall a b. AssetRef b -> (b -> AssetRef a) -> AssetRef a
  PureRef :: forall a. a -> AssetRef a
  AppRef :: AssetRef (a -> b) -> AssetRef a -> AssetRef b
  NullRef :: AssetRef a

decodeRef :: (Asset a, Bundle a) => Text -> KDL.ValueDecoder (AssetRef a)
decodeRef :: forall a. (Asset a, Bundle a) => Text -> ValueDecoder (AssetRef a)
decodeRef Text
path = do
  t <- forall a. DecodeValue a => ValueDecoder a
valueDecoder @Text
  pure $ Ref (path <> "/" <> t)

-- | Gets an AssetRef's entity. If it is unloaded, it will create an entity and return it.
getRefEntity :: forall a. AssetRef a -> System (Maybe Entity)
getRefEntity :: forall a. AssetRef a -> System (Maybe Entity)
getRefEntity (Ref Text
p') = do
  p <- Text -> System (Path Abs File)
forall w (m :: * -> *).
MonadSystem w m =>
Text -> m (Path Abs File)
relAssetToAbsFile Text
p'
  e <- tryFindAsset @a p
  case e of
    Maybe Entity
Nothing -> Entity -> Maybe Entity
forall a. a -> Maybe a
Just (Entity -> Maybe Entity) -> System Entity -> System (Maybe Entity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
(Asset a, Bundle a) =>
Path Abs File -> Text -> System Entity
loadByAbsPath @a Path Abs File
p Text
p'
    Just Entity
x -> Maybe Entity -> System (Maybe Entity)
forall a. a -> System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Entity -> System (Maybe Entity))
-> Maybe Entity -> System (Maybe Entity)
forall a b. (a -> b) -> a -> b
$ Entity -> Maybe Entity
forall a. a -> Maybe a
Just Entity
x
-- registry <- res @(AssetRegistry a)
-- case registry of
--   Nothing -> pure Nothing
--   Just (AssetRegistry registry) -> do
--     liftIO $ H.lookup registry p
getRefEntity (EntityRef Entity
e) = Maybe Entity -> System (Maybe Entity)
forall a. a -> System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Entity -> System (Maybe Entity))
-> Maybe Entity -> System (Maybe Entity)
forall a b. (a -> b) -> a -> b
$ Entity -> Maybe Entity
forall a. a -> Maybe a
Just Entity
e
getRefEntity (SubRef AssetRef b
_ b -> a
_) = do
  Text -> System ()
forall w (m :: * -> *).
(HasCallStack, MonadSystem w m) =>
Text -> m ()
warn Text
"Attempted to retrieve the entity of a sub asset (data inside a loaded asset). Returning Nothing"
  Maybe Entity -> System (Maybe Entity)
forall a. a -> System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Entity
forall a. Maybe a
Nothing
getRefEntity (TransRef AssetRef b
ref b -> AssetRef a
f) = do
  a <- AssetRef b -> System (Maybe b)
forall a w (m :: * -> *).
MonadSystem w m =>
AssetRef a -> m (Maybe a)
getAsset' AssetRef b
ref
  case a of
    Maybe b
Nothing -> Maybe Entity -> System (Maybe Entity)
forall a. a -> System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Entity
forall a. Maybe a
Nothing
    Just b
a -> AssetRef a -> System (Maybe Entity)
forall a. AssetRef a -> System (Maybe Entity)
getRefEntity (AssetRef a -> System (Maybe Entity))
-> AssetRef a -> System (Maybe Entity)
forall a b. (a -> b) -> a -> b
$ b -> AssetRef a
f b
a
getRefEntity (PureRef a
_) = do
  Text -> System ()
forall w (m :: * -> *).
(HasCallStack, MonadSystem w m) =>
Text -> m ()
warn Text
"Attempted to retrieve the entity of a pure AssetRef. Returning Nothing."
  Maybe Entity -> System (Maybe Entity)
forall a. a -> System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Entity
forall a. Maybe a
Nothing
getRefEntity (AppRef AssetRef (a -> a)
_ AssetRef a
_) = do
  Text -> System ()
forall w (m :: * -> *).
(HasCallStack, MonadSystem w m) =>
Text -> m ()
warn Text
"Attempted to retrieve the entity of an AppRef. Returning Nothing."
  Maybe Entity -> System (Maybe Entity)
forall a. a -> System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Entity
forall a. Maybe a
Nothing
getRefEntity AssetRef a
NullRef = Maybe Entity -> System (Maybe Entity)
forall a. a -> System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Entity
forall a. Maybe a
Nothing

-- | Gets an AssetRef's entity. Won't trigger any IO.
getRefEntity' :: forall a w m. (MonadSystem w m) => AssetRef a -> m (Maybe Entity)
getRefEntity' :: forall a w (m :: * -> *).
MonadSystem w m =>
AssetRef a -> m (Maybe Entity)
getRefEntity' (Ref Text
p) = do
  registry <- forall c (m :: * -> *) w.
(MonadSystem w m, Component c) =>
m (Maybe c)
res @(AssetRegistry a)
  case registry of
    Maybe (AssetRegistry a)
Nothing -> Maybe Entity -> m (Maybe Entity)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Entity
forall a. Maybe a
Nothing
    Just (AssetRegistry HashMap (Path Abs File) Entity
registry) -> do
      p <- Text -> m (Path Abs File)
forall w (m :: * -> *).
MonadSystem w m =>
Text -> m (Path Abs File)
relAssetToAbsFile Text
p
      liftIO $ H.lookup registry p
getRefEntity' (EntityRef Entity
e) = Maybe Entity -> m (Maybe Entity)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Entity -> m (Maybe Entity))
-> Maybe Entity -> m (Maybe Entity)
forall a b. (a -> b) -> a -> b
$ Entity -> Maybe Entity
forall a. a -> Maybe a
Just Entity
e
getRefEntity' (SubRef AssetRef b
_ b -> a
_) = do
  Text -> m ()
forall w (m :: * -> *).
(HasCallStack, MonadSystem w m) =>
Text -> m ()
warn Text
"Attempted to retrieve the entity of a sub asset (data inside a loaded asset). Returning Nothing"
  Maybe Entity -> m (Maybe Entity)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Entity
forall a. Maybe a
Nothing
getRefEntity' (TransRef AssetRef b
ref b -> AssetRef a
f) = do
  a <- AssetRef b -> m (Maybe b)
forall a w (m :: * -> *).
MonadSystem w m =>
AssetRef a -> m (Maybe a)
getAsset' AssetRef b
ref
  case a of
    Maybe b
Nothing -> Maybe Entity -> m (Maybe Entity)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Entity
forall a. Maybe a
Nothing
    Just b
a -> AssetRef a -> m (Maybe Entity)
forall a w (m :: * -> *).
MonadSystem w m =>
AssetRef a -> m (Maybe Entity)
getRefEntity' (AssetRef a -> m (Maybe Entity)) -> AssetRef a -> m (Maybe Entity)
forall a b. (a -> b) -> a -> b
$ b -> AssetRef a
f b
a
getRefEntity' (PureRef a
_) = do
  Text -> m ()
forall w (m :: * -> *).
(HasCallStack, MonadSystem w m) =>
Text -> m ()
warn Text
"Attempted to retrieve the entity of a pure AssetRef. Returning Nothing"
  Maybe Entity -> m (Maybe Entity)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Entity
forall a. Maybe a
Nothing
getRefEntity' (AppRef AssetRef (a -> a)
_ AssetRef a
_) = do
  Text -> m ()
forall w (m :: * -> *).
(HasCallStack, MonadSystem w m) =>
Text -> m ()
warn Text
"Attempted to retrieve the entity of an AppRef. Returning Nothing."
  Maybe Entity -> m (Maybe Entity)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Entity
forall a. Maybe a
Nothing
getRefEntity' AssetRef a
NullRef = Maybe Entity -> m (Maybe Entity)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Entity
forall a. Maybe a
Nothing

-- | Try to get an asset by its AssetRef. Won't trigger any IO.
getAsset' :: forall a w m. (MonadSystem w m) => AssetRef a -> m (Maybe a)
getAsset' :: forall a w (m :: * -> *).
MonadSystem w m =>
AssetRef a -> m (Maybe a)
getAsset' (Ref Text
a) = do
  e <- AssetRef a -> m (Maybe Entity)
forall a w (m :: * -> *).
MonadSystem w m =>
AssetRef a -> m (Maybe Entity)
getRefEntity' (forall a. (Asset a, Bundle a) => Text -> AssetRef a
Ref @a Text
a)
  case e of
    Maybe Entity
Nothing -> Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    Just Entity
e -> Query m a -> m (Maybe a)
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m (Maybe out)
single [q|e. a|]
getAsset' (EntityRef Entity
e) = Query m a -> m (Maybe a)
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m (Maybe out)
single [q|e. a|]
getAsset' (SubRef AssetRef b
a b -> a
f) = (b -> a) -> Maybe b -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> a
f (Maybe b -> Maybe a) -> m (Maybe b) -> m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AssetRef b -> m (Maybe b)
forall a w (m :: * -> *).
MonadSystem w m =>
AssetRef a -> m (Maybe a)
getAsset' AssetRef b
a
getAsset' (TransRef AssetRef b
a b -> AssetRef a
f) = do
  x <- AssetRef b -> m (Maybe b)
forall a w (m :: * -> *).
MonadSystem w m =>
AssetRef a -> m (Maybe a)
getAsset' AssetRef b
a
  case x of
    Maybe b
Nothing -> Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    Just b
x -> do
      AssetRef a -> m (Maybe a)
forall a w (m :: * -> *).
MonadSystem w m =>
AssetRef a -> m (Maybe a)
getAsset' (b -> AssetRef a
f b
x)
getAsset' (PureRef a
a) = Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
a
getAsset' (AppRef AssetRef (a -> a)
f AssetRef a
a) = do
  x <- AssetRef (a -> a) -> m (Maybe (a -> a))
forall a w (m :: * -> *).
MonadSystem w m =>
AssetRef a -> m (Maybe a)
getAsset' AssetRef (a -> a)
f
  y <- getAsset' a
  let z = (,) ((a -> a) -> a -> (a -> a, a))
-> Maybe (a -> a) -> Maybe (a -> (a -> a, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (a -> a)
x Maybe (a -> (a -> a, a)) -> Maybe a -> Maybe (a -> a, a)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe a
y
  case z of
    Maybe (a -> a, a)
Nothing -> Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    Just (a -> a
f, a
a) -> do
      Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a -> a
f a
a
getAsset' AssetRef a
NullRef = Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing

-- loaded :: forall a w m. (MonadSystem w m) => AssetRef a -> m Bool
-- loaded ref = isJust <$> getAsset' ref

type IsRec = Bool

-- | Try to get an AssetRef's value. Will trigger it to load it it's currently unloaded.
getAsset :: forall a. AssetRef a -> IsRec -> Set TypeRep -> System (Maybe a)
getAsset :: forall a. AssetRef a -> Bool -> Set TypeRep -> System (Maybe a)
getAsset (EntityRef Entity
e) Bool
b Set TypeRep
prev = do
  r <- Query System (Maybe a, Maybe AssetFilePath, Bool, Bool)
-> System (Maybe (Maybe a, Maybe AssetFilePath, Bool, Bool))
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m (Maybe out)
single [q|e. Maybe a, Maybe AssetFilePath, Has Loading, Has LoadRec|]
  case r of
    Maybe (Maybe a, Maybe AssetFilePath, Bool, Bool)
Nothing -> Maybe a
forall a. Maybe a
Nothing Maybe a -> System () -> System (Maybe a)
forall a b. a -> System b -> System a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> System ()
forall w (m :: * -> *).
(HasCallStack, MonadSystem w m) =>
Text -> m ()
warn [i|Trying to get asset of invalid entity #{e}|]
    Just (Just a
a, Maybe AssetFilePath
_, Bool
_, Bool
_) -> do
      Bool -> System () -> System ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b (System () -> System ()) -> System () -> System ()
forall a b. (a -> b) -> a -> b
$ do
        let t :: TypeRep
t = Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a -> TypeRep) -> Proxy a -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a
        Bool -> System () -> System ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TypeRep -> Set TypeRep -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member TypeRep
t Set TypeRep
prev) (System () -> System ()) -> System () -> System ()
forall a b. (a -> b) -> a -> b
$ a -> Set TypeRep -> System ()
forall a. Asset a => a -> Set TypeRep -> System ()
handleLoadRec a
a (TypeRep -> Set TypeRep -> Set TypeRep
forall a. Ord a => a -> Set a -> Set a
Set.insert TypeRep
t Set TypeRep
prev)
      Maybe a -> System (Maybe a)
forall a. a -> System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> System (Maybe a)) -> Maybe a -> System (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
a
    Just (Maybe a
_, Maybe AssetFilePath
Nothing, Bool
_, Bool
_) -> Maybe a
forall a. Maybe a
Nothing Maybe a -> System () -> System (Maybe a)
forall a b. a -> System b -> System a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> System ()
forall w (m :: * -> *).
(HasCallStack, MonadSystem w m) =>
Text -> m ()
warn [i|Trying to load an asset without a file path #{e}|]
    Just (Maybe a
_, Just (AssetFilePath {Path Abs File
absFilePath :: AssetFilePath -> Path Abs File
absFilePath :: Path Abs File
absFilePath, Text
relFilePath :: AssetFilePath -> Text
relFilePath :: Text
relFilePath}), Bool
False, Bool
_) -> do
      System Entity -> System ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (System Entity -> System ()) -> System Entity -> System ()
forall a b. (a -> b) -> a -> b
$ forall a.
(Asset a, Bundle a) =>
Path Abs File -> Text -> System Entity
reloadByAbsPath @a Path Abs File
absFilePath Text
relFilePath
      Bool -> System () -> System ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b (System () -> System ()) -> System () -> System ()
forall a b. (a -> b) -> a -> b
$ forall b. (HasCallStack, Bundle b) => b -> Entity -> System ()
LoadRec -> Entity -> System ()
forall b. Bundle b => b -> Entity -> System ()
insert LoadRec
LoadRec Entity
e
      Maybe a -> System (Maybe a)
forall a. a -> System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    Just (Maybe a
_, Maybe AssetFilePath
_, Bool
True, Bool
loadRec) -> do
      Bool -> System () -> System ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
b Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
loadRec) (System () -> System ()) -> System () -> System ()
forall a b. (a -> b) -> a -> b
$ forall b. (HasCallStack, Bundle b) => b -> Entity -> System ()
LoadRec -> Entity -> System ()
forall b. Bundle b => b -> Entity -> System ()
insert LoadRec
LoadRec Entity
e
      Maybe a -> System (Maybe a)
forall a. a -> System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
getAsset (Ref Text
path) Bool
b' Set TypeRep
prev = do
  e <- AssetRef a -> System (Maybe Entity)
forall a w (m :: * -> *).
MonadSystem w m =>
AssetRef a -> m (Maybe Entity)
getRefEntity' (forall a. (Asset a, Bundle a) => Text -> AssetRef a
Ref @a Text
path)
  case e of
    Just Entity
e -> do
      b <- Query System (Maybe a, Bool, Bool)
-> System (Maybe (Maybe a, Bool, Bool))
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m (Maybe out)
single (Query System (Maybe a, Bool, Bool)
 -> System (Maybe (Maybe a, Bool, Bool)))
-> Query System (Maybe a, Bool, Bool)
-> System (Maybe (Maybe a, Bool, Bool))
forall a b. (a -> b) -> a -> b
$ Entity
-> (M a, Has Loading, Has LoadRec)
-> Query System (Maybe a, Bool, Bool)
forall qd out (m :: * -> *).
Queryable qd out =>
Entity -> qd -> Query m out
mkGet Entity
e (forall a. M a
forall {k} (a :: k). M a
M @a, forall a. Has a
forall {k} (a :: k). Has a
Has @Loading, forall a. Has a
forall {k} (a :: k). Has a
Has @LoadRec)
      case b of
        Maybe (Maybe a, Bool, Bool)
Nothing -> Maybe a
forall a. Maybe a
Nothing Maybe a -> System Entity -> System (Maybe a)
forall a b. a -> System b -> System a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a. (Asset a, Bundle a) => Text -> System Entity
loadByRelPath @a Text
path
        Just (Just a
a, Bool
_, Bool
_) -> do
          Bool -> System () -> System ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b' (System () -> System ()) -> System () -> System ()
forall a b. (a -> b) -> a -> b
$ do
            let t :: TypeRep
t = Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a -> TypeRep) -> Proxy a -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a
            Bool -> System () -> System ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TypeRep -> Set TypeRep -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member TypeRep
t Set TypeRep
prev) (System () -> System ()) -> System () -> System ()
forall a b. (a -> b) -> a -> b
$ a -> Set TypeRep -> System ()
forall a. Asset a => a -> Set TypeRep -> System ()
handleLoadRec a
a (TypeRep -> Set TypeRep -> Set TypeRep
forall a. Ord a => a -> Set a -> Set a
Set.insert TypeRep
t Set TypeRep
prev)
          Maybe a -> System (Maybe a)
forall a. a -> System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> System (Maybe a)) -> Maybe a -> System (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
a
        Just (Maybe a
Nothing, Bool
False, Bool
_) -> do
          System Entity -> System ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (System Entity -> System ()) -> System Entity -> System ()
forall a b. (a -> b) -> a -> b
$ forall a. (Asset a, Bundle a) => Text -> System Entity
loadByRelPath @a Text
path
          forall b. (HasCallStack, Bundle b) => b -> Entity -> System ()
LoadRec -> Entity -> System ()
forall b. Bundle b => b -> Entity -> System ()
insert LoadRec
LoadRec Entity
e
          Maybe a -> System (Maybe a)
forall a. a -> System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
        Just (Maybe a
Nothing, Bool
True, Bool
loadRec) -> do
          Bool -> System () -> System ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
b' Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
loadRec) (System () -> System ()) -> System () -> System ()
forall a b. (a -> b) -> a -> b
$ forall b. (HasCallStack, Bundle b) => b -> Entity -> System ()
LoadRec -> Entity -> System ()
forall b. Bundle b => b -> Entity -> System ()
insert LoadRec
LoadRec Entity
e
          Maybe a -> System (Maybe a)
forall a. a -> System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    Maybe Entity
Nothing -> do
      e <- forall a. (Asset a, Bundle a) => Text -> System Entity
loadByRelPath @a Text
path
      when b' $ insert LoadRec e
      pure Nothing
getAsset (SubRef AssetRef b
e b -> a
f) Bool
b Set TypeRep
prev = (b -> a) -> Maybe b -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> a
f (Maybe b -> Maybe a) -> System (Maybe b) -> System (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AssetRef b -> Bool -> Set TypeRep -> System (Maybe b)
forall a. AssetRef a -> Bool -> Set TypeRep -> System (Maybe a)
getAsset AssetRef b
e Bool
b Set TypeRep
prev
getAsset (TransRef AssetRef b
a b -> AssetRef a
f) Bool
b Set TypeRep
prev = do
  x <- AssetRef b -> Bool -> Set TypeRep -> System (Maybe b)
forall a. AssetRef a -> Bool -> Set TypeRep -> System (Maybe a)
getAsset AssetRef b
a Bool
b Set TypeRep
prev
  case x of
    Maybe b
Nothing -> Maybe a -> System (Maybe a)
forall a. a -> System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    Just b
x -> do
      AssetRef a -> Bool -> Set TypeRep -> System (Maybe a)
forall a. AssetRef a -> Bool -> Set TypeRep -> System (Maybe a)
getAsset (b -> AssetRef a
f b
x) Bool
b Set TypeRep
prev
getAsset (PureRef a
a) Bool
_ Set TypeRep
_ = Maybe a -> System (Maybe a)
forall a. a -> System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> System (Maybe a)) -> Maybe a -> System (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
a
getAsset (AppRef AssetRef (a -> a)
f AssetRef a
a) Bool
b Set TypeRep
prev = do
  x <- AssetRef (a -> a) -> Bool -> Set TypeRep -> System (Maybe (a -> a))
forall a. AssetRef a -> Bool -> Set TypeRep -> System (Maybe a)
getAsset AssetRef (a -> a)
f Bool
b Set TypeRep
prev
  y <- getAsset a b prev
  let z = (,) ((a -> a) -> a -> (a -> a, a))
-> Maybe (a -> a) -> Maybe (a -> (a -> a, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (a -> a)
x Maybe (a -> (a -> a, a)) -> Maybe a -> Maybe (a -> a, a)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe a
y
  case z of
    Maybe (a -> a, a)
Nothing -> Maybe a -> System (Maybe a)
forall a. a -> System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    Just (a -> a
f, a
a) -> do
      Maybe a -> System (Maybe a)
forall a. a -> System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> System (Maybe a)) -> Maybe a -> System (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a -> a
f a
a
getAsset AssetRef a
NullRef Bool
_ Set TypeRep
_ = Maybe a -> System (Maybe a)
forall a. a -> System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing

-- loaded :: forall a. AssetRef a -> System Bool
-- loaded ref = isJust <$> getAsset ref

instance Show (AssetRef a) where
  show :: AssetRef a -> FilePath
show (Ref Text
p) = FilePath
"Ref " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> FilePath
forall a. Show a => a -> FilePath
show Text
p
  show (EntityRef Entity
p) = FilePath
"Ref " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Entity -> FilePath
forall a. Show a => a -> FilePath
show Entity
p
  show (SubRef AssetRef b
a b -> a
_) = FilePath
"SubRef " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ AssetRef b -> FilePath
forall a. Show a => a -> FilePath
show AssetRef b
a
  show (TransRef AssetRef b
a b -> AssetRef a
_) = FilePath
"TransRef " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ AssetRef b -> FilePath
forall a. Show a => a -> FilePath
show AssetRef b
a
  show (PureRef a
_) = FilePath
"PureRef"
  show (AppRef AssetRef (a -> a)
f AssetRef a
a) = FilePath
"AppRef" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ AssetRef (a -> a) -> FilePath
forall a. Show a => a -> FilePath
show AssetRef (a -> a)
f FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ AssetRef a -> FilePath
forall a. Show a => a -> FilePath
show AssetRef a
a
  show AssetRef a
NullRef = FilePath
"NullRef"

instance Functor AssetRef where
  fmap :: forall a b. (a -> b) -> AssetRef a -> AssetRef b
fmap a -> b
f AssetRef a
a = AssetRef a -> (a -> b) -> AssetRef b
forall b a. AssetRef b -> (b -> a) -> AssetRef a
SubRef AssetRef a
a a -> b
f

instance Applicative AssetRef where
  pure :: a -> AssetRef a
  pure :: forall a. a -> AssetRef a
pure = a -> AssetRef a
forall a. a -> AssetRef a
PureRef
  (<*>) :: AssetRef (a -> b) -> AssetRef a -> AssetRef b
  <*> :: forall a b. AssetRef (a -> b) -> AssetRef a -> AssetRef b
(<*>) = AssetRef (a -> b) -> AssetRef a -> AssetRef b
forall a b. AssetRef (a -> b) -> AssetRef a -> AssetRef b
AppRef

instance Monad AssetRef where
  (>>=) :: AssetRef a -> (a -> AssetRef b) -> AssetRef b
  >>= :: forall a b. AssetRef a -> (a -> AssetRef b) -> AssetRef b
(>>=) = AssetRef a -> (a -> AssetRef b) -> AssetRef b
forall a b. AssetRef b -> (b -> AssetRef a) -> AssetRef a
TransRef

class ToAssetRef r where
  toRef :: (Asset a, Bundle a) => r a -> AssetRef a

instance (Asset a) => IsString (AssetRef a) where
  fromString :: String -> AssetRef a
  fromString :: FilePath -> AssetRef a
fromString FilePath
s = Text -> AssetRef a
forall a. (Asset a, Bundle a) => Text -> AssetRef a
Ref (FilePath -> Text
T.pack FilePath
s)