{-| Compile-time generated files, used to put all data-files in the executable
    to make it easy to distribute.
-}

{-# LANGUAGE CPP             #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections   #-}

module Dhall.Docs.Embedded (getDataDir) where

import Data.ByteString (ByteString)
import Path            (File, Path, Rel)

import qualified Path

#if defined(EMBED)

import Data.FileEmbed (embedDir)

#else

import Paths_dhall_docs hiding (getDataDir)

import qualified Control.Monad
import qualified Data.ByteString as ByteString
import qualified Path.IO

#endif

getDataDir :: IO [(Path Rel File, ByteString)]
#if defined(EMBED)
getDataDir :: IO [(Path Rel File, ByteString)]
getDataDir = ((FilePath, ByteString) -> IO (Path Rel File, ByteString))
-> [(FilePath, ByteString)] -> IO [(Path Rel File, ByteString)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FilePath, ByteString) -> IO (Path Rel File, ByteString)
f $(embedDir "src/Dhall/data/assets")
  where
    f :: (FilePath, ByteString) -> IO (Path Rel File, ByteString)
    f :: (FilePath, ByteString) -> IO (Path Rel File, ByteString)
f (FilePath
filePath, ByteString
contents) = (,ByteString
contents) (Path Rel File -> (Path Rel File, ByteString))
-> IO (Path Rel File) -> IO (Path Rel File, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Path Rel File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
Path.parseRelFile FilePath
filePath
#else
getDataDir = do
    dir <- Path.parent
        <$> (getDataFileName "src/Dhall/data/assets/index.css" >>= Path.parseAbsFile)
    files <- snd <$> Path.IO.listDir dir
    Control.Monad.forM files $ \file -> do
        contents <- ByteString.readFile $ Path.fromAbsFile file
        return (Path.filename file, contents)

#endif