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