Source.hs

module Resource.Source
  ( Source(..)
  , load
  , embedFile
  ) where

import RIO

import Data.FileEmbed qualified
import Data.Typeable
import GHC.Stack (withFrozenCallStack)
import Language.Haskell.TH.Syntax qualified as TH
import Resource.Compressed.Zstd qualified as Zstd
import RIO.ByteString qualified as ByteString
import RIO.FilePath (takeFileName, takeExtension)
import RIO.Text qualified as Text

data Source
  = Bytes     (Maybe Text) ByteString
  | BytesZstd (Maybe Text) (Zstd.Compressed ByteString)
  | File      (Maybe Text) FilePath

instance Show Source where
  show = \case
    Bytes mlabel _bs ->
      maybe "<buffer>" Text.unpack mlabel
    BytesZstd mlabel _zbs ->
      maybe "<zstd buffer>" Text.unpack mlabel
    File mlabel filePath ->
      maybe filePath Text.unpack mlabel

load
  :: forall a m env
  .  ( MonadIO m
     , MonadReader env m
     , HasLogFunc env
     , Typeable a
     , HasCallStack
     )
  => (ByteString -> m a)
  -> Source
  -> m a
load action = \case
  Bytes label !bytes -> do
    withFrozenCallStack . logDebug $
      case label of
        Nothing ->
          "Loading " <> displayShow (typeRep $ Proxy @a)
        Just someText ->
          "Loading " <> displayShow (typeRep $ Proxy @a) <> " from " <> display someText
    action bytes

  BytesZstd label !bytesZstd ->
    case Zstd.decompressBytes bytesZstd of
      Left zstdError ->
        throwIO zstdError
      Right !bytes ->
        load action $
          Bytes label bytes

  File label filePath -> do
    !bytes <- Zstd.fromFileWith pure (liftIO . ByteString.readFile) filePath
    load action $
      Bytes
        (label <|> Just (fromString filePath))
        bytes

embedFile :: FilePath -> TH.Q TH.Exp
embedFile filePath =
  case takeExtension filePath of
    ".zst" -> do
      bytesZstd <- Data.FileEmbed.embedFile filePath
      compressed <- [| Zstd.Compressed |]
      let bytesZstdExpr = compressed `TH.AppE` bytesZstd

      constr <- [| BytesZstd label |]
      pure $ constr `TH.AppE` bytesZstdExpr

    _ -> do
      bytes <- Data.FileEmbed.embedFile filePath
      constr <- [| Bytes label |]
      pure $ constr `TH.AppE` bytes
  where
    label = Just . mappend "embedded|" $ takeFileName filePath