{-# LANGUAGE CPP #-}
module Jukebox.TPTP.FindFile where

import System.FilePath
import System.Directory(doesFileExist)
import System.Environment
import Control.Exception
import Control.Monad
import Jukebox.Options
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
import Data.Traversable(sequenceA)
#endif

findFile :: [FilePath] -> FilePath -> IO (Maybe FilePath)
findFile :: [FilePath] -> FilePath -> IO (Maybe FilePath)
findFile [] FilePath
_file = Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
findFile (FilePath
path:[FilePath]
paths) FilePath
file = do
  let candidate :: FilePath
candidate = FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
file
  Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
candidate
  if Bool
exists then Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
candidate)
   else [FilePath] -> FilePath -> IO (Maybe FilePath)
findFile [FilePath]
paths FilePath
file

findFileTPTP :: [FilePath] -> FilePath -> IO (Maybe FilePath)
findFileTPTP :: [FilePath] -> FilePath -> IO (Maybe FilePath)
findFileTPTP [FilePath]
dirs FilePath
file = do
  let candidates :: [FilePath]
candidates = [FilePath
file, FilePath
"Problems" FilePath -> FilePath -> FilePath
</> FilePath
file,
                    FilePath
"Problems" FilePath -> FilePath -> FilePath
</> Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
3 FilePath
file FilePath -> FilePath -> FilePath
</> FilePath
file]
  ([Maybe FilePath] -> Maybe FilePath)
-> IO [Maybe FilePath] -> IO (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe FilePath] -> Maybe FilePath
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ((FilePath -> IO (Maybe FilePath))
-> [FilePath] -> IO [Maybe FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([FilePath] -> FilePath -> IO (Maybe FilePath)
findFile [FilePath]
dirs) [FilePath]
candidates)

getTPTPDirs :: IO [FilePath]
getTPTPDirs :: IO [FilePath]
getTPTPDirs = do { FilePath
dir <- FilePath -> IO FilePath
getEnv FilePath
"TPTP"; [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
dir] } IO [FilePath] -> (IOException -> IO [FilePath]) -> IO [FilePath]
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` IOException -> IO [FilePath]
f
  where f :: IOException -> IO [FilePath]
        f :: IOException -> IO [FilePath]
f IOException
_ = [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []

findFileFlags :: OptionParser [FilePath]
findFileFlags =
  FilePath -> OptionParser [FilePath] -> OptionParser [FilePath]
forall a. FilePath -> OptionParser a -> OptionParser a
inGroup FilePath
"Input and clausifier options" (OptionParser [FilePath] -> OptionParser [FilePath])
-> OptionParser [FilePath] -> OptionParser [FilePath]
forall a b. (a -> b) -> a -> b
$
  [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FilePath]] -> [FilePath])
-> Annotated [Flag] ParParser [[FilePath]]
-> OptionParser [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  [OptionParser [FilePath]]
-> Annotated [Flag] ParParser [[FilePath]]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [
    [FilePath] -> OptionParser [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FilePath
"."],
    [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FilePath]] -> [FilePath])
-> Annotated [Flag] ParParser [[FilePath]]
-> OptionParser [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      FilePath
-> [FilePath]
-> ArgParser [FilePath]
-> Annotated [Flag] ParParser [[FilePath]]
forall a. FilePath -> [FilePath] -> ArgParser a -> OptionParser [a]
manyFlags FilePath
"root"
        [FilePath
"Extra directories that will be searched for TPTP input files."]
        ArgParser [FilePath]
argFiles,
    IO [FilePath] -> OptionParser [FilePath]
forall a. IO a -> OptionParser a
io IO [FilePath]
getTPTPDirs
    ]