{-# LANGUAGE CPP, BangPatterns, ForeignFunctionInterface #-}
module Math.Singular.Factory.GFTables where
import Control.Monad
import Foreign.Ptr
import Foreign.C
import Foreign.C.String
import System.FilePath
import System.Directory
import System.Process
import Data.IORef
import System.IO.Unsafe as Unsafe
{-# NOINLINE theGFTablesDir #-}
theGFTablesDir :: IORef (Maybe FilePath)
theGFTablesDir = Unsafe.unsafePerformIO $ newIORef Nothing
getGFTablesDir :: IO (Maybe FilePath)
getGFTablesDir = readIORef theGFTablesDir
initGFTables :: IO ()
initGFTables = initGFTables' Nothing
initGFTables' :: Maybe FilePath -> IO ()
initGFTables' mbdir = case mbdir of
Just fpath -> setGFTablesDir fpath
Nothing -> guessGFTablesDir >>= \d -> case d of
Just fpath -> do
setGFTablesDir fpath
Nothing -> do
writeIORef theGFTablesDir Nothing
putStrLn "WARNING: cannot find factory's gftables"
setGFTablesDir :: FilePath -> IO ()
setGFTablesDir fpath0 = do
fpath1 <- canonicalizePath fpath0
withCString (fpath1 ++ "/") $ \ptr -> set_gftable_dir ptr
writeIORef theGFTablesDir (Just fpath1)
foreign import ccall "set_gftable_dir" set_gftable_dir :: Ptr CChar -> IO ()
guessGFTablesDir :: IO (Maybe FilePath)
guessGFTablesDir = do
#if defined(linux_HOST_OS)
guessLinux
#elif defined(darwin_HOST_OS)
guessHomebrew
#elif defined(mingw32_HOST_OS) || defined(mingw64_HOST_OS)
guessCygwin
#else
return Nothing
#endif
infixr 5 >>>
(>>>) :: IO (Maybe a) -> IO (Maybe a) -> IO (Maybe a)
(>>>) action1 action2 = do
mb <- action1
case mb of
Just x -> return (Just x)
Nothing -> action2
testDir :: FilePath -> IO (Maybe FilePath)
testDir dir = doesFileExist (dir </> "gftables/361") >>= \b -> if b
then return (Just dir)
else return Nothing
guessHomebrew :: IO (Maybe FilePath)
guessHomebrew = do
let brew_prefix = "/usr/local"
let cellar = brew_prefix </> "Cellar"
let sing_root = cellar </> "singular"
entries <- map (sing_root </>) <$> listDirectory sing_root
subdirs <- filterM doesDirectoryExist entries
foldl (>>>) (return Nothing) [ testDir (sing_root </> d </> "share/factory") | d <- subdirs]
guessLinux :: IO (Maybe FilePath)
guessLinux =
testDir "/usr/share/singular/factory" >>>
testDir "/usr/share/singular" >>>
testDir "/usr/share/factory" >>>
testDir "/usr/local/share/singular/factory" >>>
testDir "/usr/local/share/singular" >>>
testDir "/usr/local/share/factory"
guessCygwin ::IO (Maybe FilePath)
guessCygwin = do
cygwin_root <- readCreateProcess (shell "cygpath -w /") ""
let test1 dir = testDir (cygwin_root </> dir)
id <$>
test1 "/usr/share/singular/factory" >>>
test1 "/usr/share/singular" >>>
test1 "/usr/share/factory" >>>
test1 "/usr/local/share/singular/factory" >>>
test1 "/usr/local/share/singular" >>>
test1 "/usr/local/share/factory"