{-# LANGUAGE OverloadedStrings #-}

-- | @futhark datacmp@
module Futhark.CLI.Datacmp (main) where

import Control.Exception
import qualified Data.ByteString.Lazy.Char8 as BS
import Futhark.Test.Values
import Futhark.Util.Options
import System.Exit
import System.IO

readFileSafely :: String -> IO (Either String BS.ByteString)
readFileSafely :: String -> IO (Either String ByteString)
readFileSafely String
filepath =
  (ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (ByteString -> Either String ByteString)
-> IO ByteString -> IO (Either String ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BS.readFile String
filepath) IO (Either String ByteString)
-> (IOError -> IO (Either String ByteString))
-> IO (Either String ByteString)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` IOError -> IO (Either String ByteString)
forall (m :: * -> *) b. Monad m => IOError -> m (Either String b)
couldNotRead
  where
    couldNotRead :: IOError -> m (Either String b)
couldNotRead IOError
e = Either String b -> m (Either String b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String b -> m (Either String b))
-> Either String b -> m (Either String b)
forall a b. (a -> b) -> a -> b
$ String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b) -> String -> Either String b
forall a b. (a -> b) -> a -> b
$ IOError -> String
forall a. Show a => a -> String
show (IOError
e :: IOError)

-- | Run @futhark datacmp@
main :: String -> [String] -> IO ()
main :: String -> [String] -> IO ()
main = ()
-> [FunOptDescr ()]
-> String
-> ([String] -> () -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
forall cfg.
cfg
-> [FunOptDescr cfg]
-> String
-> ([String] -> cfg -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
mainWithOptions () [] String
"<file> <file>" [String] -> () -> Maybe (IO ())
f
  where
    f :: [String] -> () -> Maybe (IO ())
f [String
file_a, String
file_b] () = IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ do
      Either String ByteString
file_contents_a_maybe <- String -> IO (Either String ByteString)
readFileSafely String
file_a
      Either String ByteString
file_contents_b_maybe <- String -> IO (Either String ByteString)
readFileSafely String
file_b
      case (Either String ByteString
file_contents_a_maybe, Either String ByteString
file_contents_b_maybe) of
        (Left String
err_msg, Either String ByteString
_) -> do
          Handle -> String -> IO ()
hPutStrLn Handle
stderr String
err_msg
          IO ()
forall a. IO a
exitFailure
        (Either String ByteString
_, Left String
err_msg) -> do
          Handle -> String -> IO ()
hPutStrLn Handle
stderr String
err_msg
          IO ()
forall a. IO a
exitFailure
        (Right ByteString
contents_a, Right ByteString
contents_b) -> do
          let vs_a_maybe :: Maybe [Value]
vs_a_maybe = ByteString -> Maybe [Value]
readValues ByteString
contents_a
          let vs_b_maybe :: Maybe [Value]
vs_b_maybe = ByteString -> Maybe [Value]
readValues ByteString
contents_b
          case (Maybe [Value]
vs_a_maybe, Maybe [Value]
vs_b_maybe) of
            (Maybe [Value]
Nothing, Maybe [Value]
_) -> do
              Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Error reading values from " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file_a
              IO ()
forall a. IO a
exitFailure
            (Maybe [Value]
_, Maybe [Value]
Nothing) -> do
              Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Error reading values from " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file_b
              IO ()
forall a. IO a
exitFailure
            (Just [Value]
vs_a, Just [Value]
vs_b) ->
              case [Value] -> [Value] -> [Mismatch]
compareValues [Value]
vs_a [Value]
vs_b of
                [] -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                [Mismatch]
es -> do
                  (Mismatch -> IO ()) -> [Mismatch] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Mismatch -> IO ()
forall a. Show a => a -> IO ()
print [Mismatch]
es
                  ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (ExitCode -> IO ()) -> ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
2
    f [String]
_ ()
_ =
      Maybe (IO ())
forall a. Maybe a
Nothing