Watcher.hs

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)