{-# LANGUAGE TemplateHaskell #-}

module Jikka.Common.FileEmbed where

import Control.Monad
import Data.Char
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Language.Haskell.TH
import Language.Haskell.TH.Syntax (addDependentFile)
import System.Directory

listDirectoryRecursive :: FilePath -> IO [FilePath]
listDirectoryRecursive :: FilePath -> IO [FilePath]
listDirectoryRecursive FilePath
path = do
  [FilePath]
paths <- (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/") FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
listDirectory FilePath
path
  [[FilePath]]
paths <- [FilePath] -> (FilePath -> IO [FilePath]) -> IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
paths ((FilePath -> IO [FilePath]) -> IO [[FilePath]])
-> (FilePath -> IO [FilePath]) -> IO [[FilePath]]
forall a b. (a -> b) -> a -> b
$ \FilePath
path -> do
    Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
path
    if Bool
isDir
      then FilePath -> IO [FilePath]
listDirectoryRecursive FilePath
path
      else [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
path]
  [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FilePath]]
paths

-- | `embedDir` find files recursively and embed their contents, like https://hackage.haskell.org/package/file-embed @file-embed@>'s <https://hackage.haskell.org/package/file-embed/docs/Data-FileEmbed.html#v:embedDir @embedDir@>.
--
-- == Usage
--
-- > myDir :: [(FilePath, Data.Text.Text)]
-- > myDir = $(embedDir "dirName")
embedDir :: FilePath -> Q Exp
embedDir :: FilePath -> Q Exp
embedDir FilePath
path = do
  [FilePath]
paths <- IO [FilePath] -> Q [FilePath]
forall a. IO a -> Q a
runIO (IO [FilePath] -> Q [FilePath]) -> IO [FilePath] -> Q [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
listDirectoryRecursive FilePath
path
  [Text]
contents <- IO [Text] -> Q [Text]
forall a. IO a -> Q a
runIO (IO [Text] -> Q [Text]) -> IO [Text] -> Q [Text]
forall a b. (a -> b) -> a -> b
$ (FilePath -> IO Text) -> [FilePath] -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO Text
T.readFile [FilePath]
paths :: Q [T.Text]
  (FilePath -> Q ()) -> [FilePath] -> Q ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> Q ()
addDependentFile [FilePath]
paths
  let contents' :: [[Int]]
contents' = (Text -> [Int]) -> [Text] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Int) -> FilePath -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Int
ord (FilePath -> [Int]) -> (Text -> FilePath) -> Text -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack) [Text]
contents -- use [Int] instead of T.Text for scripts/erase_template_haskell.py
  [e|zip paths (map (T.pack . map chr) contents') :: [(FilePath, T.Text)]|]