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 +5/−0
- LICENSE +29/−0
- README.md +11/−0
- examples/FirstAsset.hs +58/−0
- mischief-assets.cabal +200/−0
- src/Mischief/Assets.hs +40/−0
- src/Mischief/Assets/Asset.hs +82/−0
- src/Mischief/Assets/AssetRef.hs +26/−0
- src/Mischief/Assets/Image.hs +15/−0
- src/Mischief/Assets/Internal/Asset.hs +429/−0
- src/Mischief/Assets/Internal/Kdl.hs +86/−0
- src/Mischief/Assets/Internal/Kdl/Collection.hs +25/−0
- src/Mischief/Assets/Internal/Path.hs +80/−0
- src/Mischief/Assets/Internal/Plugin.hs +1/−0
- src/Mischief/Assets/Internal/Watcher.hs +88/−0
- src/Mischief/Assets/Kdl.hs +16/−0
- src/Mischief/Assets/Orphans.hs +28/−0
- src/Mischief/Assets/Tutorial/Control.hs +110/−0
- src/Mischief/Assets/Tutorial/Introduction.hs +201/−0
- src/Mischief/Assets/Tutorial/Kdl.hs +118/−0
- src/Mischief/Assets/Tutorial/Refs.hs +143/−0
- test/Main.hs +57/−0
+ 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_