Package.hs

{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}

module Dhall.Test.Package where

import           Control.Exception  (Exception, displayException, finally, try)
import           Data.List.NonEmpty (NonEmpty (..))
import           Data.Void          (Void)
import           Dhall.Core
    ( Directory (..)
    , Expr (..)
    , File (..)
    , FilePrefix (..)
    , Import (..)
    , ImportHashed (..)
    , ImportMode (..)
    , ImportType (..)
    , makeRecordField
    )
import qualified Dhall.Map          as Map
import           Dhall.Package
import           Lens.Micro         (set)
import qualified System.Directory   as Directory
import           System.FilePath    ((</>))
import           Test.Tasty
import           Test.Tasty.HUnit

tests :: TestTree
tests = testGroup "Package"
    [ packagePackageFile
    , packageCustomPackageFile
    , packageSingleFile
    , packageEmptyDirectory
    , packageSingleDirectory
    , packageNested
    , packageRecursive
    , packageMissingFile
    , packageFilesDifferentDirs
    , packageIncompatibleFiles
    ]

packagePackageFile :: TestTree
packagePackageFile = testCase "package file" $ do
    let path = "./tests/package" </> "package.dhall"

    let package :: Expr Void Import
        package = RecordLit Map.empty

    (output, expr) <- getPackagePathAndContent defaultOptions ("./tests/package/package.dhall" :| [])
    assertEqual "path" path output
    assertEqual "content" package expr

packageCustomPackageFile :: TestTree
packageCustomPackageFile = testCase "custom package file" $ do
    let path = "./tests/package" </> "custom.dhall"

    let package :: Expr Void Import
        package = RecordLit $
            Map.singleton "package" $ makeRecordField $ Embed packageDhall

    let options :: Options
        options = set packageFileName "custom.dhall" defaultOptions

    (output, expr) <- getPackagePathAndContent options ("./tests/package/package.dhall" :| [])
    assertEqual "path" path output
    assertEqual "content" package expr

packageSingleFile :: TestTree
packageSingleFile = testCase "single file" $ do
    let path = "./tests/package/dir" </> "package.dhall"

    let package :: Expr Void Import
        package = RecordLit $
            Map.singleton "test" $ makeRecordField $ Embed testDhall

    (output, expr) <- getPackagePathAndContent defaultOptions ("./tests/package/dir/test.dhall" :| [])
    assertEqual "path" path output
    assertEqual "content" package expr

packageEmptyDirectory :: TestTree
packageEmptyDirectory = testCase "empty directory" $ do
    let path = "./tests/package/empty" </> "package.dhall"

    let package :: Expr Void Import
        package = RecordLit Map.empty

    (output, expr) <- getPackagePathAndContent defaultOptions ("./tests/package/empty" :| [])
    assertEqual "path" path output
    assertEqual "content" package expr

packageSingleDirectory :: TestTree
packageSingleDirectory = testCase "single directory" $ do
    let path = "./tests/package/dir" </> "package.dhall"

    let package :: Expr Void Import
        package = RecordLit $ Map.singleton "test" $
            makeRecordField $ Embed testDhall

    (output, expr) <- getPackagePathAndContent defaultOptions ("./tests/package/dir" :| [])
    assertEqual "path" path output
    assertEqual "content" package expr

packageNested :: TestTree
packageNested = testCase "nested files" $ do
    let path = "./tests/package" </> "package.dhall"

    let package :: Expr Void Import
        package = RecordLit $ Map.fromList
            [ ("dir", makeRecordField $ RecordLit $ Map.fromList
                [ ("test", makeRecordField $ Embed dirTestDhall)
                ]
              )
            , ("other", makeRecordField $ Embed otherPackageDhall)
            , ("test", makeRecordField $ Embed testDhall)
            ]

    (output, expr) <- getPackagePathAndContent defaultOptions
        ( "./tests/package/test.dhall" :|
        [ "./tests/package/dir/test.dhall"
        , "./tests/package/other/package.dhall"
        ])
    assertEqual "path" path output
    assertEqual "content" package expr

packageRecursive :: TestTree
packageRecursive = testCase "recursively create subpackages" $ removePackagesAfter $ do
    let path = "./tests/package/dir" </> "package.dhall"

    let package :: Expr Void Import
        package = RecordLit $ Map.fromList
            [ ("subdirectory1", makeRecordField $ Embed subdirectoryPackageDhall1)
            , ("subdirectory2", makeRecordField $ Embed subdirectoryPackageDhall2)
            , ("test", makeRecordField $ Embed testDhall)
            ]

    let options :: Options
        options = set packagingMode RecursiveSubpackages defaultOptions

    (output, expr) <- getPackagePathAndContent options
        ( "./tests/package/dir" :| [] )
    assertEqual "path" path output
    assertEqual "content" package expr
    where
        removePackagesAfter :: IO a -> IO a
        removePackagesAfter action = action `finally` do
            Directory.removePathForcibly "./tests/package/dir/subdirectory1/package.dhall"
            Directory.removePathForcibly "./tests/package/dir/subdirectory2/package.dhall"

packageMissingFile :: TestTree
packageMissingFile = testCase "missing file" $ do
    let action :: IO (FilePath, Expr Void Import)
        action = getPackagePathAndContent defaultOptions ("./tests/package/missing.dhall" :| [])

    assertThrow action $ \case
        InvalidPath "./tests/package/missing.dhall" -> True
        _ -> False

packageFilesDifferentDirs :: TestTree
packageFilesDifferentDirs = testCase "files from different directories" $ do
    let action :: IO (FilePath, Expr Void Import)
        action = getPackagePathAndContent defaultOptions
            ( "./tests/package/dir/test.dhall" :|
            [ "./tests/package/test/test.dhall"
            ])

    assertThrow action $ \case
        AmbiguousOutputDirectory "./tests/package/dir" "./tests/package/test" -> True
        _ -> False

packageIncompatibleFiles :: TestTree
packageIncompatibleFiles = testCase "files that are incompatible" $ do
    let action :: IO (FilePath, Expr Void Import)
        action = getPackagePathAndContent defaultOptions
            ( "./tests/package/test.dhall" :|
            [ "./tests/package/test/test.dhall"
            ])

    assertThrow action $ \case
        IncompatiblePaths xs -> xs == [ testDhall , testTestDhall ]
        _ -> False

packageDhall :: Import
packageDhall = Import
    { importHashed = ImportHashed
        { hash = Nothing
        , importType = Local Here File
            { directory = Directory []
            , file = "package.dhall"
            }
        }
    , importMode = Code
    }

testDhall :: Import
testDhall = Import
    { importHashed = ImportHashed
        { hash = Nothing
        , importType = Local Here File
            { directory = Directory []
            , file = "test.dhall"
            }
        }
    , importMode = Code
    }

dirTestDhall :: Import
dirTestDhall = Import
    { importHashed = ImportHashed
        { hash = Nothing
        , importType = Local Here $ File
            { directory = Directory {components = ["dir"]}
            , file = "test.dhall"
            }
        }
    , importMode = Code
    }

otherPackageDhall :: Import
otherPackageDhall = Import
    { importHashed = ImportHashed
        { hash = Nothing
        , importType = Local Here $ File
            { directory = Directory {components = ["other"]}
            , file = "package.dhall"
            }
        }
    , importMode = Code
    }

subdirectoryPackageDhall1 :: Import
subdirectoryPackageDhall1 = Import
    { importHashed = ImportHashed
        { hash = Nothing
        , importType = Local Here $ File
            { directory = Directory {components = ["subdirectory1"]}
            , file = "package.dhall"}
            }
        , importMode = Code
        }

subdirectoryPackageDhall2 :: Import
subdirectoryPackageDhall2 = Import
    { importHashed = ImportHashed
        { hash = Nothing
        , importType = Local Here $ File
            { directory = Directory {components = ["subdirectory2"]}
            , file = "package.dhall"}
            }
        , importMode = Code
        }

testTestDhall :: Import
testTestDhall = Import
    { importHashed = ImportHashed
        { hash = Nothing
        , importType = Local Here (File
            { directory = Directory {components = ["test"]}
            , file = "test.dhall"
            })
        }
    , importMode = Code
    }

assertThrow :: (Exception e, Show a) => IO a -> (e -> Bool) -> IO ()
assertThrow k p = do
    result <- try k
    case result of
        Left e | p e -> return ()
        Left e -> assertFailure $ "Predicate did not match: " <> displayException e
        Right result' -> assertFailure $ "Expected exception, but got: " <> show result'