module Codec.GlTF.URI
  ( URI(..)
  , loadURI
  ) where

import Codec.GlTF.Prelude

import Data.ByteString (ByteString)
import Data.Text.Encoding (encodeUtf8)
import GHC.Stack (HasCallStack)

import qualified Data.ByteString.Base64 as Base64
import qualified Data.Text as Text

-- | The URI of the buffer or image.
--
-- Relative paths are relative to the .gltf file.
-- Instead of referencing an external file, the uri can also be a data-uri.
newtype URI = URI Text
  deriving (Eq, Ord, Show, FromJSON, ToJSON, Generic)

loadURI :: HasCallStack => (FilePath -> IO (Either String ByteString)) -> URI -> IO (Either String ByteString)
loadURI fileLoader (URI uri) =
  if Text.isPrefixOf "data:" uri then
    case Text.breakOn needle uri of
      (_prefix, "") ->
        error "Malformed data: URI"
      (_prefix, found) ->
        pure . Base64.decode . encodeUtf8 $ Text.drop (Text.length needle) found
  else
    fileLoader (Text.unpack uri)
  where
    needle = ";base64,"