Scripts.hs

-- | Contains some useful scripts for automating things.
--
-- Some functions assume that are ran from the project root dir.
{-# LANGUAGE OverloadedStrings #-}
-- :set -XOverloadedStrings
module AM3.Scripts where

import System.Process
import System.FilePath
import System.Directory
import Control.Monad.Random
import Control.Monad.Extra
import AM3.RandomInstance
import AM3.TestParams
import Control.Monad.Trans
import Numeric
import System.Clock

-- process = proc

-- -- | Runs oplrun in all the .dats in a directory
-- runOplDir dir = do
--   export "LD_LIBRARY_PATH" "$LD_LIBRARY_PATH:$HOME/Programs/cplex-studio126/opl/bin/x86-64_linux"
--   e <- need "LD_LIBRARY_PATH"
--   print e
--   process "oplrun" ["-version"] empty
--   shell "oplrun" empty

getDirectoryContentsAbsolute :: FilePath -> IO [FilePath]
getDirectoryContentsAbsolute dir =
  map (dir </>) <$> getDirectoryContents dir

getDats :: FilePath -> IO [FilePath]
getDats dir = filter isDat <$> getDirectoryContentsAbsolute dir
  where isDat = (==".dat") . takeExtension

appendFileName :: FilePath -> String -> FilePath
appendFileName file x = replaceBaseName file (takeBaseName file ++ x)

rdd :: Int -> FilePath
rdd i = "dat" </> "runs" </> "run" ++ show i

-- | Guarantees no overwrites.
withNum :: FilePath -> IO FilePath
withNum = go 0
  where
    go n file = ifM (doesFileExist file')
      (go (n + 1) file) (return file')
      where file'
              | n == 0 = file
              | otherwise = appendFileName file ("-" ++ show n)

-- | oplrun from the root dir.
runOpl :: String -> FilePath -> IO ()
runOpl mod dat = do
  out <- withNum (replaceExtension dat ".out")
  readProcess "oplrun" [mod, dat] "" >>= writeFile out

runStackGrasp :: Int -> FilePath -> IO ()
runStackGrasp seed dat = do
  out <- withNum (replaceExtension dat ".grasp")
  timeReadProcess "time" ["stack", "exec", "grasp-exe", "--", "-g", show seed, dat] ""
   >>= \(stdout, nanos) -> writeFile out (unlines [stdout, "time: " ++ show nanos])


timeReadProcess :: String -> [String] -> String -> IO (String, Integer)
timeReadProcess cmd args stdin = do
  t1 <- getTime Monotonic
  r <- readProcess cmd args stdin
  t2 <- getTime Monotonic
  return (r, timeSpecAsNanoSecs $ diffTimeSpec t1 t2)

timeSpecsAsSecs :: TimeSpec -> Double
timeSpecsAsSecs = (/1000) . fromInteger . (`div`(10^6)) . timeSpecAsNanoSecs

-- | Creates many randomly generated test in a folder.
populateFolder :: Int -> Int -> Params -> FilePath -> IO ()
populateFolder seed many params dir = flip evalRandT (mkStdGen seed) $
  do
    info <- lift $ withNum (dir </> "info.txt")
    lift $ writeFile info (unlines ["seed: " ++ show seed
                                   , "many: " ++ show many
                                   , show params])
    names <- lift $ mapM withNum [dir </> "test" ++ show n <.> ".dat" | n <- [1..many]]
    forM_ names (randomInstanceFile params)


-- | Runs oplrun in all the .dat files in a directory.
runOplDir :: FilePath -> IO ()
runOplDir dir = do
  dats <- getDats dir >>= mapM makeAbsolute
  print dats
  forM_ dats (runOpl "dat/oplP.mod")

runGraspDir :: Int -> FilePath -> IO ()
runGraspDir seed dir = do
  dats <- getDats dir >>= mapM makeAbsolute
  print dats
  forM_ dats (\d -> print d >> runStackGrasp seed d)


-- renaming :: IO ()
-- renaming =
--   getDirectoryContentsAbsolute "dat/runs/run2" >>= mapM_ rename
--     where
--       rename x
--         | takeExtension x == ".dat" || takeExtension x == ".out" =
--           let old = takeBaseName x
--               new = replaceBaseName x ("test" ++ (reverse . drop k .reverse . drop 5) old)
--           in print (x, new) >> renameFile x new
--         | otherwise = return ()
--         where
--           k
--             | takeExtension x == ".dat" = 2
--             | otherwise = 4