{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
-- | This module uses template Haskell. Following is a simplified explanation of usage for those unfamiliar with calling Template Haskell functions.
--
-- The function @embedFile@ in this modules embeds a file into the executable
-- that you can use it at runtime. A file is represented as a @ByteString@.
-- However, as you can see below, the type signature indicates a value of type
-- @Q Exp@ will be returned. In order to convert this into a @ByteString@, you
-- must use Template Haskell syntax, e.g.:
--
-- > $(embedFile "myfile.txt")
--
-- This expression will have type @ByteString@. Be certain to enable the
-- TemplateHaskell language extension, usually by adding the following to the
-- top of your module:
--
-- > {-# LANGUAGE TemplateHaskell #-}
module Data.FileEmbed
    ( -- * Embed at compile time
      embedFile
    , embedOneFileOf
    , embedDir
      -- * Relative path manipulation
    , makeRelativeToProject
    ) where

import Language.Haskell.TH.Syntax
    ( Exp (AppE, ListE, LitE, TupE, SigE, VarE)
    , Lit (StringL)
    , Q
    , runIO
    , qLocation, loc_filename
#if MIN_VERSION_template_haskell(2, 7, 0)
    , Quasi(qAddDependentFile)
#endif
    )
import System.Directory (doesDirectoryExist, doesFileExist,
                         getDirectoryContents, canonicalizePath)
import Control.Applicative ((<|>), (<$>))
import Control.Exception (throw, ErrorCall(..))
import Control.Monad (filterM)
import Control.Arrow ((&&&), second)
import System.FilePath ((</>), takeDirectory, takeExtension)
import Data.String (IsString, fromString)
import Prelude as P


-- | Embed a single file in your source code.
--
-- > import Data.String
-- >
-- > myFile :: IsString a => a
-- > myFile = $(embedFile "dirName/fileName")
embedFile :: FilePath -> Q Exp
embedFile fp =
#if MIN_VERSION_template_haskell(2, 7, 0)
    qAddDependentFile fp >>
#endif
  (runIO $ readFile fp) >>= toExp

-- | Embed a single existing string file in your source code
-- out of list a list of paths supplied.
embedOneFileOf :: [FilePath] -> Q Exp
embedOneFileOf  ps =
  (runIO $ readExistingFile ps) >>= \ ( path, content ) -> do
#if MIN_VERSION_template_haskell(2, 7, 0)
    qAddDependentFile path
#endif
    toExp content
  where
    readExistingFile :: [FilePath] -> IO (FilePath, String)
    readExistingFile xs = do
      ys <- filterM doesFileExist xs
      case ys of
        (p:_) -> readFile p >>= \ c -> return ( p, c )
        _ -> throw $ ErrorCall "Cannot find file to embed as resource"

-- | Embed a directory recursively in your source code.
--
-- > import Data.String
-- >
-- > myDir :: IsString a => [(FilePath, a)]
-- > myDir = $(embedDir "dirName")
embedDir :: FilePath -> Q Exp
embedDir fp = do
    typ <- [t| forall a. IsString a => [(FilePath, a)] |]
    e <- ListE <$> ((runIO $ getDir) >>= mapM (pairToExp fp))
    return $ SigE e typ
    where 
        getDir = fileList fp ""

        pairToExp :: FilePath -> (FilePath, String) -> Q Exp
        pairToExp _root (path, bs) = do
#if MIN_VERSION_template_haskell(2, 7, 0)
            qAddDependentFile $ _root ++ '/' : path
#endif
            exp' <- toExp bs
            return $! TupE [LitE $ StringL path, exp']

fileList :: FilePath -> FilePath -> IO [(FilePath, String)]
fileList realTop top = do
    allContents <- filter notHidden <$> getDirectoryContents (realTop </> top)
    let all' = map ((top </>) &&& (\x -> realTop </> top </> x)) allContents
    files <- filterM (doesFileExist . snd) all' >>=
             mapM (liftPair2 . second readFile)
    dirs <- filterM (doesDirectoryExist . snd) all' >>=
            mapM (fileList realTop . fst)
    return $ concat $ files : dirs
    where
        notHidden :: FilePath -> Bool
        notHidden ('.':_) = False
        notHidden _ = True

        liftPair2 :: Monad m => (a, m b) -> m (a, b)
        liftPair2 (a, b) = b >>= \b' -> return (a, b')

toExp :: String -> Q Exp
toExp s =
    return $ VarE 'fromString
      `AppE` LitE (StringL s)

-- | Take a relative file path and attach it to the root of the current
-- project.
--
-- The idea here is that, when building with Stack, the build will always be
-- executed with a current working directory of the root of the project (where
-- your .cabal file is located). However, if you load up multiple projects with
-- @stack ghci@, the working directory may be something else entirely.
--
-- This function looks at the source location of the Haskell file calling it,
-- finds the first parent directory with a .cabal file, and uses that as the
-- root directory for fixing the relative path.
--
-- > $(makeRelativeToProject "data/foo.txt" >>= embedFile)
--
-- @since 0.0.10
makeRelativeToProject :: FilePath -> Q FilePath
makeRelativeToProject rel = do
    loc <- qLocation
    runIO $ do
        srcFP <- canonicalizePath $ loc_filename loc
        mdir <- findProjectDir srcFP
        case mdir of
            Nothing -> error $ "Could not find .cabal file for path: " ++ srcFP
            Just dir -> return $ dir </> rel
  where
    findProjectDir x = do
        let dir = takeDirectory x
        if dir == x
            then return Nothing
            else do
                contents <- getDirectoryContents dir
                if any isCabalFile contents
                    then return (Just dir)
                    else findProjectDir dir

    isCabalFile fp = takeExtension fp == ".cabal"