{-# LANGUAGE MultiWayIf #-} module Main (main) where import System.FilePath ( (), (<.>), (-<.>) , takeBaseName, replaceExtension , takeDirectory, splitDirectories, joinPath ) import System.Directory (renameFile) import Test.Tasty (defaultMain, TestTree, testGroup) import Test.Tasty.Golden (findByExtension) import Test.Tasty.Golden (goldenVsFile, goldenVsString) import Hpack (Verbose(..), Options(..), hpack, defaultOptions, setDecode) import Hpack.Config (DecodeOptions(..)) import Hpack.Dhall (fileToJson, showDhall, showJson, showYaml) import Data.ByteString.Lazy.UTF8 (fromString) main :: IO () main = defaultMain =<< goldenTests goldenTests :: IO TestTree goldenTests = do ks <- findByExtension [".dhall"] "test/golden/test-files/key" rs <- findByExtension [".dhall"] "test/golden/test-files/real-world" g1 <- goldenTestSet "archetypes" ks g2 <- goldenTestSet "real-world examples" rs return $ testGroup "golden tests" [g1 , g2] goldenTestSet :: String -> [FilePath] -> IO TestTree goldenTestSet title dhallFiles = do return $ testGroup title [ testGroup ".dhall to .cabal" [ goldenVsFile (testName dhallFile) (cabalFile <.> ".golden") cabalFile (writeDhallCabal dhallFile) | dhallFile <- dhallFiles , let cabalFile = cabalFilePath dhallFile ] , testGroup ".dhall to dhall" [ goldenVsString (testName dhallFile) (dhallFile <.> ".golden") (fmap fromString . showDhall $ dhallFile) | dhallFile <- dhallFiles ] , testGroup ".dhall to json" [ goldenVsFile (testName dhallFile) (dhallFile -<.> ".json.golden") jsonFile (writeJson dhallFile jsonFile) | dhallFile <- dhallFiles , let jsonFile = dhallFile -<.> ".json" ] , testGroup ".dhall to yaml" [ goldenVsFile (testName dhallFile) (dhallFile -<.> ".yaml.golden") yamlFile (writeYaml dhallFile yamlFile) | dhallFile <- dhallFiles , let yamlFile = dhallFile -<.> ".yaml" ] , testGroup ".yaml to .cabal" [ goldenVsFile (testName dhallFile) (cabalFile <.> ".golden") cabalFile (writeYamlCabal yamlFile cabalFile yamlCabalFile) | dhallFile <- dhallFiles , let yamlFile = dhallFile -<.> ".yaml" , let cabalFile = cabalFilePath dhallFile , let yamlCabalFile = yamlFile <.> ".cabal" ] ] testName :: FilePath -> FilePath testName p = if | fName == dName -> fName | fName == "package" -> dName | dName == "key" -> fName | dName == "real-world" -> fName | otherwise -> dName fName where dName = joinPath . take 1 . reverse . splitDirectories . takeDirectory $ p fName = takeBaseName p writeDhallCabal :: FilePath -> IO () writeDhallCabal dhallFile = hpack NoVerbose (setDecode fileToJson options) where d = optionsDecodeOptions defaultOptions d' = d {decodeOptionsTarget = dhallFile} options = defaultOptions {optionsDecodeOptions = d'} writeYamlCabal :: FilePath -> FilePath -> FilePath -> IO () writeYamlCabal yamlFile cabalFile yamlCabalFile = do renameFile cabalFile tmp hpack NoVerbose options renameFile cabalFile yamlCabalFile renameFile tmp cabalFile where tmp = cabalFile <.> ".TMP" d = optionsDecodeOptions defaultOptions d' = d {decodeOptionsTarget = yamlFile} options = defaultOptions { optionsDecodeOptions = d' } writeJson :: FilePath -> FilePath -> IO () writeJson dhallFile jsonFile = do s <- showJson Nothing dhallFile writeFile jsonFile s writeYaml :: FilePath -> FilePath -> IO () writeYaml dhallFile yamlFile = do s <- showYaml Nothing dhallFile writeFile yamlFile s cabalFilePath :: FilePath -> FilePath cabalFilePath p | takeBaseName p == "package" = case reverse . splitDirectories $ ds of d : ds' -> joinPath (reverse ds') d d <.> ".cabal" _ -> replaceExtension p ".cabal" | otherwise = replaceExtension p ".cabal" where ds = takeDirectory p