--------------------------------------------------------------------
-- |
-- Copyright :  © Edward Kmett 2010-2014, Johan Kiviniemi 2013
-- License   :  BSD3
-- Maintainer:  Edward Kmett <ekmett@gmail.com>
-- Stability :  experimental
-- Portability: non-portable
--
--------------------------------------------------------------------
module Ersatz.Solver.Common
  ( withTempFiles
  , resultOf

  -- * Support for trying many solvers
  , trySolvers
  , NoSolvers(..)

  , parseSolution5
  ) where

import Control.Exception (Exception(..), throwIO)
import Control.Monad.IO.Class
import Ersatz.Solution
import System.Exit (ExitCode(..))
import System.IO.Error (tryIOError)
import System.IO.Temp (withSystemTempDirectory)
import Data.IntMap (IntMap)
import qualified Data.IntMap.Strict as IntMap

withTempFiles :: MonadIO m
              => FilePath  -- ^ Problem file extension including the dot, if any
              -> FilePath  -- ^ Solution file extension including the dot, if any
              -> (FilePath -> FilePath -> IO a) -> m a
withTempFiles :: forall (m :: * -> *) a.
MonadIO m =>
FilePath -> FilePath -> (FilePath -> FilePath -> IO a) -> m a
withTempFiles FilePath
problemExt FilePath
solutionExt FilePath -> FilePath -> IO a
f = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
  forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> (FilePath -> m a) -> m a
withSystemTempDirectory FilePath
"ersatz" forall a b. (a -> b) -> a -> b
$ \FilePath
dir -> do
    let problemPath :: FilePath
problemPath  = FilePath
dir forall a. [a] -> [a] -> [a]
++ FilePath
"/problem"  forall a. [a] -> [a] -> [a]
++ FilePath
problemExt
        solutionPath :: FilePath
solutionPath = FilePath
dir forall a. [a] -> [a] -> [a]
++ FilePath
"/solution" forall a. [a] -> [a] -> [a]
++ FilePath
solutionExt

    FilePath -> FilePath -> IO a
f FilePath
problemPath FilePath
solutionPath

resultOf :: ExitCode -> Result
resultOf :: ExitCode -> Result
resultOf (ExitFailure Key
10) = Result
Satisfied
resultOf (ExitFailure Key
20) = Result
Unsatisfied
resultOf ExitCode
_                = Result
Unsolved

-- | This error is thrown by 'trySolvers' when no solvers are found.
newtype NoSolvers = NoSolvers [IOError] deriving Key -> NoSolvers -> ShowS
[NoSolvers] -> ShowS
NoSolvers -> FilePath
forall a.
(Key -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [NoSolvers] -> ShowS
$cshowList :: [NoSolvers] -> ShowS
show :: NoSolvers -> FilePath
$cshow :: NoSolvers -> FilePath
showsPrec :: Key -> NoSolvers -> ShowS
$cshowsPrec :: Key -> NoSolvers -> ShowS
Show

instance Exception NoSolvers where
  displayException :: NoSolvers -> FilePath
displayException NoSolvers
_ = FilePath
"no ersatz solvers were found"

-- | Try a list of solvers in order. When a solver fails due to
-- a missing executable the next solver will be tried. Throws
-- 'NoSolvers' exception if none of the given solvers were installed.
trySolvers :: [Solver s IO] -> Solver s IO
trySolvers :: forall s. [Solver s IO] -> Solver s IO
trySolvers [Solver s IO]
solvers s
problem = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {b}. (s -> IO b) -> ([IOError] -> IO b) -> [IOError] -> IO b
runSolver forall {a}. [IOError] -> IO a
noSolvers [Solver s IO]
solvers []
  where
    noSolvers :: [IOError] -> IO a
noSolvers = forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IOError] -> NoSolvers
NoSolvers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse

    runSolver :: (s -> IO b) -> ([IOError] -> IO b) -> [IOError] -> IO b
runSolver s -> IO b
solver [IOError] -> IO b
next [IOError]
es =
      do Either IOError b
res <- forall a. IO a -> IO (Either IOError a)
tryIOError (s -> IO b
solver s
problem)
         case Either IOError b
res of
           Left  IOError
e -> [IOError] -> IO b
next (IOError
eforall a. a -> [a] -> [a]
:[IOError]
es)
           Right b
x -> forall (m :: * -> *) a. Monad m => a -> m a
return b
x

parseSolution5 :: String -> IntMap Bool
parseSolution5 :: FilePath -> IntMap Bool
parseSolution5 FilePath
txt = forall a. [(Key, a)] -> IntMap a
IntMap.fromList [(forall a. Num a => a -> a
abs Key
v, Key
v forall a. Ord a => a -> a -> Bool
> Key
0) | Key
v <- [Key]
vars, Key
v forall a. Eq a => a -> a -> Bool
/= Key
0]
  where
    vlines :: [FilePath]
vlines = [FilePath
l | (Char
'v':FilePath
l) <- FilePath -> [FilePath]
lines FilePath
txt]
    vars :: [Key]
vars = forall a b. (a -> b) -> [a] -> [b]
map forall a. Read a => FilePath -> a
read (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FilePath -> [FilePath]
words [FilePath]
vlines)