diff --git a/confer.cabal b/confer.cabal index 682d36a..5c63169 100644 --- a/confer.cabal +++ b/confer.cabal @@ -16,7 +16,7 @@ extra-doc-files: CHANGELOG.md doc/*.md README.md - doc/confer_example.lua + examples/confer.lua data-files: runtime/lua/confer.lua tested-with: GHC ==9.10.1 @@ -94,6 +94,7 @@ library , selective , text , text-display + , text-builder-linear , validation-selective , vector @@ -142,4 +143,5 @@ test-suite confer-test , tasty-coverage , tasty-hunit , tasty-test-reporter + , vector , temporary diff --git a/doc/confer_example.lua b/examples/confer.lua similarity index 100% rename from doc/confer_example.lua rename to examples/confer.lua diff --git a/src/Confer/Config/Types.hs b/src/Confer/Config/Types.hs index 04cd863..d812298 100644 --- a/src/Confer/Config/Types.hs +++ b/src/Confer/Config/Types.hs @@ -10,8 +10,9 @@ module Confer.Config.Types import Data.Maybe import Data.Text (Text) import Data.Text.Display -import Data.Text.Internal.Builder qualified as Builder +import Data.Text.Builder.Linear qualified as Builder import Data.Vector (Vector) +import Data.String import System.OsPath (OsPath) import System.OsPath qualified as OsPath @@ -28,9 +29,9 @@ instance Display Fact where displayBuilder Fact{name, source, destination} = Builder.fromText name <> ": " - <> Builder.fromString (fromJust (OsPath.decodeUtf source)) + <> fromString (fromJust (OsPath.decodeUtf source)) <> " ~> " - <> Builder.fromString (fromJust (OsPath.decodeUtf destination)) + <> fromString (fromJust (OsPath.decodeUtf destination)) data Deployment = Deployment { hostname :: Maybe Text diff --git a/test/Confer/EvaluatorTest.hs b/test/Confer/EvaluatorTest.hs index 4c014f0..eefa2d0 100644 --- a/test/Confer/EvaluatorTest.hs +++ b/test/Confer/EvaluatorTest.hs @@ -1 +1,37 @@ +{-# LANGUAGE QuasiQuotes #-} module Confer.EvaluatorTest where + +import Data.Function +import Control.Monad +import Data.Vector qualified as Vector +import Data.List.NonEmpty qualified as NE +import Effectful +import Effectful.Error.Static (Error) +import Effectful.Error.Static qualified as Error +import Effectful.FileSystem (FileSystem) +import Effectful.FileSystem qualified as FileSystem +import System.FilePath qualified as FilePath +import System.IO.Temp qualified as Temporary +import System.OsPath +import System.OsPath qualified as OsPath +import Test.Tasty (TestTree) +import Effectful.FileSystem +import Test.Tasty.HUnit () + +import Confer.Config.Evaluator +import Utils + +spec :: TestEff TestTree +spec = + testThese + "Evaluator Checks" + [ testThis "Empty configuration" testEmptyConfigurationoError + ] + +testEmptyConfigurationoError :: TestEff () +testEmptyConfigurationoError = do + Temporary.withSystemTempDirectory "empty-config.ext" $ \directory -> do + copyFile "./test/fixtures/empty-config.lua" (directory <> "/empty-config.lua") + filepath <- liftIO $ encodeUtf $ directory <> "/empty-config.lua" + result <- assertRight =<< loadConfiguration False filepath + assertEqual result Vector.empty diff --git a/test/Main.hs b/test/Main.hs index 5a3b308..75c3383 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -7,6 +7,7 @@ import Test.Tasty.HUnit import Test.Tasty.Runners.Reporter qualified as Reporter import Confer.CLI.Cmd.CheckTest qualified as CheckTest +import Confer.EvaluatorTest qualified as EvaluatorTest import Utils (TestEff) import Utils qualified @@ -23,4 +24,5 @@ main = do specs :: List (TestEff TestTree) specs = [ CheckTest.spec + , EvaluatorTest.spec ] diff --git a/test/Utils.hs b/test/Utils.hs index d5bdfbc..4d6e49a 100644 --- a/test/Utils.hs +++ b/test/Utils.hs @@ -49,7 +49,7 @@ assertIsNotSymlink (Right _) = assertFailure "Did not return Left" assertIsNotSymlink (Left (IsNotSymlink{})) = pure () assertIsNotSymlink (Left e) = assertFailure $ "Returned: " <> show e -assertRight :: HasCallStack => Either a () -> TestEff () +assertRight :: HasCallStack => Either a b -> TestEff b assertRight (Left _a) = liftIO $ Test.assertFailure "Test return Left instead of Right" assertRight (Right b) = pure b @@ -67,3 +67,6 @@ testThese groupName tests = fmap (Test.testGroup groupName) newTests assertBool :: Bool -> TestEff () assertBool boolean = liftIO $ Test.assertBool "" boolean + +assertEqual :: (Eq a, Show a) => a -> a -> TestEff () +assertEqual actual expected = liftIO $ Test.assertEqual "" actual expected diff --git a/test/fixtures/empty-config.lua b/test/fixtures/empty-config.lua new file mode 100644 index 0000000..a564707 --- /dev/null +++ b/test/fixtures/empty-config.lua @@ -0,0 +1 @@ +return {}