packages feed

photoname-5.0: src/tests/TestLink.hs

{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}

module TestLink
  ( tests
  )
  where

import System.Directory ( copyFile, removeDirectoryRecursive, removeFile )
import System.FilePath.Posix ( (</>), (<.>) )
import System.Posix.Files ( fileExist )
import System.Process ( waitForProcess )
import Text.Regex.Posix ( (=~) )
import Test.Tasty
import Test.Tasty.HUnit
import qualified Util


parentDir, oldPath, newLinkPathDate :: FilePath

parentDir = Util.resourcesPath </> "testParentDir"
oldPath = Util.resourcesPath </> "dateTimeDigitized.jpg"
newLinkPathDate = parentDir </> "2003/2003-09-02/20030902-114303.jpg"


tests :: TestTree
tests = testGroup "test the normal behavior of hard-linking original files to new paths"
  [ testLinkDigitized
  , testLinkOriginal
  , testLinkDate
  , testNoDate
  , testMove
  , testLinkNoAction
  , testLinkNoActionLong
  , testLinkQuiet
  , testLinkQuietLong
  , testLinkSuffix
  , testLinkPrefix
  , testNoExif
  , testNotAnImage
  , testDirForFile
  , testLinkFilenameDate
  ]


testLinkDigitized :: TestTree
testLinkDigitized = testCase "tests for DateTimeDigitized" $ do
   -- Run the program with known input data
   (output, procH) <- Util.getBinaryOutput
      [ "--parent-dir=" ++ parentDir, oldPath ]
   waitForProcess procH

   -- Check that the correct output path exists
   existsNew <- fileExist newLinkPathDate
   assertBool "make link, date digitized: existance of new link" existsNew

   -- Check that old path still exists
   existsOld <- fileExist oldPath
   assertBool "make link, date digitized: existance of old link" existsOld

   -- Remove files and dirs that were created
   removeDirectoryRecursive parentDir

   -- Test output to stdout
   assertBool "make link, date digitized: correct output"
      (output =~ newLinkPathDate :: Bool)


testLinkOriginal :: TestTree
testLinkOriginal = testCase "tests for DateTimeOriginal" $ do
   let digitizedOldPath = Util.resourcesPath </> "dateTimeOriginal.jpg"

   -- Run the program with known input data
   (output, procH) <- Util.getBinaryOutput
      [ "--parent-dir=" ++ parentDir, digitizedOldPath ]
   waitForProcess procH

   -- Check that the correct output path exists
   existsNew <- fileExist newLinkPathDate
   assertBool "make link, date original: existance of new link" existsNew

   -- Check that old path still exists
   existsOld <- fileExist digitizedOldPath
   assertBool "make link, date original: existance of old link" existsOld

   -- Remove files and dirs that were created
   removeDirectoryRecursive parentDir

   -- Test output to stdout
   assertBool "make link, date original: correct output"
      (output =~ newLinkPathDate :: Bool)


testLinkDate :: TestTree
testLinkDate = testCase "tests for DateTime" $ do
   let dateOldPath = Util.resourcesPath </> "dateTime.jpg"
   let customLinkPathDate = parentDir </> "2019/2019-03-26/20190326-075309.jpg"

   -- Run the program with known input data
   (output, procH) <- Util.getBinaryOutput
      [ "--parent-dir=" ++ parentDir, dateOldPath ]
   waitForProcess procH

   -- Check that the correct output path exists
   existsNew <- fileExist customLinkPathDate
   assertBool "make link, date: existance of new link" existsNew

   -- Check that old path still exists
   existsOld <- fileExist dateOldPath
   assertBool "make link, date: existance of old link" existsOld

   -- Remove files and dirs that were created
   removeDirectoryRecursive parentDir

   -- Test output to stdout
   assertBool "make link, date: correct output"
      (output =~ customLinkPathDate :: Bool)


testNoDate :: TestTree
testNoDate = testCase "test for no date in the file" $ do
   -- Run the program with known input data
   (output, procH) <- Util.getBinaryOutput
      [ "--parent-dir=" ++ parentDir, Util.resourcesPath </> "noDate.jpg" ]
   waitForProcess procH

   -- Test output to stdout
   assertBool "no EXIF: correct output"
      (output =~ "\\*\\* Processing util/resources/test/noDate.jpg: Could not extract any date information" :: Bool)


testMove :: TestTree
testMove = testCase "tests to ensure the file is moved (original link removed)" $ do
   -- Make a dummy copy of the source file. This test will be getting rid
   -- of it, if successful.
   let newOldPath = Util.resourcesPath </> "moveTest.jpg"
   copyFile oldPath newOldPath

   -- Run the program with known input data
   (output, procH) <- Util.getBinaryOutput
      [ "--move", "--parent-dir=" ++ parentDir, newOldPath ]
   waitForProcess procH

   -- Check that the correct output path exists
   existsNew <- fileExist newLinkPathDate
   assertBool "move file: existance of new link" existsNew

   -- Check that old path still exists
   existsOld <- fileExist newOldPath
   Util.assertFalse "move file: existance of old link" existsOld

   -- Remove files and dirs that were created
   removeDirectoryRecursive parentDir

   -- Test output to stdout
   assertBool "move file: correct output"
      (output =~ newLinkPathDate :: Bool)


testLinkNoAction :: TestTree
testLinkNoAction = testLinkNoAction' "no action" "-n"


testLinkNoActionLong :: TestTree
testLinkNoActionLong = testLinkNoAction' "no action long" "--no-action"


testLinkNoAction' :: String -> String -> TestTree
testLinkNoAction' label switch = testCase label $ do
   -- Run the program with known input data
   (output, procH) <- Util.getBinaryOutput
      [ switch, "--parent-dir=" ++ parentDir, oldPath ]
   waitForProcess procH

   -- Check that the correct output path exists
   existsNew <- fileExist parentDir
   Util.assertFalse (label ++ ": existance of new link") existsNew

   -- Check that old path still exists
   existsOld <- fileExist oldPath
   assertBool (label ++ ": existance of old link") existsOld

   -- Test output to stdout
   assertBool (label ++ ": correct output")
      (output =~ newLinkPathDate :: Bool)


testLinkQuiet :: TestTree
testLinkQuiet = testLinkQuiet' "make link quiet" "-v0"


testLinkQuietLong :: TestTree
testLinkQuietLong = testLinkQuiet' "make link quiet long" "--verbose 0"


-- Reusable test code for above short/long versions of the quiet switch
testLinkQuiet' :: String -> String -> TestTree
testLinkQuiet' label switch = testCase label $ do
   -- Run the program with known input data
   (output, procH) <- Util.getBinaryOutput
      [ switch, "--parent-dir=" ++ parentDir, oldPath ]
   waitForProcess procH

   -- Check that the correct output path exists
   existsNew <- fileExist newLinkPathDate
   assertBool (label ++ ": existance of new link") existsNew

   -- Check that old path still exists
   existsOld <- fileExist oldPath
   assertBool (label ++ ": existance of old link") existsOld

   -- Remove files and dirs that were created
   removeDirectoryRecursive parentDir

   -- Test output to stdout
   Util.assertFalse (label ++ ": no output")
      (output =~ newLinkPathDate :: Bool)


testLinkSuffix :: TestTree
testLinkSuffix = testCase "test link with a suffix" $ do
   let suffix = "_dwm"

   -- Run the program with known input data
   (output, procH) <- Util.getBinaryOutput
      [ "--parent-dir=" ++ parentDir, "--suffix=" ++ suffix, oldPath ]
   waitForProcess procH

   let newLinkPath = parentDir </>
         ("2003/2003-09-02/20030902-114303" ++ suffix) <.> "jpg"

   -- Check that the correct output path exists
   existsNew <- fileExist newLinkPath
   assertBool "make link: existance of new link" existsNew

   -- Check that old path still exists
   existsOld <- fileExist oldPath
   assertBool "make link: existance of old link" existsOld

   -- Remove files and dirs that were created
   removeDirectoryRecursive parentDir

   -- Test output to stdout
   assertBool "make link: correct output"
      (output =~ newLinkPath :: Bool)


testLinkPrefix :: TestTree
testLinkPrefix = testCase "test link with a prefix" $ do
  let prefix = "SomeSubject_"

  -- Run the program with known input data
  (output, procH) <- Util.getBinaryOutput
    [ "--parent-dir=" ++ parentDir, "--prefix=" ++ prefix, oldPath ]
  waitForProcess procH

  let newLinkPath = parentDir </>
        ("2003/2003-09-02/" <> prefix <> "20030902-114303") <.> "jpg"

  -- Check that the correct output path exists
  existsNew <- fileExist newLinkPath
  assertBool "make link: existance of new link" existsNew

  -- Check that old path still exists
  existsOld <- fileExist oldPath
  assertBool "make link: existance of old link" existsOld

  -- Remove files and dirs that were created
  removeDirectoryRecursive parentDir

  -- Test output to stdout
  assertBool "make link: correct output"
    (output =~ newLinkPath :: Bool)


testNoExif :: TestTree
testNoExif = testCase "test for a file without any EXIF data" $ do
   -- Run the program with known input data
   (output, procH) <- Util.getBinaryOutput
      [ "--parent-dir=" ++ parentDir, Util.resourcesPath </> "noExif.jpg" ]
   waitForProcess procH

   -- Test output to stdout
   assertBool "no EXIF: correct output"
      (output =~ "\\*\\* Processing util/resources/test/noExif.jpg: Could not extract any date information" :: Bool)


testNotAnImage :: TestTree
testNotAnImage = testCase "test for a file that isn't an image" $ do
   -- Run the program with known input data
   (output, procH) <- Util.getBinaryOutput
      [ "--parent-dir=" ++ parentDir, Util.resourcesPath </> "notAnImage.txt" ]
   waitForProcess procH

   -- Test output to stdout
   assertBool "no EXIF: correct output"
      (output =~ "\\*\\* Processing util/resources/test/notAnImage.txt: Could not extract any date information" :: Bool)


testDirForFile :: TestTree
testDirForFile = testCase "test when a directory is passed instead of a file" $ do
   -- Run the program with known input data
   (output, procH) <- Util.getBinaryOutput
      [ "--parent-dir=" ++ parentDir, Util.resourcesPath ]
   waitForProcess procH

   -- Test output to stdout
   assertBool "dir as file to change: correct output"
      (output =~ "" :: Bool)


testLinkFilenameDate :: TestTree
testLinkFilenameDate = testCase "test to ensure the date can be acquired from the file name" $ do
   -- Make a dummy copy of the source file. This test will be modifying
   -- it, if successful.
   let newOldPath = Util.resourcesPath </> "copy-of-foobar-2021-10-04-17-29-49-942.jpg"
   copyFile (Util.resourcesPath </> "foobar-2021-10-04-17-29-49-942.jpg") newOldPath
   let newLinkPathDate' = parentDir </> "2021/2021-10-04/20211004-172949.jpg"

   -- Run the program with known input data
   (output, procH) <- Util.getBinaryOutput
      [ "--parent-dir=" ++ parentDir, newOldPath ]
   waitForProcess procH

   -- Check that the correct output path exists
   existsNew <- fileExist newLinkPathDate'
   assertBool "filename date: existance of new link" existsNew

   -- Check that old path still exists
   existsOld <- fileExist newOldPath
   assertBool "filename date: existance of old link" existsOld

   -- Remove files and dirs that were created
   removeFile newOldPath
   removeDirectoryRecursive parentDir

   -- WARNING We are NOT checking for the new EXIF tags in the files!!

   -- Test output to stdout
   assertBool "filename date: correct output"
      (output =~ newLinkPathDate' :: Bool)