{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskellQuotes #-}

-- | External file 'Asset's.
module Drasil.Assets.FromLocalPath
  ( -- * Assets
    Asset,

    -- ** Constructors
    readAsset,

    -- ** Accessors
    content,
    description,

    -- ** File Dumping
    toFile,
  )
where

import Data.Text (Text)
import Language.Haskell.TH (Code (examineCode), Q, liftCode, runIO)
import Language.Haskell.TH.Syntax (addDependentFile, makeRelativeToProject)
import System.Directory.OsPath (doesPathExist)
import System.File.OsPath (readFile')
import System.OsPath (OsPath, decodeUtf, encodeUtf)
import Prelude hiding (readFile)

import Drasil.Assets.Core (Asset, content, description, mkAsset, toFile)

-- | Read a file from disk, providing a description of the asset.
readAsset :: OsPath -> Text -> Code Q Asset
readAsset :: OsPath -> Text -> Code Q Asset
readAsset OsPath
filePath Text
desc = Q (TExp Asset) -> Code Q Asset
forall a (m :: * -> *). m (TExp a) -> Code m a
liftCode (Q (TExp Asset) -> Code Q Asset) -> Q (TExp Asset) -> Code Q Asset
forall a b. (a -> b) -> a -> b
$ do
  FilePath
strPath <- IO FilePath -> Q FilePath
forall a. IO a -> Q a
runIO (OsPath -> IO FilePath
forall (m :: * -> *). MonadThrow m => OsPath -> m FilePath
decodeUtf OsPath
filePath)
  -- FIXME: HACK: This relies on decoding the path, making it relative, and then
  -- re-encoding. It works, but, when OsPath and OsString is propagated through
  -- GHC core libs more, this will break.
  FilePath
absPathStr <- FilePath -> Q FilePath
makeRelativeToProject FilePath
strPath
  OsPath
absPath <- IO OsPath -> Q OsPath
forall a. IO a -> Q a
runIO (FilePath -> IO OsPath
forall (m :: * -> *). MonadThrow m => FilePath -> m OsPath
encodeUtf FilePath
absPathStr)
  Bool
exists <- IO Bool -> Q Bool
forall a. IO a -> Q a
runIO (OsPath -> IO Bool
doesPathExist OsPath
absPath)
  if Bool
exists
    then do
      ByteString
fc <- IO ByteString -> Q ByteString
forall a. IO a -> Q a
runIO (OsPath -> IO ByteString
readFile' OsPath
absPath)
      let a :: Asset
a = Text -> ByteString -> Asset
mkAsset Text
desc ByteString
fc
      FilePath -> Q ()
addDependentFile FilePath
absPathStr
      Code Q Asset -> Q (TExp Asset)
forall (m :: * -> *) a. Code m a -> m (TExp a)
examineCode [||Asset
a||]
    else FilePath -> Q (TExp Asset)
forall a. HasCallStack => FilePath -> a
error (FilePath -> Q (TExp Asset)) -> FilePath -> Q (TExp Asset)
forall a b. (a -> b) -> a -> b
$ FilePath
"Asset file lookup failed. File does not exist: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
absPathStr