Path.hs

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