module Literate.Web.Live.Asset where

import Data.Eq (Eq (..))
import Data.Function ((.))
import Data.Functor (Functor, (<$>))
import Data.Ord (Ord)
import Data.Text (Text)
import Data.Text qualified as Text
import GHC.Generics (Generic)
import Literate.Web qualified as Web
import System.FilePath qualified as File
import System.IO (FilePath)
import Text.Show (Show)

-- | The type of assets that can be bundled in a static site.
data Asset a
  = -- | A file that is copied as-is from the source directory.
    --
    -- Relative paths are assumed relative to the source directory. Absolute
    -- paths allow copying static files outside of source directory.
    AssetStatic FilePath
  | -- | A file whose contents are generated at runtime by user code.
    AssetGenerated Format a
  deriving stock (Eq, Show, Ord, Functor, Generic)

-- | The format of a generated asset.
data Format
  = -- | Html assets are served by the live server with hot-reload
    Html
  | -- | Other assets are served by the live server as static files.
    Other
  deriving stock (Eq, Show, Ord, Generic)

decodeOutputPath :: Text -> Web.OutputPath
decodeOutputPath p =
  Web.OutputPath
    { Web.outputPathSegs = Web.decodePathSegment . Text.pack <$> File.splitDirectories segs
    , Web.outputPathExts = Web.decodePathSegment <$> Text.split (== '.') (Text.pack case exts of '.' : e -> e; _ -> exts)
    }
  where
    (segs, exts) = File.splitExtensions (Text.unpack p)