packages feed

mischief-assets (empty) → 0.1.0.0

raw patch · 22 files changed

+1848/−0 lines, 22 filesdep +JuicyPixelsdep +asyncdep +base

Dependencies added: JuicyPixels, async, base, bytestring, containers, data-default, directory, exceptions, filepath, fsnotify, hashtables, kdl-hs, linear, mischief-assets, mischief-ecs, mtl, path, primitive, sdl3-bindgen-sys, stm, store, text, transformers

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for mischief-assets++## 0.1.0.0 ++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright (c) 2026, Damon+++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of the copyright holder nor the names of its+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,11 @@+# mischief-assets++This library provides ways of integrating data-driven design into your Mischief projects.+It lets you define, load and save Assets, such as .kdl files and images, as entities. It also allows hot-reloading. ++This library lives in the official [repo](https://codeberg.org/mischief/mischief) and is considered a "core library" of the ecosystem. ++To contribute, you can file issues, such as bug reports and feature requests, in the official [repository](https://codeberg.org/mischief/mischief).+You can also join the official server on discord to be kept up to date with updates and chat with the rest of the community. Link in the aforementioned repo. ++Check out the Asset Book in the Mischief.Assets module to learn about using it! 
+ examples/FirstAsset.hs view
@@ -0,0 +1,58 @@+module Main where++import Control.Monad (void)+import Mischief.Assets+import Mischief.ECS+import Mischief.ECS.Interval qualified as Interval++newtype Heal = Heal {amount :: Int}+  deriving (Generic, KdlAsset, Component, Show)++instance Asset Heal where+  type Saveable Heal = False+  loadAsset = loadKdl "heal"++main :: IO ()+main = do+  app <- newApp+  setAssetSource "mischief-assets/assets/" app+  addPlugin @MyPlugin app+  runApp app++data MyPlugin++instance Plugin MyPlugin where+  init = do+    systems spawnPlayers+      & schedule @Startup++    spawn_ $ Observer onLoadHeal++    void $ Interval.start 1000000 healPlayers++  deps = [dep @FileWatcherPlugin]++loadHeal :: System ()+loadHeal = load_ @Heal "heal.kdl"++onLoadHeal :: OnLoad Heal -> System ()+onLoadHeal (OnLoad heal) =+  [q|heal. Heal|]+    & qinfo (\h -> [i|Loaded #{h}|])+    & query_++newtype Health = Health Int deriving (Component)++spawnPlayers :: System ()+spawnPlayers = do+  spawn_ (Name "A", Health 20)+  spawn_ (Name "B", Health 30)+  spawn_ (Name "C", Health 60)++healPlayers :: System ()+healPlayers = query_ $ do+  (player, name, Health hp) <- [q|Entity, Name, Health|]+  Heal heal <- qasset @Heal "heal.kdl"+  qlift $ do+    insert (Health $ hp + heal) player+    info [i|Player #{name} is now at #{hp + heal} hp|]
+ mischief-assets.cabal view
@@ -0,0 +1,200 @@+cabal-version: 3.0+-- The cabal-version field refers to the version of the .cabal specification,+-- and can be different from the cabal-install (the tool) version and the+-- Cabal (the library) version you are using. As such, the Cabal (the library)+-- version used must be equal or greater than the version stated in this field.+-- Starting from the specification version 2.2, the cabal-version field must be+-- the first thing in the cabal file.+-- Initial package description 'mischief' generated by+-- 'cabal init'. For further documentation, see:+--   http://haskell.org/cabal/users-guide/+--+-- The name of the package.+name: mischief-assets+-- The package version.+-- See the Haskell package versioning policy (PVP) for standards+-- guiding when and how versions should be incremented.+-- https://pvp.haskell.org+-- PVP summary:     +-+------- breaking API changes+--                  | | +----- non-breaking API additions+--                  | | | +--- code changes with no API change+version: 0.1.0.0+-- A short (one-line) description of the package.+-- synopsis:+-- A longer description of the package.+-- description:+-- The license under which the package is released.+license: BSD-3-Clause+-- The file containing the license text.+license-file: LICENSE+-- The package author(s).+author: Damon+-- An email address to which users can send suggestions, bug reports, and patches.+maintainer: pvdoriginal2019@gmail.com+homepage: https://codeberg.org/mischief/mischief,+synopsis: Asset and Data-Driven Functionality for the Mischief game engine.+-- A copyright notice.+-- copyright:+build-type: Simple+-- Extra doc files to be distributed with the package, such as a CHANGELOG or a README.+extra-doc-files:+  CHANGELOG.md+  README.md++description: Assets for the Mischief Game Engine++-- Extra source files to be distributed with the package, such as examples, or a tutorial module.+-- extra-source-files:+common warnings+  ghc-options:+    "-Wall,"+    -Wno-name-shadowing++library+  -- Import common warning flags.+  import: warnings+  -- Modules exported by the library.+  exposed-modules:+    Mischief.Assets+    Mischief.Assets.Asset+    Mischief.Assets.AssetRef+    Mischief.Assets.Image+    Mischief.Assets.Kdl+    Mischief.Assets.Orphans+    Mischief.Assets.Tutorial.Control+    Mischief.Assets.Tutorial.Introduction+    Mischief.Assets.Tutorial.Kdl+    Mischief.Assets.Tutorial.Refs++  other-modules:+    Mischief.Assets.Internal.Asset+    Mischief.Assets.Internal.Kdl+    Mischief.Assets.Internal.Kdl.Collection+    Mischief.Assets.Internal.Path+    Mischief.Assets.Internal.Plugin+    Mischief.Assets.Internal.Watcher++  -- Modules included in this library but not exported.+  -- other-modules:+  other-modules:+  -- LANGUAGE extensions used by modules in this package.z+  default-extensions:+    DefaultSignatures+    DeriveAnyClass+    DuplicateRecordFields+    FunctionalDependencies+    ImportQualifiedPost+    MagicHash+    NoFieldSelectors+    OverloadedRecordDot+    OverloadedStrings+    QuasiQuotes+    RequiredTypeArguments+    TemplateHaskell+    TypeFamilyDependencies+    UndecidableInstances++  -- other-extensions:+  -- Other library packages from which modules are imported.+  build-depends:+    base >=4.21.0 && <4.22,+    bytestring >=0.12.2 && <0.13,+    containers >=0.7 && <0.8,+    directory >=1.3.9 && <1.4,+    exceptions >=0.10.9 && <0.11,+    fsnotify >=0.4.4 && <0.5,+    hashtables >=1.4.2 && <1.5,+    JuicyPixels >=3.3.9 && <3.4,+    kdl-hs >=1.2.1 && <1.3,+    linear >=1.23.3 && <1.24,+    mischief-ecs >=0.2.0 && <0.3,+    mtl >=2.3.1 && <2.4,+    path >=0.9.6 && <0.10,+    sdl3-bindgen-sys >=0.0.1 && <0.1,+    stm >=2.5.3 && <2.6,+    text >=2.1.2 && <2.2,+    transformers >=0.6.1 && <0.7,++  -- Directories containing source files.+  hs-source-dirs:+    src++  -- Base language which the package is written in.+  default-language:+    GHC2024++  ghc-options: -fno-omit-yields++test-suite mischief-test+  -- Import common warning flags.+  import: warnings+  ghc-options: -fno-omit-yields+  -- Base language which the package is written in.+  default-language: GHC2024+  -- Modules included in this executable, other than Main.+  -- other-modules:+  -- LANGUAGE extensions used by modules in this package.+  default-extensions:+    DeriveAnyClass+    DuplicateRecordFields+    MagicHash+    NoFieldSelectors+    NoGeneralizedNewtypeDeriving+    OverloadedRecordDot+    QuasiQuotes+    RequiredTypeArguments+    TypeFamilyDependencies++  -- other-extensions:+  -- The interface type and version of the test suite.+  type: exitcode-stdio-1.0+  -- Directories containing source files.+  hs-source-dirs: test+  -- The entrypoint to the test suite.+  main-is: Main.hs+  -- Test dependencies.+  build-depends:+    async,+    base >=4.21.0.0 && <4.22,+    bytestring,+    containers,+    data-default,+    directory,+    filepath,+    kdl-hs,+    linear,+    mischief-assets,+    mischief-ecs,+    primitive,+    store,+    text,+    transformers,++executable example-first-asset+  main-is: FirstAsset.hs+  hs-source-dirs: examples/+  build-depends:+    async,+    base,+    bytestring,+    containers,+    data-default,+    mischief-assets,+    mischief-ecs,+    primitive,+    store,+    text,+    transformers,++  default-language: GHC2024+  default-extensions:+    DeriveAnyClass+    DuplicateRecordFields+    NoFieldSelectors+    NoGeneralizedNewtypeDeriving+    OverloadedRecordDot+    OverloadedStrings+    QuasiQuotes+    RequiredTypeArguments+    TemplateHaskell+    TypeFamilyDependencies
+ src/Mischief/Assets.hs view
@@ -0,0 +1,40 @@+-- | Library for adding Asset and Data-Driven functionality to the Mischief Game Engine.+module Mischief.Assets+  ( -- * Mischief Assets++    -- * Dependencies+    -- $deps++    -- * Pre-Requisites+    -- $pre++    -- * The Asset Book+    -- $book+    module Mischief.Assets.Asset,+    module Mischief.Assets.AssetRef,+    module Mischief.Assets.Kdl,+    module Mischief.Assets.Image,+    FileWatcherPlugin,+  )+where++import Mischief.Assets.Asset+import Mischief.Assets.AssetRef+import Mischief.Assets.Image+import Mischief.Assets.Internal.Watcher+import Mischief.Assets.Kdl+import Mischief.Assets.Orphans ()++-- $deps+-- Dependencies:+--+-- *[mischief-ecs]("Mischief.ECS")++-- $pre+-- You should be familiar to how the ECS works. You can start learning [here]("Mischief.ECS").++-- $book+-- * [1. Introduction to Assets]("Mischief.Assets.Tutorial.Introduction")+-- * [2. Asset Refs]("Mischief.Assets.Tutorial.Refs")+-- * [3. Asset Control Flow]("Mischief.Assets.Tutorial.Control")+-- * [4. Kdl Assets]("Mischief.Assets.Tutorial.Kdl")
+ src/Mischief/Assets/Asset.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# OPTIONS_GHC -Wno-redundant-constraints #-}++module Mischief.Assets.Asset+  ( Asset (..),+    OnLoad (..),+    setAssetSource,+    load,+    load_,+    loadRec,+    loadRec_,+    reload,+    retrieve,+    asset,+    assetRec,+    asset',+    Mischief.Assets.Asset.store,+    Mischief.Assets.Asset.save,+    saveEntity,+    Loaded,+    Loading,+    AssetType,+    decodeRef,+    Rec,+    addRec,+  )+where++import Control.Monad (void)+import Data.Set qualified as Set+import Data.Text (Text)+import Mischief.Assets.Internal.Asset+import Mischief.Assets.Internal.Path+import Mischief.ECS++load :: forall a. ((Loadable a ~ True), Asset a, Bundle a) => Text -> System Entity+load = loadByRelPath @a++load_ :: forall a. ((Loadable a ~ True), Asset a, Bundle a) => Text -> System ()+load_ = void . load @a++loadRec :: forall a. ((Loadable a ~ True), Asset a, Bundle a) => Text -> System Entity+loadRec t = do+  e <- loadByRelPath @a t+  insert LoadRec e+  pure e++loadRec_ :: forall a. ((Loadable a ~ True), Asset a, Bundle a) => Text -> System ()+loadRec_ t = do+  e <- loadByRelPath @a t+  insert LoadRec e++reload :: forall a. ((Loadable a ~ True), Asset a, Bundle a) => Text -> System Entity+reload = reloadByRelPath @a++assetRec :: forall a. AssetRef a -> System (Maybe a)+assetRec a = getAsset a True Set.empty++asset :: forall a. AssetRef a -> System (Maybe a)+asset a = getAsset a False Set.empty++asset' :: forall a. AssetRef a -> System (Maybe a)+asset' = getAsset'++retrieve :: forall a. AssetRef a -> System (Maybe Entity)+retrieve = getRefEntity @a++retrieve' :: forall a. AssetRef a -> System (Maybe Entity)+retrieve' = getRefEntity' @a++store :: (Asset a, Bundle a) => Text -> a -> System Entity+store = Mischief.Assets.Internal.Asset.store++save :: forall a. (Asset a, Saveable a ~ True, Bundle a) => Text -> System ()+save path = do+  e <- retrieve' @a (Ref path)+  case e of+    Nothing -> warn "Attempted to save an asset which isn't stored"+    Just e -> Mischief.Assets.Internal.Asset.save @a e++saveEntity :: forall a. (Asset a, Saveable a ~ True) => Entity -> System ()+saveEntity = Mischief.Assets.Internal.Asset.save @a
+ src/Mischief/Assets/AssetRef.hs view
@@ -0,0 +1,26 @@+module Mischief.Assets.AssetRef+  ( AssetRef (..),+    getAsset,+    getAsset',+    getRefEntity,+    qasset,+    qassetRec,+    qasset',+    ToAssetRef (..),+  )+where++import Data.Set qualified as Set+import Mischief.Assets.Internal.Asset+import Mischief.ECS++-- | Gets the value of an asset.+qasset' :: forall a m w. (MonadSystem w m) => AssetRef a -> Query m a+qasset' ref = qmaybe =<< qlift (getAsset' ref)++-- | Gets the value of an asset. If it isn't loaded, it will attempt to start loading it.+qasset :: forall a. AssetRef a -> Query System a+qasset ref = qmaybe =<< qlift (getAsset ref False Set.empty)++qassetRec :: forall a. AssetRef a -> Query System a+qassetRec ref = qmaybe =<< qlift (getAsset ref True Set.empty)
+ src/Mischief/Assets/Image.hs view
@@ -0,0 +1,15 @@+module Mischief.Assets.Image where++import Codec.Picture qualified as P+import Data.Text qualified as T+import Mischief.Assets.Internal.Asset+import Mischief.ECS+import Mischief.ECS.Utils++newtype Image = Image P.DynamicImage deriving anyclass (Component)++instance Asset Image where+  type Saveable Image = False++  loadAsset !path _ = do+    fmap Image . mapLeft T.pack <$> P.readImage path
+ src/Mischief/Assets/Internal/Asset.hs view
@@ -0,0 +1,429 @@+{-# 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 _ _ = pure $ Left $ T.show (typeRep $ Proxy @a) <> " 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 _ _ _ = pure $ Left $ T.show (typeRep $ Proxy @a) <> " does not implement a save function!"++  rec :: a -> Rec ()+  rec = const $ pure ()++data RecAsset where+  RecAsset :: AssetRef a -> RecAsset++data LoadRec = LoadRec deriving (Component)++newtype RecAssets = RecAssets [RecAsset]++type Rec = State RecAssets++addRec :: AssetRef a -> Rec ()+addRec a' = do+  RecAssets a <- get+  put $ RecAssets $ RecAsset a' : a++type RelativePath = Text++data Loading = Loading deriving (Component)++data Loaded = Loaded deriving (Component)++data AssetEntity = AssetEntity deriving (Component)++loadByRelPath :: forall a. (Asset a, Bundle a) => Text -> System Entity+loadByRelPath !path' = do+  path <- relAssetToAbsFile path'+  loadByAbsPath @a path path'++loadByAbsPath :: forall a. (Asset a, Bundle a) => Path Path.Abs Path.File -> Text -> System Entity+loadByAbsPath !path !relPath = do+  a <- tryFindAsset @a path+  relDir <- T.pack . Path.toFilePath . Path.parent <$> Path.parseRelFile (T.unpack relPath)++  case a of+    Just a -> pure a+    Nothing -> do+      entity <- spawn (AssetEntity, Loading, AssetType $ Proxy @a, AssetFilePath {absFilePath = path, relFilePath = relPath})++      Just (AssetRegistry registry) <- res @(AssetRegistry a)+      AssetTypeRegistry typeRegistry <- resOrInsertM @AssetTypeRegistry $ AssetTypeRegistry <$> liftIO H.new+      void $ liftIO $ H.mutate typeRegistry path $ \case+        Just x -> (Just $ Set.insert (AssetType $ Proxy @a) x, path)+        Nothing -> (Just $ Set.singleton (AssetType $ Proxy @a), path)++      liftIO $ H.insert registry path entity++      runAfter+        ( do+            loadAsset @a (Path.toFilePath path) relDir+        )+        ( \(!assetData) -> do+            case assetData of+              Left t -> err [i|Error when loading asset: #{t}|]+              Right assetData -> do+                Just loadRec <- 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 a prev = do+  let (_, RecAssets recs) = runState (rec a) (RecAssets [])+  for_ recs $ \(RecAsset a) -> void $ getAsset a True prev++data AssetFilePath = AssetFilePath {absFilePath :: Path Path.Abs Path.File, relFilePath :: Text} deriving (Component)++reloadByRelPath :: forall a. (Asset a, Bundle a) => Text -> System Entity+reloadByRelPath !path' = do+  path <- relAssetToAbsFile path'+  reloadByAbsPath @a path path'++reloadByAbsPath :: forall a. (Asset a, Bundle a) => Path Path.Abs Path.File -> Text -> System Entity+reloadByAbsPath !path !relPath = do+  a <- tryFindAsset @a path+  relDir <- T.pack . Path.toFilePath . Path.parent <$> Path.parseRelFile (T.unpack relPath)++  entity <- case a of+    Just a -> pure a+    Nothing -> do+      spawn (AssetEntity, Loading, AssetType $ Proxy @a, AssetFilePath {absFilePath = path, relFilePath = relPath})++  Just (AssetRegistry registry) <- res @(AssetRegistry a)+  AssetTypeRegistry typeRegistry <- resOrInsertM @AssetTypeRegistry $ AssetTypeRegistry <$> liftIO H.new+  void $ liftIO $ H.mutate typeRegistry path $ \case+    Just x -> (Just $ Set.insert (AssetType $ Proxy @a) x, path)+    Nothing -> (Just $ Set.singleton (AssetType $ Proxy @a), path)++  liftIO $ H.insert registry path entity++  runAfter+    ( do+        loadAsset @a (Path.toFilePath path) relDir+    )+    ( \(!assetData) -> do+        case assetData of+          Left t -> err [i|Error when loading asset: #{t}|]+          Right assetData -> do+            remove (C @Loading) entity+            insert (assetData, Loaded) entity+            trigger (OnLoad @a 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 !path' !a = do+  path <- relAssetToAbsFile path'+  a' <- tryFindAsset @a path++  entity <- case a' of+    Just e -> do+      insert a e+      pure e+    Nothing -> do+      entity <- spawn $ bundle (AssetEntity, Loading, AssetType $ Proxy @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 x -> (Just $ Set.insert (AssetType $ Proxy @a) x, path)+        Nothing -> (Just $ Set.singleton (AssetType $ Proxy @a), path)++      pure entity++  trigger (OnLoad @a entity)+  pure entity++save :: forall a. (Asset a) => Entity -> System ()+save e = do+  t <- single [q|e. a, AssetFilePath|]+  case t of+    Nothing -> warn $ "Asset of type " <> T.show (typeRep $ Proxy @a) <> " not found at " <> T.show e <> "."+    Just (a, AssetFilePath {absFilePath = path, relFilePath = relPath}) -> do+      runAfter+        ( do+            saveAsset a (Path.toFilePath path) relPath+        )+        ( \case+            Left t -> warn t+            _ -> pure ()+        )++tryFindAsset :: forall a. (Asset a) => Path Path.Abs Path.File -> System (Maybe Entity)+tryFindAsset !path = do+  AssetRegistry registry <- resOrInsertM @(AssetRegistry a) (AssetRegistry <$> liftIO H.new)+  liftIO $ H.lookup registry path++-- newtype Path = Path AssetPath deriving anyclass (Component)++newtype OnLoad a = OnLoad {entity :: Entity}+  deriving anyclass (Event)+  deriving stock (Show)++data AssetType where+  AssetType :: (Asset a) => Proxy a -> AssetType+  deriving (Component)++instance Eq AssetType where+  AssetType a == AssetType b = typeRep a == typeRep b++instance Ord AssetType where+  compare (AssetType a) (AssetType b) = compare (typeRep a) (typeRep b)++type HashMap k v = H.BasicHashTable k v++newtype AssetRegistry a = AssetRegistry (HashMap (Path Path.Abs Path.File) Entity) deriving anyclass (Component)++newtype AssetTypeRegistry = AssetTypeRegistry (HashMap (Path Path.Abs Path.File) (Set AssetType)) deriving anyclass (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 path = do+  t <- 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 (Ref p') = do+  p <- relAssetToAbsFile p'+  e <- tryFindAsset @a p+  case e of+    Nothing -> Just <$> loadByAbsPath @a p p'+    Just x -> pure $ Just x+-- registry <- res @(AssetRegistry a)+-- case registry of+--   Nothing -> pure Nothing+--   Just (AssetRegistry registry) -> do+--     liftIO $ H.lookup registry p+getRefEntity (EntityRef e) = pure $ Just e+getRefEntity (SubRef _ _) = do+  warn "Attempted to retrieve the entity of a sub asset (data inside a loaded asset). Returning Nothing"+  pure Nothing+getRefEntity (TransRef ref f) = do+  a <- getAsset' ref+  case a of+    Nothing -> pure Nothing+    Just a -> getRefEntity $ f a+getRefEntity (PureRef _) = do+  warn "Attempted to retrieve the entity of a pure AssetRef. Returning Nothing."+  pure Nothing+getRefEntity (AppRef _ _) = do+  warn "Attempted to retrieve the entity of an AppRef. Returning Nothing."+  pure Nothing+getRefEntity NullRef = pure 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' (Ref p) = do+  registry <- res @(AssetRegistry a)+  case registry of+    Nothing -> pure Nothing+    Just (AssetRegistry registry) -> do+      p <- relAssetToAbsFile p+      liftIO $ H.lookup registry p+getRefEntity' (EntityRef e) = pure $ Just e+getRefEntity' (SubRef _ _) = do+  warn "Attempted to retrieve the entity of a sub asset (data inside a loaded asset). Returning Nothing"+  pure Nothing+getRefEntity' (TransRef ref f) = do+  a <- getAsset' ref+  case a of+    Nothing -> pure Nothing+    Just a -> getRefEntity' $ f a+getRefEntity' (PureRef _) = do+  warn "Attempted to retrieve the entity of a pure AssetRef. Returning Nothing"+  pure Nothing+getRefEntity' (AppRef _ _) = do+  warn "Attempted to retrieve the entity of an AppRef. Returning Nothing."+  pure Nothing+getRefEntity' NullRef = pure 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' (Ref a) = do+  e <- getRefEntity' (Ref @a a)+  case e of+    Nothing -> pure Nothing+    Just e -> single [q|e. a|]+getAsset' (EntityRef e) = single [q|e. a|]+getAsset' (SubRef a f) = fmap f <$> getAsset' a+getAsset' (TransRef a f) = do+  x <- getAsset' a+  case x of+    Nothing -> pure Nothing+    Just x -> do+      getAsset' (f x)+getAsset' (PureRef a) = pure $ Just a+getAsset' (AppRef f a) = do+  x <- getAsset' f+  y <- getAsset' a+  let z = (,) <$> x <*> y+  case z of+    Nothing -> pure Nothing+    Just (f, a) -> do+      pure $ Just $ f a+getAsset' NullRef = pure 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 (EntityRef e) b prev = do+  r <- single [q|e. Maybe a, Maybe AssetFilePath, Has Loading, Has LoadRec|]+  case r of+    Nothing -> Nothing <$ warn [i|Trying to get asset of invalid entity #{e}|]+    Just (Just a, _, _, _) -> do+      when b $ do+        let t = typeRep $ Proxy @a+        when (Set.member t prev) $ handleLoadRec a (Set.insert t prev)+      pure $ Just a+    Just (_, Nothing, _, _) -> Nothing <$ warn [i|Trying to load an asset without a file path #{e}|]+    Just (_, Just (AssetFilePath {absFilePath, relFilePath}), False, _) -> do+      void $ reloadByAbsPath @a absFilePath relFilePath+      when b $ insert LoadRec e+      pure Nothing+    Just (_, _, True, loadRec) -> do+      when (b && not loadRec) $ insert LoadRec e+      pure Nothing+getAsset (Ref path) b' prev = do+  e <- getRefEntity' (Ref @a path)+  case e of+    Just e -> do+      b <- single $ mkGet e (M @a, Has @Loading, Has @LoadRec)+      case b of+        Nothing -> Nothing <$ loadByRelPath @a path+        Just (Just a, _, _) -> do+          when b' $ do+            let t = typeRep $ Proxy @a+            when (Set.member t prev) $ handleLoadRec a (Set.insert t prev)+          pure $ Just a+        Just (Nothing, False, _) -> do+          void $ loadByRelPath @a path+          insert LoadRec e+          pure Nothing+        Just (Nothing, True, loadRec) -> do+          when (b' && not loadRec) $ insert LoadRec e+          pure Nothing+    Nothing -> do+      e <- loadByRelPath @a path+      when b' $ insert LoadRec e+      pure Nothing+getAsset (SubRef e f) b prev = fmap f <$> getAsset e b prev+getAsset (TransRef a f) b prev = do+  x <- getAsset a b prev+  case x of+    Nothing -> pure Nothing+    Just x -> do+      getAsset (f x) b prev+getAsset (PureRef a) _ _ = pure $ Just a+getAsset (AppRef f a) b prev = do+  x <- getAsset f b prev+  y <- getAsset a b prev+  let z = (,) <$> x <*> y+  case z of+    Nothing -> pure Nothing+    Just (f, a) -> do+      pure $ Just $ f a+getAsset NullRef _ _ = pure Nothing++-- loaded :: forall a. AssetRef a -> System Bool+-- loaded ref = isJust <$> getAsset ref++instance Show (AssetRef a) where+  show (Ref p) = "Ref " ++ show p+  show (EntityRef p) = "Ref " ++ show p+  show (SubRef a _) = "SubRef " ++ show a+  show (TransRef a _) = "TransRef " ++ show a+  show (PureRef _) = "PureRef"+  show (AppRef f a) = "AppRef" ++ show f ++ " " ++ show a+  show NullRef = "NullRef"++instance Functor AssetRef where+  fmap f a = SubRef a f++instance Applicative AssetRef where+  pure :: a -> AssetRef a+  pure = PureRef+  (<*>) :: AssetRef (a -> b) -> AssetRef a -> AssetRef b+  (<*>) = AppRef++instance Monad AssetRef where+  (>>=) :: AssetRef a -> (a -> AssetRef b) -> AssetRef b+  (>>=) = 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 s = Ref (T.pack s)
+ src/Mischief/Assets/Internal/Kdl.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE AllowAmbiguousTypes #-}++module Mischief.Assets.Internal.Kdl where++import Data.Data+import Data.Map qualified as Map+import Data.Text (Text)+import Data.Text qualified as T+import GHC.Base+import GHC.Generics+import GHC.TypeLits+import KDL qualified+import Linear (V2)+import Mischief.Assets.Internal.Asset+import Mischief.Assets.Internal.Kdl.Collection+import Mischief.Assets.Orphans+import Mischief.ECS.Components.Bundle (Bundle)+import Mischief.ECS.Utils (mapLeft)++class (Typeable a) => KdlAsset a where+  decodeKdl :: RelativePath -> KDL.NodeDecoder a+  default decodeKdl :: (Generic a, GKdlAsset (Rep a)) => RelativePath -> KDL.NodeDecoder a+  decodeKdl x = KDL.children (to <$> decodeKdl' @(Rep a) x)++class GKdlAsset f where+  decodeKdl' :: RelativePath -> KDL.NodeListDecoder (f p)++data KdlRef a = KdlRef Text | KdlValue a deriving (Show)++instance GKdlAsset V1 where+  decodeKdl' _ = undefined++instance GKdlAsset U1 where+  decodeKdl' _ = pure U1++instance (GKdlAsset f, GKdlAsset g) => GKdlAsset (f :*: g) where+  decodeKdl' x = do+    a <- decodeKdl' @f x+    b <- decodeKdl' @g x+    pure $ a :*: b++instance (KdlAsset a, KnownSymbol name) => GKdlAsset (M1 S (MetaSel (Just name) x y z) (K1 i a)) where+  decodeKdl' x = do+    let t = T.pack $ symbolVal (Proxy @name)+    M1 . K1 <$> KDL.nodeWith t (decodeKdl x)++instance (GKdlAsset a) => GKdlAsset (D1 i a) where+  decodeKdl' x = M1 <$> decodeKdl' x++instance {-# OVERLAPPABLE #-} (GKdlAsset a) => GKdlAsset (M1 C i a) where+  decodeKdl' x = M1 <$> decodeKdl' x++instance (Asset a, Bundle a) => KdlAsset (AssetRef a) where+  decodeKdl = KDL.argWith . decodeRef++instance (KdlAsset a) => KdlAsset [a] where+  decodeKdl n = KDL.children $ do+    x <- KDL.remainingNodesWith $ decodeKdl @a n+    pure $ concatMap snd $ Map.toList x++instance (KdlAsset a) => KdlAsset (KdlRef a) where+  decodeKdl n = f1 <|> f2+    where+      f1 = KDL.propWith "link" $ decodeKdlRef n+      f2 = KdlValue <$> decodeKdl n++instance (KdlAsset a) => KdlAsset (KdlCollection a) where+  decodeKdl n = KDL.children $ colDecodeWith $ decodeKdl @a n++instance {-# OVERLAPPABLE #-} (Typeable a, KDL.DecodeNode a) => KdlAsset a where+  decodeKdl _ = KDL.nodeDecoder++loadKdl :: forall a. (KdlAsset a) => Text -> FilePath -> RelativePath -> IO (Either Text a)+loadKdl t p r = mapLeft T.show <$> KDL.decodeFileWith (KDL.document $ KDL.nodeWith t $ decodeKdl @a r) p++decodeKdlRef :: RelativePath -> KDL.ValueDecoder (KdlRef a)+decodeKdlRef path = do+  t <- KDL.valueDecoder @Text+  pure $ KdlRef $ path <> "/" <> t++kdlToAssetRef :: (Asset a, Bundle a) => KdlRef a -> AssetRef a+kdlToAssetRef (KdlRef p) = Ref p+kdlToAssetRef (KdlValue v) = PureRef v++instance ToAssetRef KdlRef where+  toRef = kdlToAssetRef
+ src/Mischief/Assets/Internal/Kdl/Collection.hs view
@@ -0,0 +1,25 @@+module Mischief.Assets.Internal.Kdl.Collection where++import Data.Data+import Data.Map (Map)+import Data.Map qualified as Map+import Data.Maybe+import Data.Text (Text)+import KDL qualified+import Mischief.ECS.Utils++newtype KdlCollection a = KdlCollection (Map Text [a]) deriving (Show)++colGetU :: Text -> KdlCollection a -> a+colGetU = (unwrap .) . colGet++colGet :: Text -> KdlCollection a -> Maybe a+colGet a b = case colGetMany a b of+  (x : _) -> Just x+  _ -> Nothing++colGetMany :: Text -> KdlCollection a -> [a]+colGetMany t (KdlCollection m) = fromMaybe [] (Map.lookup t m)++colDecodeWith :: (Typeable a) => KDL.NodeDecoder a -> KDL.NodeListDecoder (KdlCollection a)+colDecodeWith = (KdlCollection <$>) . KDL.remainingNodesWith
+ src/Mischief/Assets/Internal/Path.hs view
@@ -0,0 +1,80 @@+module Mischief.Assets.Internal.Path where++import Control.Monad.IO.Class+import Data.List (unsnoc)+import Data.Text (Text)+import Data.Text qualified as T+import Mischief.ECS (Component, MonadSystem, insertRes, res)+import Mischief.ECS.App (App (..))+import Mischief.ECS.Utils (fromMaybeM)+import Mischief.ECS.World (runSystem)+import Path (Path, (</>))+import Path qualified+import System.Directory++setAssetSource :: Text -> App -> IO ()+setAssetSource t app =+  runSystem+    ( do+        path <- relPathToAbsDir t+        insertRes $ AssetSource path+    )+    app.world++newtype AssetSource = AssetSource (Path Path.Abs Path.Dir) deriving anyclass (Component)++defAbsAssetSource :: (MonadSystem w m) => m AssetSource+defAbsAssetSource = do+  path <- liftIO $ makeAbsolute "./"+  AssetSource <$> Path.parseAbsDir path++relAssetToAbsFile :: (MonadSystem w m) => Text -> m (Path Path.Abs Path.File)+relAssetToAbsFile path = do+  (AssetSource s) <- fromMaybeM defAbsAssetSource =<< res @AssetSource+  let chunks = concatMap (T.splitOn "\\") $ T.splitOn "/" path+  case unsnoc chunks of+    Nothing -> undefined+    Just (xs, last) -> do+      x :: Path Path.Abs Path.Dir <- f s (map T.unpack xs)+      last <- Path.parseRelFile $ T.unpack last+      pure $ x </> last+  where+    f curr (".." : xs) = f (Path.parent curr) xs+    f curr ("" : xs) = f curr xs+    f curr (x : xs) = do+      d <- Path.parseRelDir x+      f (curr </> d) xs+    f curr [] = pure curr++relPathToAbsFile :: (MonadSystem w m) => Text -> m (Path Path.Abs Path.File)+relPathToAbsFile path = do+  x <- liftIO $ makeAbsolute "."+  s <- Path.parseAbsDir x+  let chunks = concatMap (T.splitOn "\\") $ T.splitOn "/" path+  case unsnoc chunks of+    Nothing -> undefined+    Just (xs, last) -> do+      x :: Path Path.Abs Path.Dir <- f s (map T.unpack xs)+      last <- Path.parseRelFile $ T.unpack last+      pure $ x </> last+  where+    f curr (".." : xs) = f (Path.parent curr) xs+    f curr ("" : xs) = f curr xs+    f curr (x : xs) = do+      d <- Path.parseRelDir x+      f (curr </> d) xs+    f curr [] = pure curr++relPathToAbsDir :: (MonadSystem w m) => Text -> m (Path Path.Abs Path.Dir)+relPathToAbsDir path = do+  x <- liftIO $ makeAbsolute "."+  s <- Path.parseAbsDir x+  let chunks = concatMap (T.splitOn "\\") $ T.splitOn "/" path+  f s (map T.unpack chunks)+  where+    f curr (".." : xs) = f (Path.parent curr) xs+    f curr ("" : xs) = f curr xs+    f curr (x : xs) = do+      d <- Path.parseRelDir x+      f (curr </> d) xs+    f curr [] = pure curr
+ src/Mischief/Assets/Internal/Plugin.hs view
@@ -0,0 +1,1 @@+module Mischief.Assets.Internal.Plugin where
+ src/Mischief/Assets/Internal/Watcher.hs view
@@ -0,0 +1,88 @@+module Mischief.Assets.Internal.Watcher where++import Control.Concurrent (forkIO, threadDelay)+import Control.Concurrent.STM (atomically, modifyTVar')+import Control.Monad (forever, void)+import Control.Monad.IO.Class+import Data.Data+import Data.Foldable+import Data.HashTable.IO qualified as H+import Data.Text qualified as T+import Mischief.Assets.Internal.Asset+import Mischief.Assets.Internal.Path+import Mischief.ECS+import Mischief.ECS.Utils (fromMaybeM)+import Mischief.ECS.World+import Path (Path)+import Path qualified+import System.Directory+import System.FSNotify++-- | Listens to changes in your asset folder and reloads assets when they have been changed.+--+-- On Windows running with @-fthreaded@ might be required.+data FileWatcherPlugin++instance Plugin FileWatcherPlugin where+  init = do+    systems managerSystem & schedule @Startup+    void $ spawn $ Observer onFileAdd+    void $ spawn $ Observer onFileModified++managerSystem :: System ()+managerSystem = do+  (AssetSource source) <- fromMaybeM defAbsAssetSource =<< res @AssetSource+  dir <- liftIO $ makeAbsolute $ Path.toFilePath source+  dir <- Path.parseAbsDir dir+  world <- unsafeGetWorld+  void $ liftIO $ forkIO $ do+    withManager $ watcher world dir++watcher :: World -> Path Path.Abs Path.Dir -> WatchManager -> IO ()+watcher world dir mgr = do+  void $ watchTree mgr (Path.toFilePath dir) (const True) (action world)+  forever $ threadDelay 10000000000000000++action :: World -> System.FSNotify.Event -> IO ()+action world (System.FSNotify.Added path _ IsFile) = do+  file <- Path.parseAbsFile path+  triggerEvent world (OnFileAdded file)+action world (System.FSNotify.Modified path _ IsFile) = do+  file <- Path.parseAbsFile path+  triggerEvent world (OnFileModified file)+action world (System.FSNotify.Removed path _ IsFile) = do+  file <- Path.parseAbsFile path+  triggerEvent world (OnFileRemoved file)+action _ _ = pure ()++triggerEvent :: (Mischief.ECS.Event e) => World -> e -> IO ()+triggerEvent World {deferredAsync} m = atomically $ do+  modifyTVar' deferredAsync (++ [trigger m])++newtype OnFileAdded = OnFileAdded (Path Path.Abs Path.File) deriving anyclass (Mischief.ECS.Event)++newtype OnFileModified = OnFileModified (Path Path.Abs Path.File) deriving anyclass (Mischief.ECS.Event)++newtype OnFileRemoved = OnFileRemoved (Path Path.Abs Path.File) deriving anyclass (Mischief.ECS.Event)++onFileAdd :: OnFileAdded -> System ()+onFileAdd (OnFileAdded path) = triggerReload path++onFileModified :: OnFileModified -> System ()+onFileModified (OnFileModified path) = triggerReload path++triggerReload :: Path Path.Abs Path.File -> System ()+triggerReload path = do+  AssetSource s <- fromMaybeM defAbsAssetSource =<< res @AssetSource+  rel <- Path.stripProperPrefix s path++  typeRegistry <- res @AssetTypeRegistry+  case typeRegistry of+    Nothing -> pure ()+    Just (AssetTypeRegistry typeRegistry) -> do+      types <- liftIO $ H.lookup typeRegistry path+      case types of+        Nothing -> pure ()+        Just types -> do+          for_ types $ \(AssetType (_ :: Proxy a)) -> do+            reloadByAbsPath @a path $ T.pack (Path.toFilePath rel)
+ src/Mischief/Assets/Kdl.hs view
@@ -0,0 +1,16 @@+module Mischief.Assets.Kdl+  ( KdlAsset (..),+    KdlRef (..),+    KdlCollection (..),+    loadKdl,+    kdlToAssetRef,+    colGet,+    colGetU,+    colGetMany,+    colDecodeWith,+    decodeKdlRef,+  )+where++import Mischief.Assets.Internal.Kdl+import Mischief.Assets.Internal.Kdl.Collection
+ src/Mischief/Assets/Orphans.hs view
@@ -0,0 +1,28 @@+{-# OPTIONS_GHC -Wno-orphans #-}++module Mischief.Assets.Orphans where++import KDL qualified+import Linear++instance (KDL.DecodeValue a) => KDL.DecodeNode (V2 a) where+  nodeDecoder = V2 <$> KDL.arg <*> KDL.arg++instance (KDL.DecodeValue a) => KDL.DecodeNode (V3 a) where+  nodeDecoder = V3 <$> KDL.arg <*> KDL.arg <*> KDL.arg++instance (KDL.DecodeValue a) => KDL.DecodeNode (V4 a) where+  nodeDecoder :: (KDL.DecodeValue a) => KDL.NodeDecoder (V4 a)+  nodeDecoder = V4 <$> KDL.arg <*> KDL.arg <*> KDL.arg <*> KDL.arg++instance KDL.DecodeNode Int where+  nodeDecoder = KDL.arg++instance KDL.DecodeNode Integer where+  nodeDecoder = KDL.arg++instance KDL.DecodeNode Float where+  nodeDecoder = KDL.arg++instance KDL.DecodeNode Double where+  nodeDecoder = KDL.arg
+ src/Mischief/Assets/Tutorial/Control.hs view
@@ -0,0 +1,110 @@+{-# OPTIONS_GHC -Wno-unused-imports #-}++-- |+-- [Previous Chapter: Asset Refs]("Mischief.Assets.Tutorial.Refs")+--+-- [Next Chapter: Kdl Assets]("Mischief.Assets.Tutorial.Kdl")+--+-- [Main Page]("Mischief.Assets")+module Mischief.Assets.Tutorial.Control+  ( -- * Chapter 3: Asset Control Flow+    -- $intro++    -- * Active vs. Passive Querying+    -- $passiveactive++    -- * Recursive Loading+    -- $rec++    -- * Events+    -- $events++    -- * One-Shot Observers+    -- $oneshot++    -- * [Next Chapter: Kdl Assets]("Mischief.Assets.Tutorial.Kdl")+  )+where++import Mischief.Assets+import Mischief.ECS++-- $intro+-- Some pointers on controlling the logic control flow when working with assets.++-- $passiveactive+-- Attempting to query for an asset will, by default, prompt the asset to load. This is called+-- /active/ querying.+--+-- For instance, running this every frame:+--+-- @+-- foo <- 'asset' \@Foo \"foo.kdl\"+-- @+--+-- Will prompt Foo to start loading if it hasn't yet.+--+-- Assuming that it takes it less than a frame to load, this should be returning a @Just Foo@ starting with the second frame.+--+-- This mechanism is extremely powerful when used in conjunction with queries, via @qasset@, since+-- queries are designed to stop executing when something you're trying to grab isn't available:+--+-- @+-- 'query_' $ do+--   foo <- 'qasset' \@Foo getB+--   'qlift' $ 'info' ['i'|Reading asset: #{foo}|]+-- @+--+-- You can choose to use /passive/ querying, through the equivalent functions ending in @'@. Such as+-- @'asset''@ and @'qasset''@. These functions will attempt to grab the asset, but they will not prompt it to load.++-- $events+-- You can spawn observers that listen to the @OnLoad@ events, which is triggered each time an asset is loaded.+--+-- @+-- onFoo :: 'OnLoad' Foo -> 'System'+-- onFoo event = ...+-- @+--+-- Since assets are components, you can also listen to @'OnAdd'@, @'OnSet'@, and so on.++-- $rec+-- By default, each asset is loaded lazily. Meaning the least possible amount of I/O operations will be performed in order to get the data you need.+--+-- If asset @A@ contains a reference to asset @B@, neither @'load'@ nor @'asset'@ of @A@ will attempt to load @B@.+-- You can alternatively use the dedicated @'loadRec'@ and @'assetRec'@ which will trigger a recursive loading sequence.+--+-- For all assets you define, you are responsible for specifying the references that will be loaded in such a case. For instance:+--+-- @+-- data Foo = Foo+--   {+--     i :: 'Int',+--     ref1 :: 'AssetRef' Bar+--     ref2 :: 'KdlRef' Baz+--   }+--+-- instance 'Asset' Foo where+--   'rec' foo = do+--     'addRec' foo.ref1+--     'addRec' $ 'toRef' foo.ref2+-- @++-- $oneshot+-- You can use @'runWhen'@ and similar functions to run a system when a specific asset (or group of assets) has been loaded, like so:+--+-- @+-- 'runWhenOne'+--   (+--     foo <- 'qasset' \@Foo \"foo.kdl\"+--     bar <- 'qasset' \@Bar \"bar.kdl\"+--     'pure' (foo, bar)+--   )+--   (\\(foo, bar) -> do+--     ...+--   )+-- @+--+-- Note however, that each time this function is ran, an instance of your query will be scheduled to run at every sync point until+-- it returns a result. In order to not waste a large amount of resources, this should only be used in one-time logic such as+-- on Startup or in an Observer, rather than in logic that runs at a fixed interval.
+ src/Mischief/Assets/Tutorial/Introduction.hs view
@@ -0,0 +1,201 @@+{-# OPTIONS_GHC -Wno-unused-imports #-}++-- |+-- [Next Chapter: Asset Refs]("Mischief.Assets.Tutorial.Refs")+--+-- [Main Page]("Mischief.Assets")+module Mischief.Assets.Tutorial.Introduction+  ( -- * Chapter 1: Introduction to Assets+    -- $intro++    -- * Defining an Asset+    -- $defining++    -- * Loading the Asset+    -- $loading++    -- * Hot-Reloading the Asset+    -- $hot++    -- * Integrating Assets Into a Game+    -- $integrating++    -- * [Next Chapter: Asset Refs]("Mischief.Assets.Tutorial.Refs")+  )+where++import Control.Monad+import Mischief.Assets+import Mischief.ECS++-- $intro+-- This chapter will walk you through creating and loading your first asset, as well as hot-reloading it and integrating it into the ECS.+--+-- We'll start by creating an app:+--+-- @+-- import Mischief.Assets+-- import Mischief.ECS+--+-- main :: 'IO' ()+-- main = do+--   app <- 'newApp'+--   'addPlugin' \@MyPlugin app+--   'runApp' app+--+-- data MyPlugin+--+-- instance 'Plugin' MyPlugin+-- @+--+-- It's good practice to set an /asset source/ at the start of your program. This will be the place where you'll be loading and saving assets.+--+-- @+-- app <- 'newApp'+-- 'setAssetSource' \"assets/\" app+-- ...+-- @+--+-- Make sure to create an @assets@ folder. This is generally relative to where you're executing the program from.++-- $defining+-- For this tutorial we'll use @.kdl@ (pronounced '\cuddle'\), as it is the official file format used by Mischief. You can read more about it [here](https://kdl.dev/spec/).+--+-- We'll define an asset that looks like this:+--+-- @+-- heal {+--   amount 5+-- }+-- @+--+-- Just a simple @heal@ node with an @amount@ child containing an integer.+--+-- Create a @heal.kdl@ file in your assets folder and copy the above content into it.+--+-- Next, we need a type in Haskell to represent that data. @Component@ is necessary for all assets.+-- @KdlAsset@ is a tool we use to conver the kdl into this form for us.+--+-- @+-- newtype Heal = Heal {amount :: 'Int'}+--   deriving ('Generic', 'KdlAsset', 'Show', 'Component')+-- @+--+-- Now to write the actual @Asset@ instance:+--+-- @+-- instance 'Asset' Heal where+--   type 'Saveable' Heal = 'False'+--   'loadAsset' = 'loadKdl' \"heal\"+-- @+--+-- We do two things here: First, we set @Saveable@ to False. We just don't care about saving this asset. Second,+-- we tell it how to actually load the asset. We use the @loadKdl@ function provided by the earlier @KdlAsset@ instance.+-- We need to also give it the name of the node we want it to load. In our case that's \"heal\".++-- $loading+-- We can load an asset using the @load@ function! Let's write a system that does that.+--+-- @+-- loadHeal :: 'System' ()+-- loadHeal = 'load_' \@Heal \"heal.kdl\"+-- @+--+-- Since assets are loaded aysnchronously, we also need a way to react to the asset being loaded if we want to print it and+-- check that everything's working. We can do that using the @OnLoad@ event:+--+-- @+-- onLoadHeal :: 'OnLoad' Heal -> 'System' ()+-- onLoadHeal ('OnLoad' e) =+--   ['q'|e. Heal|]+--     & 'qinfo' (\\h -\> ['i'|Loaded #{h}|])+--     & 'query_'+-- @+--+-- And of course, we need to set these to run:+--+-- @+-- instance 'Plugin' MyPlugin where+--   'init' = do+--     'systems' loadHeal+--       & 'schedule' \@'Startup'+--+--     'spawn_' $ 'Observer' onLoadHeal+-- @+--+-- When running your app, you should now see this printed to your screen:+--+-- @+-- [INFO] Loaded Heal {amount = 5}+-- @++-- $hot+-- Pretty annoying that we need to restart our program after modifying our asset in order to load it again..+--+-- But that's why we have hot-reloading! Just add the @FileWatcherPlugin@ as a dependency to your plugin:+--+-- @+-- instance 'Plugin' MyPlugin where+--   'deps' = ['dep' \@'FileWatcherPlugin']+-- @+--+-- Note that, on Windows, you may need to run your project with the @-fthreaded@ flag for this to work properly.+--+-- Now, while running your app, try changing the amount in the @heal.kdl@ file. You'll see the new value printed+-- to the screen immediately!++-- $integrating+-- Let's spawn a few players, each having a @Health@ component:+--+-- @+-- newtype Health = Health 'Int' deriving ('Component')+--+-- spawnPlayers :: 'System' ()+-- spawnPlayers = do+--   'spawn_' (Name \"A\", Health 20)+--   'spawn_' (Name \"B\", Health 30)+--   'spawn_' (Name \"C\", Health 60)+-- @+--+-- Now let's write a system that, when it runs, increases each player's health by the value currently loaded inside Heal:+--+-- @+-- healPlayers :: 'System' ()+-- healPlayers = 'query_' $ do+--   Heal heal <- 'qasset' \@Heal \"heal.kdl\"+--   (player, name, Health hp) \<- ['q'|Entity, Name, Health|]+--   'qlift' $ do+--     'insert' (Health $ hp + heal) player+--     'info' ['i'|Player #{name} is now at #{hp + heal} hp|]+-- @+--+-- Inside a query, we are grabbing each player's name and health, along with the Heal asset. We are then inserting the updated health+-- on the player and printing it.+--+-- All that's left is scheduling this to run at a fixed interval:+--+-- @+-- import "Mischief.ECS.Interval" qualified as Interval+-- @+--+-- @+-- instance 'Plugin' MyPlugin where+--   'init' = do+--     'systems' spawnPlayers+--       & 'schedule' \@'Startup'+--+--     'void' $ Interval.'Mischief.ECS.Interval.start' 1000000 healPlayers+-- @+--+-- Note that we don't need to manually load the file anymore. Asset queries are /active/ by default,+-- meaning they will trigger a load for us if the asset we're asking for is not currently loaded.+--+-- You should see a bunch of these printed to your screen:+--+-- @+-- [Info] Player A is now at 24 hp+-- [Info] Player B is now at 34 hp+-- [Info] Player C is now at 64 hp+-- @+--+-- Try toying with the heal amount in the file, and see how that affects the amount players heal each second!
+ src/Mischief/Assets/Tutorial/Kdl.hs view
@@ -0,0 +1,118 @@+{-# OPTIONS_GHC -Wno-unused-imports #-}++-- |+-- [Previous Chapter: Asset Control Flow]("Mischief.Assets.Tutorial.Control")+--+-- [Next Chapter: Asset Control Flow]("Mischief.Assets.Tutorial.Control")+--+-- [Main Page]("Mischief.Assets")+module Mischief.Assets.Tutorial.Kdl+  ( -- * Chapter 4: Kdl Assets+    -- $intro++    -- * The KdlAsset Class+    -- $kdlasset++    -- * Manual Decoding+    -- $decoding++    -- * Collections+    -- $collection+  )+where++import KDL qualified+import Linear+import Mischief.Assets+import Mischief.ECS++-- $intro+-- [Kdl](https://kdl.dev/spec/) is the official file format used by Mischief.++-- $kdlasset+-- The KdlAsset typeclass is a helper for defining assets that are loaded from .kdl files without needing to parse their fields manually.+--+-- Generally, only types with named fields (records) can automatically derive it:+--+-- @+-- data Foo = Foo+--   {+--     a :: 'Int'+--     b :: 'Float'+--     c :: 'V2' 'Int'+--   }+--   deriving ('Generic', 'KdlAsset')+-- @+--+-- You can now use the @loadKdl@ function provided by the typeclass to quickly make a loadable asset:+--+-- @+-- instance 'Asset' Foo where+--   type 'Saveable' Foo = 'False'+--+--   'loadAsset' = 'loadKdl' \"foo\"+-- @+--+-- The asset itself should look something like this:+--+-- @+-- foo {+--   a 6+--   b 3.2+--   c 2 4+-- }+-- @++-- $decoding+-- You can write custom kdl decoders using the [kdl-hs]("KDL") library.+--+-- For instance, this is how you could decode the asset from the previous section:+--+-- @+-- instance 'KdlAsset' Foo where+--   'decodeKdl' path = KDL.'KDL.children' $ do+--     a <- KDL.'KDL.argAt' \"a\"+--     b <- KDL.'KDL.argAt' \"b\"+--     c <- KDL.'KDL.nodeWith' \"c\" KDL.'KDL.nodeDecoder'+--     pure $ Foo {a, b, c}+-- @+--+-- Note that here we can use @"KDL.nodeDecoder"@ because @V2 a@ has a @KDL.'KDL.DecodeNode'@ instance. Otherwise you'd need+-- to parse it manually, like the others.+--+-- The @path@ argument is used to decode references to other assets. For instance, if @Foo@ also had this field:+--+-- @+-- bar :: 'AssetRef' Bar+-- @+--+-- You'd decode it like this:+--+-- @+-- bar <- 'KDL.argAtWith' $ \"bar\" $ 'decodeRef' path+-- @+--+-- For KdlRefs you use 'decodeKdlRef' instead.++-- $collection+-- A Kdl Collection is a map of nodes of the same type.+--+-- For instance, this field:+--+-- @+-- a :: 'KdlCollection' 'Int'+-- @+--+-- Expects something that looks like this:+--+-- @+-- a {+--   name1 4+--   name2 6+--   name3 5+--   ...+-- }+-- @+--+-- You can use @'colGet'@ to try and get the value of a node from a collection by name. Or @'colGetMany'@ to get the+-- value of all nodes with the given name.
+ src/Mischief/Assets/Tutorial/Refs.hs view
@@ -0,0 +1,143 @@+{-# OPTIONS_GHC -Wno-unused-imports #-}++-- |+-- [Previous Chapter: Introduction to Assets]("Mischief.Assets.Tutorial.Introduction")+--+-- [Next Chapter: Asset Control Flow]("Mischief.Assets.Tutorial.Control")+--+-- [Main Page]("Mischief.Assets")+module Mischief.Assets.Tutorial.Refs+  ( -- * Chapter 2: Asset Refs+    -- $intro++    -- * Asset Querying+    -- $querying++    -- * Kdl Refs+    -- $kdlrefs++    -- * [Next Chapter: Asset Control Flow]("Mischief.Assets.Tutorial.Control")+  )+where++import Mischief.Assets+import Mischief.ECS++-- $intro+-- When you want to point to an asset, you use an @'AssetRef'@. This is a refernece specifying how to get to the asset you're looking for. It+-- could be a simple loaded asset, an asset referenced in another asset, or even a subasset (a part of a larger asset).++-- $querying+-- An @AssetRef a@ can be used with functions such as @'asset'@ and @'qasset'@ to attempt to grab the @a@ the ref is pointing to.+--+-- Assume you have these two .kdl assets:+--+-- assets\/foo.kdl+--+-- @+-- foo {+--   f 10+--   bar \"bars\/bar.kdl\"+-- }+-- @+--+-- assets\/bars\/bar.kdl+--+-- @+-- bar {+--   b 15+-- }+-- @+--+-- And their represenatations in Haskell:+--+-- @+-- data Foo = Foo {+--   f :: 'Int',+--   bar :: 'AssetRef' Bar+-- }+--+-- data Bar = Bar {+--   b :: 'Int'+-- }+-- @+--+-- To query for the Foo asset, you need to provide an @AssetRef Foo@, which can be the path to the asset:+--+-- @+-- foo :: Foo <- 'asset' \"foo.kdl\"+-- @+--+-- You can also query directly for the @f@ field of a Foo:+--+-- @+-- f \<- 'asset' $ do+--   foo :: Foo <- \"foo.kdl"+--   pure foo.f+-- @+--+-- And you can query for the Bar asset referenced by a certain Foo:+--+-- @+-- bar \<- 'asset' $ do+--   foo :: Foo \<- \"foo.kdl\"+--   foo.bar+-- @+--+-- Note that this is equivalent to referencing Bar's file directly, assuming you know the path to it:+--+-- @+-- bar \<- 'asset' $ \"bars\/bar.kdl\"+-- @++-- $kdlrefs+-- For kdl files in particular, there is an utility called a @KdlRef@.+--+-- Let's rewrite the earlier types, this time with KdlRefs instead of AssetRefs:+--+-- @+-- data Foo = Foo {+--   f :: 'Int'+--   bar :: 'KdlRef' Bar+-- }+--+-- data Bar = Bar {+--   b :: 'Int'+-- }+-- @+--+-- A @KdlRef@ can have two possible values: either a reference to another file, or directly the value of the other asset:+--+-- So both of these are valid:+--+-- @+-- -- foo.kdl+-- foo {+--   f 10+--   bar link=\"bar.kdl\"+-- }+--+-- -- bar.kdl+-- bar {+--   b 15+-- }+-- @+--+-- @+-- -- foo.kdl+-- foo {+--   f 10+--   bar {+--     b 15 s+--   }+-- }+-- @+--+-- You can convert a @KdlRef@ to an @AssetRef@ using @toRef@. For instance, this is how we'd get the value of @b@ from a Foo file:+--+-- @+-- b \<- 'asset' $ do+--   foo :: Foo <- \"foo.kdl\"+--   bar <- 'toRef' foo.bar+--   pure bar.b+-- @
+ test/Main.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-orphans #-}++module Main where++import Control.Monad+import Data.Text qualified as T+import Linear (V2)+import Mischief.Assets+import Mischief.ECS++newtype SomeAsset = SomeAsset {vec :: V2 Float}+  deriving (Generic, KdlAsset, Component, Show)++instance Asset SomeAsset where+  type Saveable SomeAsset = False+  loadAsset = loadKdl "a"++-- instance Asset SomeAsset where+--   loadAsset = loadKdl "a"++data MyCollection = MyCollection+  { someImage :: AssetRef Image,+    someAssets :: [KdlRef SomeAsset],+    someMap :: KdlCollection SomeAsset+  }+  deriving (Generic, KdlAsset, Component, Show)++instance Asset MyCollection where+  type Saveable MyCollection = False+  loadAsset = loadKdl "collection"++main :: IO ()+main = do+  app <- newApp+  setAssetSource "test" app+  addPlugin @P app+  runApp app++data P++instance Plugin P where+  init = do+    void $ load @SomeAsset "a.kdl"++    -- whenLoaded' (Ref @MyCollection "collection.kdl") $ warn . T.show++    systems dummy & schedule @Update+    void $ spawn $ Observer loadedA++  deps = [dep @FileWatcherPlugin]++dummy :: System ()+dummy = pure ()++loadedA :: OnLoad SomeAsset -> System ()+loadedA (OnLoad a) = [q|a. SomeAsset|] & qinfo T.show & query_