module System.FilePath.TH where

import Prelude

import Control.Monad ((<=<))
import Data.FileEmbed (makeRelativeToProject)
import Language.Haskell.TH (Loc(Loc), Exp, Q, loc_filename, location, runIO, stringE)
import System.Directory (canonicalizePath, getCurrentDirectory)
import System.FilePath ((</>), takeDirectory)

fileRelativeToAbsolute :: String -> Q Exp
fileRelativeToAbsolute :: String -> Q Exp
fileRelativeToAbsolute = String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
stringE (String -> Q Exp) -> (String -> Q String) -> String -> Q Exp
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< String -> Q String
fileRelativeToAbsoluteStr

-- | Use a path relative to the source file in which you're writing the path instead of relative to the working
-- directory in which that source file will be compiled.
--
-- e.g. if this source file is in `my-project/src/Foo/Bar.hs`, `fileRelativeToAbsoluteStr
-- "../../../config/settings.yml"` will load the path at `my-project/config/settings.yml`.
--
-- If this function is provided an absolute path, it will simply canonicalize that path
-- by calling 'System.Directory.canonicalizePath' rather than compute an absolute path from
-- a relative path.
fileRelativeToAbsoluteStr :: String -> Q String
fileRelativeToAbsoluteStr :: String -> Q String
fileRelativeToAbsoluteStr absoluteFilePath :: String
absoluteFilePath@(Char
'/':String
_) =
  IO String -> Q String
forall a. IO a -> Q a
runIO (IO String -> Q String)
-> (String -> IO String) -> String -> Q String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO String
canonicalizePath (String -> Q String) -> String -> Q String
forall a b. (a -> b) -> a -> b
$ String
absoluteFilePath
fileRelativeToAbsoluteStr String
relativeFilePath = do
  Loc {String
loc_filename :: Loc -> String
loc_filename :: String
..} <- Q Loc
location
  String
currentDir <- IO String -> Q String
forall a. IO a -> Q a
runIO IO String
getCurrentDirectory
  let baseDir :: String
baseDir = String -> String
takeDirectory String
loc_filename
  IO String -> Q String
forall a. IO a -> Q a
runIO (IO String -> Q String) -> IO String -> Q String
forall a b. (a -> b) -> a -> b
$ String -> IO String
canonicalizePath (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
currentDir String -> String -> String
</> String
baseDir String -> String -> String
</> String
relativeFilePath

fileRelativeToProject :: FilePath -> Q Exp
fileRelativeToProject :: String -> Q Exp
fileRelativeToProject = String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
stringE (String -> Q Exp) -> (String -> Q String) -> String -> Q Exp
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< String -> Q String
makeRelativeToProject