module Resource.Source ( Source(..) , load , embedFile ) where import RIO import Data.FileEmbed qualified import Data.Typeable import GHC.Records (HasField(..)) 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 HasField "label" Source (Maybe Text) where {-# INLINE getField #-} getField = \case Bytes label _bytes -> label BytesZstd label _bytes -> label File label _path -> label instance Show Source where show = \case Bytes mlabel _bs -> maybe "" Text.unpack mlabel BytesZstd mlabel _zbs -> maybe "" 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