content: -- This template expects CPP definitions for:
  --     PLATFORM_NAME = Posix | Windows
  
  {-# LANGUAGE RankNTypes #-}
  
  -- | Test functions that are common to Posix and Windows
  module Common.PLATFORM_NAME
    (spec
    ,parseFails
    ,parseSucceeds
    ,parserTest
    ) where
  
  import Control.Applicative ((<|>))
  import Control.Monad (forM_, void)
  import Control.Monad.Catch (MonadThrow)
  import Data.List.NonEmpty (NonEmpty (..))
  import qualified Data.List.NonEmpty as NonEmpty
  import Data.Maybe (fromJust, isNothing)
  import qualified System.FilePath.PLATFORM_NAME as FilePath
  import Test.Hspec
  
  import Path.Internal.PLATFORM_NAME
  import Path.PLATFORM_NAME
  
  currentDir :: Path Rel Dir
  currentDir = (fromJust . parseRelDir) "."
  
  drives :: NonEmpty (Path Abs Dir)
  drives = (fromJust . traverse parseAbsDir) drives_
  
  relDir :: Path Rel Dir
  relDir = (fromJust . parseRelDir) "directory"
  
  relFile :: Path Rel File
  relFile = (fromJust . parseRelFile) "file"
  
  spec :: Spec
  spec = do
    describe "Operations: (</>)" operationAppend
    describe "Operations: dirname" operationDirname
    describe "Operations: filename" operationFilename
    describe "Operations: parent" operationParent
    describe "Operations: toFilePath" operationToFilePath
    describe "Operations: isProperPrefixOf" operationIsProperPrefixOf
    describe "Operations: stripProperPrefix" operationStripProperPrefix
    describe "Operations: isDrive" operationIsDrive
    describe "Operations: splitDrive" operationSplitDrive
    describe "Operations: extensions" extensionOperations
  
  -- | The 'dirname' operation.
  operationDirname :: Spec
  operationDirname = do
    it
      "dirname (relDir </> relDir) == dirname relDir"
      (dirname (relDir </> relDir) == dirname relDir)
    it
      "dirname \".\" == dirname \".\""
      (dirname currentDir == currentDir)
  
    forDrives $ \drive -> do
      let absDir = drive </> relDir
      it
        "dirname (absDir </> relDir) == dirname relDir"
        (dirname (absDir </> relDir) == dirname relDir)
      it
        "dirname of a drive must be a Rel path"
        (isNothing (parseAbsDir . toFilePath . dirname $ drive))
  
  -- | The 'filename' operation.
  operationFilename :: Spec
  operationFilename = do
    it
      "filename (relDir </> relFile) == filename relFile"
      (filename (relDir </> relFile) == filename relFile)
  
    forDrives $ \drive -> do
      let absDir = drive </> relDir
      it
        "filename (absDir </> relFile) == filename relFile"
        (filename (absDir </> relFile) == filename relFile)
  
  -- | The 'parent' operation.
  operationParent :: Spec
  operationParent = do
    it
      "parent relDir == \".\""
      (parent relDir == currentDir)
    it
      "parent \".\" == \".\""
      (parent currentDir == currentDir)
  
    forDrives $ \drive -> do
      let absDir = drive </> relDir
      it
        "parent (absDir </> relDir) == absDir"
        (parent (absDir </> relDir) == absDir)
      it
        "parent absDir == drive"
        (parent absDir == drive)
      it
        "parent drive == drive"
        (parent drive == drive)
  
  -- | The 'splitDrive' operation.
  operationSplitDrive :: Spec
  operationSplitDrive = forDrives $ \drive -> do
    let absDir = drive </> relDir
        absFile = drive </> relFile
    it
      "splitDrive absDir == (drive, Just relDir)"
      (splitDrive absDir == (drive, Just relDir))
    it
      "splitDrive absFile == (drive, Just relFile)"
      (splitDrive absFile == (drive, Just relFile))
    it
      "splitDrive drive == (drive, Nothing)"
      (splitDrive drive == (drive, Nothing))
  
  -- | The 'isDrive' operation.
  operationIsDrive :: Spec
  operationIsDrive = forDrives $ \drive -> do
    let absDir = drive </> relDir
    it
      "isDrive drive"
      (isDrive drive)
    it
      "not (isDrive absDir)"
      (not (isDrive absDir))
  
  -- | The 'isProperPrefixOf' operation.
  operationIsProperPrefixOf :: Spec
  operationIsProperPrefixOf = do
    it
      "isProperPrefixOf relDir (relDir </> relDir)"
      (isProperPrefixOf relDir (relDir </> relDir))
  
    it
      "not (relDir `isProperPrefixOf` relDir)"
      (not (isProperPrefixOf relDir relDir))
  
    forDrives $ \drive -> do
      let absDir = drive </> relDir
      it
        "isProperPrefixOf absDir (absDir </> relDir)"
        (isProperPrefixOf absDir (absDir </> relDir))
  
      it
        "not (drive `isProperPrefixOf` drive)"
        (not (isProperPrefixOf drive drive))
  
  -- | The 'stripProperPrefix' operation.
  operationStripProperPrefix :: Spec
  operationStripProperPrefix = do
    it
      "stripProperPrefix relDir (relDir </> relDir) == relDir"
      (stripProperPrefix relDir (relDir </> relDir) == Just relDir)
  
    forDrives $ \drive -> do
      let absDir = drive </> relDir
      it
        "stripProperPrefix absDir (absDir </> relDir) == relDir"
        (stripProperPrefix absDir (absDir </> relDir) == Just relDir)
      it
        "stripProperPrefix absDir absDir == Nothing"
        (isNothing (stripProperPrefix absDir absDir))
  
  -- | The '</>' operation.
  operationAppend :: Spec
  operationAppend = do
    let Path relDir' = relDir
        Path relFile' = relFile
    it
      "RelDir + RelDir == RelDir"
       (relDir </> relDir == Path (relDir' FilePath.</> relDir'))
    it
      "\".\" + \".\" == \".\""
      (currentDir </> currentDir == currentDir)
    it
      "\".\" + relDir == relDir"
       (currentDir </> relDir == relDir)
    it
      "relDir + \".\" == x"
      (relDir </> currentDir == relDir)
    it
      "RelDir + RelFile == RelFile"
      (relDir </> relFile == Path (relDir' FilePath.</> relFile'))
  
    forDrives $ \drive -> do
      let absDir@(Path absDir') = drive </> relDir
      it
        "AbsDir + RelDir == AbsDir"
        (absDir </> relDir == Path (absDir' FilePath.</> relDir'))
      it
        "AbsDir + RelFile == AbsFile"
        (absDir </> relFile == Path (absDir' FilePath.</> relFile'))
  
  -- | The 'toFilePath operation.
  operationToFilePath :: Spec
  operationToFilePath = do
    let expected = "." ++ [FilePath.pathSeparator]
    it
      ("toFilePath \".\" == " ++ show expected)
      (toFilePath currentDir == expected)
    it
      ("show \".\" == " ++ (show . show) expected)
      (show currentDir == show expected)
  
  -- | Testing operations related to extensions.
  extensionOperations :: Spec
  extensionOperations = do
      describe "Only filenames and extensions" $
        forM_ filenames $ \file -> do
          forM_ validExtensions $ \ext -> do
            runTests parseRelFile file ext
  
      describe "Relative dir paths" $
        forM_ dirnames $ \dir -> do
          forM_ filenames $ \file -> do
            forM_ validExtensions $ \ext -> do
                let filepath = dir ++ [FilePath.pathSeparator] ++ file
                runTests parseRelFile filepath ext
  
      describe "Absolute dir paths" $
        forM_ drives_ $ \drive -> do
          forM_ dirnames $ \dir -> do
            forM_ filenames $ \file -> do
              forM_ validExtensions $ \ext -> do
                let filepath = drive ++ dir ++ [FilePath.pathSeparator] ++ file
                runTests parseAbsFile filepath ext
  
      -- Invalid extensions
      forM_ invalidExtensions $ \ext -> do
        it ("throws InvalidExtension when extension is " ++ show ext) $
           addExtension ext (Path "name")
           `shouldThrow` (== InvalidExtension ext)
  
      where
  
      runTests :: (forall m . MonadThrow m => FilePath -> m (Path b File))
               -> FilePath
               -> FilePath
               -> Spec
      runTests parse file ext = do
          let maybePathFile = parse file
          let maybePathFileWithExt = parse (file ++ ext)
          case (maybePathFile, maybePathFileWithExt) of
              (Just pathFile, Just pathFileWithExt) -> validExtensionsSpec ext pathFile pathFileWithExt
              _ -> it ("Files " ++ show file ++ " and/or " ++ show (file ++ ext) ++ " should parse successfully.") $
                       expectationFailure $
                           show file ++ " parsed to " ++ show maybePathFile ++ ", "
                           ++ show (file ++ ext) ++ " parsed to " ++ show maybePathFileWithExt
  
      filenames :: [FilePath]
      filenames =
          [ "name"
          , "name."
          , "name.."
          , ".name"
          , "..name"
          , "name.name"
          , "name..name"
          , "..."
          ]
  
      dirnames :: [FilePath]
      dirnames = filenames ++ ["."]
  
      invalidExtensions :: [String]
      invalidExtensions =
          [ ""
          , "."
          , "x"
          , ".."
          , "..."
          , "xy"
          , "foo"
          , "foo."
          , "foo.."
          , "..foo"
          , "...foo"
          , ".foo.bar"
          , ".foo" ++ [FilePath.pathSeparator] ++ "bar"
          ]
  
      validExtensions :: [String]
      validExtensions =
          [ ".foo"
          , ".foo."
          , ".foo.."
          ]
  
  validExtensionsSpec :: String -> Path b File -> Path b File -> Spec
  validExtensionsSpec ext file fext = do
      let f = show $ toFilePath file
      let fx = show $ toFilePath fext
  
      it ("addExtension " ++ show ext ++ " " ++ f ++ " == " ++ fx) $
          addExtension ext file `shouldReturn` fext
  
      it ("fileExtension " ++ fx ++ " == " ++ ext) $
          fileExtension fext `shouldReturn` ext
  
      it ("replaceExtension " ++ show ext ++ " " ++ fx ++ " == " ++ fx) $
          replaceExtension ext fext `shouldReturn` fext
  
  forDrives :: (Path Abs Dir -> Spec) -> Spec
  forDrives f = case drives of
    (drive :| []) -> f drive
    _ -> forM_ drives $ \drive ->
      describe ("Drive " ++ show drive) (f drive)
  
  parseFails :: FilePath -> Spec
  parseFails x = it (show x ++ " should be rejected")
    (isNothing (void (parseAbsDir x) <|>
                void (parseRelDir x) <|>
                void (parseAbsFile x) <|>
                void (parseRelFile x)))
  
  parseSucceeds :: FilePath -> Path Rel Dir -> Spec
  parseSucceeds x with = parserTest parseRelDir x (Just with)
  
  -- | Parser test.
  parserTest :: (Show a, Show b, Eq b)
             => (a -> Maybe b) -> a -> Maybe b -> Spec
  parserTest parser input expected =
    it (message1 ++ "Parsing " ++ show input ++ " " ++ message2)
       (parser input `shouldBe` expected)
    where message1
            | isNothing expected =  "Failing: "
            | otherwise = "Succeeding: "
  
          message2 = case expected of
            Nothing -> "should fail."
            Just x -> "should succeed with: " ++ show x
  