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 :: Source -> Maybe Text getField = \case Bytes Maybe Text label ByteString _bytes -> Maybe Text label BytesZstd Maybe Text label Compressed ByteString _bytes -> Maybe Text label File Maybe Text label FilePath _path -> Maybe Text label instance Show Source where show :: Source -> FilePath show = \case Bytes Maybe Text mlabel ByteString _bs -> forall b a. b -> (a -> b) -> Maybe a -> b maybe FilePath "<buffer>" Text -> FilePath Text.unpack Maybe Text mlabel BytesZstd Maybe Text mlabel Compressed ByteString _zbs -> forall b a. b -> (a -> b) -> Maybe a -> b maybe FilePath "<zstd buffer>" Text -> FilePath Text.unpack Maybe Text mlabel File Maybe Text mlabel FilePath filePath -> forall b a. b -> (a -> b) -> Maybe a -> b maybe FilePath filePath Text -> FilePath Text.unpack Maybe Text mlabel load :: forall a m env . ( MonadIO m , MonadReader env m , HasLogFunc env , Typeable a , HasCallStack ) => (ByteString -> m a) -> Source -> m a load :: forall a (m :: * -> *) env. (MonadIO m, MonadReader env m, HasLogFunc env, Typeable a, HasCallStack) => (ByteString -> m a) -> Source -> m a load ByteString -> m a action = \case Bytes Maybe Text label !ByteString bytes -> do forall a. HasCallStack => (HasCallStack => a) -> a withFrozenCallStack forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) env. (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) => Utf8Builder -> m () logDebug forall a b. (a -> b) -> a -> b $ case Maybe Text label of Maybe Text Nothing -> Utf8Builder "Loading " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> Utf8Builder displayShow (forall {k} (proxy :: k -> *) (a :: k). Typeable a => proxy a -> TypeRep typeRep forall a b. (a -> b) -> a -> b $ forall {k} (t :: k). Proxy t Proxy @a) Just Text someText -> Utf8Builder "Loading " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> Utf8Builder displayShow (forall {k} (proxy :: k -> *) (a :: k). Typeable a => proxy a -> TypeRep typeRep forall a b. (a -> b) -> a -> b $ forall {k} (t :: k). Proxy t Proxy @a) forall a. Semigroup a => a -> a -> a <> Utf8Builder " from " forall a. Semigroup a => a -> a -> a <> forall a. Display a => a -> Utf8Builder display Text someText ByteString -> m a action ByteString bytes BytesZstd Maybe Text label !Compressed ByteString bytesZstd -> case Compressed ByteString -> Either CompressedError ByteString Zstd.decompressBytes Compressed ByteString bytesZstd of Left CompressedError zstdError -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a throwIO CompressedError zstdError Right !ByteString bytes -> forall a (m :: * -> *) env. (MonadIO m, MonadReader env m, HasLogFunc env, Typeable a, HasCallStack) => (ByteString -> m a) -> Source -> m a load ByteString -> m a action forall a b. (a -> b) -> a -> b $ Maybe Text -> ByteString -> Source Bytes Maybe Text label ByteString bytes File Maybe Text label FilePath filePath -> do !ByteString bytes <- forall (m :: * -> *) b. MonadIO m => (ByteString -> m b) -> (FilePath -> m b) -> FilePath -> m b Zstd.fromFileWith forall (f :: * -> *) a. Applicative f => a -> f a pure (forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (m :: * -> *). MonadIO m => FilePath -> m ByteString ByteString.readFile) FilePath filePath forall a (m :: * -> *) env. (MonadIO m, MonadReader env m, HasLogFunc env, Typeable a, HasCallStack) => (ByteString -> m a) -> Source -> m a load ByteString -> m a action forall a b. (a -> b) -> a -> b $ Maybe Text -> ByteString -> Source Bytes (Maybe Text label forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> forall a. a -> Maybe a Just (forall a. IsString a => FilePath -> a fromString FilePath filePath)) ByteString bytes embedFile :: FilePath -> TH.Q TH.Exp embedFile :: FilePath -> Q Exp embedFile FilePath filePath = case ShowS takeExtension FilePath filePath of FilePath ".zst" -> do Exp bytesZstd <- FilePath -> Q Exp Data.FileEmbed.embedFile FilePath filePath Exp compressed <- [| Zstd.Compressed |] let bytesZstdExpr :: Exp bytesZstdExpr = Exp compressed Exp -> Exp -> Exp `TH.AppE` Exp bytesZstd Exp constr <- [| BytesZstd label |] pure $ Exp constr Exp -> Exp -> Exp `TH.AppE` Exp bytesZstdExpr FilePath _ -> do Exp bytes <- FilePath -> Q Exp Data.FileEmbed.embedFile FilePath filePath Exp constr <- [| Bytes label |] pure $ Exp constr Exp -> Exp -> Exp `TH.AppE` Exp bytes where label :: Maybe FilePath label = forall a. a -> Maybe a Just forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. Monoid a => a -> a -> a mappend FilePath "embedded|" forall a b. (a -> b) -> a -> b $ ShowS takeFileName FilePath filePath