module Include ( defaultIncludes
               , resolveImport
               ) where

import           Control.Exception  (Exception, throwIO)
import           Control.Monad      (filterM)
import           Data.List.Split    (splitWhen)
import           Data.Maybe         (listToMaybe)
import           Paths_jacinda      (getDataDir)
import           System.Directory   (doesFileExist, getCurrentDirectory,doesDirectoryExist)
import           System.Environment (lookupEnv)
import           System.FilePath    ((</>))

data ImportError = FileNotFound !FilePath ![FilePath] deriving (Int -> ImportError -> ShowS
[ImportError] -> ShowS
ImportError -> String
(Int -> ImportError -> ShowS)
-> (ImportError -> String)
-> ([ImportError] -> ShowS)
-> Show ImportError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImportError -> ShowS
showsPrec :: Int -> ImportError -> ShowS
$cshow :: ImportError -> String
show :: ImportError -> String
$cshowList :: [ImportError] -> ShowS
showList :: [ImportError] -> ShowS
Show)

instance Exception ImportError where

defaultIncludes :: IO ([FilePath] -> [FilePath])
defaultIncludes :: IO ([String] -> [String])
defaultIncludes = do
    path <- IO [String]
jacPath
    d <- getDataDir
    dot <- getCurrentDirectory
    share <- doesDirectoryExist shareDir
    pure $ (if share then (shareDir:) else id).(dot:).(d:).(++path)
  where
    shareDir :: String
shareDir = String
"/usr/local/share/jac"

jacPath :: IO [FilePath]
jacPath :: IO [String]
jacPath = [String] -> (String -> [String]) -> Maybe String -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] String -> [String]
splitEnv (Maybe String -> [String]) -> IO (Maybe String) -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
"JAC_PATH"

splitEnv :: String -> [FilePath]
splitEnv :: String -> [String]
splitEnv = (Char -> Bool) -> String -> [String]
forall a. (a -> Bool) -> [a] -> [[a]]
splitWhen (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':')

resolveImport :: [FilePath] -- ^ Places to look
              -> FilePath
              -> IO FilePath
resolveImport :: [String] -> String -> IO String
resolveImport [String]
incl String
fp =
    IO String -> (String -> IO String) -> Maybe String -> IO String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ImportError -> IO String
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (ImportError -> IO String) -> ImportError -> IO String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> ImportError
FileNotFound String
fp [String]
incl) String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe String -> IO String)
-> ([String] -> Maybe String) -> [String] -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe
        ([String] -> IO String) -> IO [String] -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ((String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
doesFileExist ([String] -> IO [String])
-> ([String] -> [String]) -> [String] -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> ShowS
</> String
fp) ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ [String]
incl)