content: {-# LANGUAGE CPP               #-}
  {-# LANGUAGE OverloadedLists   #-}
  {-# LANGUAGE OverloadedStrings #-}
  
  module Dhall.Test.DirectoryTree (tests) where
  
  import Control.Monad
  import Data.Either            (partitionEithers)
  import Data.Either.Validation
  import Dhall.DirectoryTree
  import Lens.Micro             (set)
  import System.FilePath        ((</>))
  import Test.Tasty
  import Test.Tasty.HUnit
  
  import qualified Data.List
  import qualified Data.Text.IO
  import qualified Dhall
  import qualified Dhall.Core
  import qualified System.Directory         as Directory
  import qualified System.FilePath          as FilePath
  import qualified System.PosixCompat.Files as Files
  
  tests :: TestTree
  tests = testGroup "to-directory-tree"
      [ testGroup "fixpointed"
          [ fixpointedType
          , fixpointedEmpty
          , fixpointedSimple
          , fixpointedAllowPathSeparators
  #ifndef mingw32_HOST_OS
          , fixpointedPermissions
          , fixpointedUserGroup
  #endif
          ]
      ]
  
  fixpointedType :: TestTree
  fixpointedType = testCase "Type is as expected" $ do
      let file = "./tests/to-directory-tree/type.dhall"
      ref <- Dhall.inputExpr file
      expected' <- case directoryTreeType of
          Failure e -> assertFailure $ show e
          Success expr -> return expr
      assertBool "Type mismatch" $ expected' `Dhall.Core.judgmentallyEqual` ref
  
  fixpointedEmpty :: TestTree
  fixpointedEmpty = testCase "empty" $ do
      let outDir = "./tests/to-directory-tree/fixpoint-empty.out"
          path = "./tests/to-directory-tree/fixpoint-empty.dhall"
      entries <- runDirectoryTree False outDir path
      entries @?= [Directory outDir]
  
  fixpointedSimple :: TestTree
  fixpointedSimple = testCase "simple" $ do
      let outDir = "./tests/to-directory-tree/fixpoint-simple.out"
          path = "./tests/to-directory-tree/fixpoint-simple.dhall"
      entries <- runDirectoryTree False outDir path
      entries @?= Data.List.sort
          [ Directory outDir
          , File $ outDir </> "file"
          , Directory $ outDir </> "directory"
          ]
  
  fixpointedAllowPathSeparators :: TestTree
  fixpointedAllowPathSeparators = testCase "allow-path-separators" $ do
      let outDir = "./tests/to-directory-tree/fixpoint-allow-path-separators.out"
          path = "./tests/to-directory-tree/fixpoint-allow-path-separators.dhall"
      entries <- runDirectoryTree True outDir path
      entries @?= Data.List.sort
          [ Directory outDir
          , Directory $ outDir </> "non-existent-1"
          , File $ outDir </> "non-existent-1" </> "file"
          , Directory $ outDir </> "non-existent-2"
          , Directory $ outDir </> "non-existent-2" </> "directory"
          ]
  
  {-
  This test is disabled on Windows as it fails due to limitations of the :
      expected: 448
      but got: 438
  -}
  fixpointedPermissions :: TestTree
  fixpointedPermissions = testCase "permissions" $ do
      let outDir = "./tests/to-directory-tree/fixpoint-permissions.out"
          path = "./tests/to-directory-tree/fixpoint-permissions.dhall"
      entries <- runDirectoryTree False outDir path
      entries @?=
          [ Directory outDir
          , File $ outDir </> "file"
          ]
      s <- Files.getFileStatus $ outDir </> "file"
      let mode = Files.fileMode s `Files.intersectFileModes` Files.accessModes
      prettyFileMode mode @?= prettyFileMode Files.ownerModes
  
  fixpointedUserGroup :: TestTree
  fixpointedUserGroup = testCase "user and group" $ do
      let file = "./tests/to-directory-tree/fixpoint-usergroup.dhall"
      expr <- Dhall.inputExpr file
      entries <- decodeDirectoryTree expr
      entries @?=
          [ TextFileEntry $ Entry
              { entryName = "ids"
              , entryContent = ""
              , entryUser = Just (UserId 0)
              , entryGroup = Just (GroupId 0)
              , entryMode = Nothing
              }
          , TextFileEntry $ Entry
              { entryName = "names"
              , entryContent = ""
              , entryUser = Just (UserName "user")
              , entryGroup = Just (GroupName "group")
              , entryMode = Nothing
              }
          ]
  
  runDirectoryTree :: Bool -> FilePath -> FilePath -> IO [WalkEntry]
  runDirectoryTree allowSeparators outDir path = do
      doesOutDirExist <- Directory.doesDirectoryExist outDir
      when doesOutDirExist $
          Directory.removeDirectoryRecursive outDir
      Directory.createDirectoryIfMissing True outDir
  
      text <- Data.Text.IO.readFile path
      let inputSettings
              = set Dhall.rootDirectory (FilePath.takeDirectory path)
              . set Dhall.sourceName path
              $ Dhall.defaultInputSettings
      expr <- Dhall.inputExprWithSettings inputSettings text
  
      toDirectoryTree allowSeparators outDir $ Dhall.Core.denote expr
  
      Data.List.sort <$> walkFsTree outDir
  
  data WalkEntry
      = Directory FilePath
      | File FilePath
      deriving (Eq, Ord, Show)
  
  walkFsTree :: FilePath -> IO [WalkEntry]
  walkFsTree dir = do
      entries <- Directory.listDirectory dir
      (ds, fs) <- fmap partitionEithers $ forM entries $ \path -> do
          let path' = dir </> path
          isDirectory <- Directory.doesDirectoryExist path'
          return $ if isDirectory then Left path' else Right (File path')
      entries' <- traverse walkFsTree ds
      return $ Directory dir : fs <> concat entries'
  