scfg-1.0.0: test/Test.hs

{-# LANGUAGE OverloadedStrings #-}

module Main (main) where

import Data.Either (isLeft)
import Data.Scfg
import System.IO (hClose, hPutStr)
import System.IO.Temp (withSystemTempFile)
import Test.Hspec

main :: IO ()
main = hspec $ do
    describe "parse" $ do
        describe "directives" $ do
            it "parses a bare directive with no params" $
                parse "foo\n" `shouldBe` Right [Directive "foo" [] []]

            it "parses a directive with params" $
                parse "foo bar baz\n" `shouldBe` Right [Directive "foo" ["bar", "baz"] []]

            it "parses multiple directives" $
                parse "foo\nbar\n" `shouldBe` Right [Directive "foo" [] [], Directive "bar" [] []]

            it "parses an empty config" $
                parse "" `shouldBe` Right []

            it "accepts missing final newline" $
                parse "foo" `shouldBe` Right [Directive "foo" [] []]

            it "ignores blank lines" $
                parse "foo\n\nbar\n" `shouldBe` Right [Directive "foo" [] [], Directive "bar" [] []]

        describe "blocks" $ do
            it "parses a directive with a block" $
                parse "foo {\nbar\n}\n" `shouldBe` Right [Directive "foo" [] [Directive "bar" [] []]]

            it "allows whitespace after opening brace" $
                parse "foo {  \nbar\n}\n" `shouldBe` Right [Directive "foo" [] [Directive "bar" [] []]]

        describe "trailing whitespace" $ do
            it "allows trailing whitespace after params" $
                parse "foo bar \n" `shouldBe` Right [Directive "foo" ["bar"] []]

            it "allows trailing whitespace with no params" $
                parse "foo \n" `shouldBe` Right [Directive "foo" [] []]

        describe "comments" $ do
            it "ignores comments" $
                parse "# a comment\nfoo\n" `shouldBe` Right [Directive "foo" [] []]

            it "rejects CTL characters in comments" $
                parse "# bad\1&comment\nfoo\n" `shouldSatisfy` isLeft

    describe "ParseError" $ do
        it "includes line and column of the error" $ do
            let result = parse "foo\nbar 'unterminated\n"
            case result of
                Right _ -> expectationFailure "expected parse error"
                Left err -> do
                    errorLine err `shouldBe` 2
                    errorColumn err `shouldBe` 5

        describe "atoms" $ do
            it "rejects single quote in atom" $
                parse "foo bar'baz\n" `shouldSatisfy` isLeft

            it "rejects CTL characters" $
                parse "foo bar\1&baz\n" `shouldSatisfy` isLeft

            it "allows C1 control characters" $
                parse "foo bar\x80baz\n" `shouldBe` Right [Directive "foo" ["bar\x80baz"] []]

        describe "double-quoted words" $ do
            it "parses double-quoted params" $
                parse "foo \"hello world\"\n" `shouldBe` Right [Directive "foo" ["hello world"] []]

            it "rejects CTL characters" $
                parse "foo \"bar\1&baz\"\n" `shouldSatisfy` isLeft

            it "allows tab" $
                parse "foo \"bar\tbaz\"\n" `shouldBe` Right [Directive "foo" ["bar\tbaz"] []]

            it "allows C1 control characters" $
                parse "foo \"bar\x80baz\"\n" `shouldBe` Right [Directive "foo" ["bar\x80baz"] []]

        describe "single-quoted words" $ do
            it "parses single-quoted params" $
                parse "foo 'hello world'\n" `shouldBe` Right [Directive "foo" ["hello world"] []]

            it "rejects newline" $
                parse "foo 'bar\nbaz'\n" `shouldSatisfy` isLeft

            it "allows tab" $
                parse "foo 'bar\tbaz'\n" `shouldBe` Right [Directive "foo" ["bar\tbaz"] []]

            it "allows C1 control characters" $
                parse "foo 'bar\x80baz'\n" `shouldBe` Right [Directive "foo" ["bar\x80baz"] []]

        describe "escape sequences" $ do
            it "parses escape sequences in atoms" $
                parse "foo bar\\=baz\n" `shouldBe` Right [Directive "foo" ["bar=baz"] []]

            it "parses escape sequences in double-quoted words" $
                parse "foo \"bar\\\"baz\"\n" `shouldBe` Right [Directive "foo" ["bar\"baz"] []]

            it "rejects CTL character" $
                parse "foo bar\\\1&baz\n" `shouldSatisfy` isLeft

            it "allows tab" $
                parse "foo bar\\\tbaz\n" `shouldBe` Right [Directive "foo" ["bar\tbaz"] []]

        describe "parseFile" $ do
            it "parses a file" $
                withSystemTempFile "scfg" $ \path h -> do
                    hPutStr h "foo bar\n"
                    hClose h
                    result <- parseFile path
                    result `shouldBe` Right [Directive "foo" ["bar"] []]

            it "returns Left on parse error" $
                withSystemTempFile "scfg" $ \path h -> do
                    hPutStr h "foo 'unterminated\n"
                    hClose h
                    result <- parseFile path
                    result `shouldSatisfy` isLeft

    describe "format" $ do
        it "formats a bare directive" $
            format [Directive "foo" [] []] `shouldBe` "\"foo\"\n"

        it "formats a directive with params" $
            format [Directive "foo" ["bar", "baz"] []] `shouldBe` "\"foo\" \"bar\" \"baz\"\n"

        it "formats a directive with a block" $
            format [Directive "foo" [] [Directive "bar" [] []]]
                `shouldBe` "\"foo\" {\n\t\"bar\"\n}\n"

        it "formats nested blocks with correct indentation" $
            format [Directive "foo" [] [Directive "bar" [] [Directive "baz" [] []]]]
                `shouldBe` "\"foo\" {\n\t\"bar\" {\n\t\t\"baz\"\n\t}\n}\n"

        it "escapes double quotes in names and params" $
            format [Directive "fo\"o" ["ba\"r"] []] `shouldBe` "\"fo\\\"o\" \"ba\\\"r\"\n"

    describe "integration" $ do
        it "parses the spec example" $
            parse
                "train \"Shinkansen\" {\n\
                \  model \"E5\" {\n\
                \    max-speed 320km/h\n\
                \    weight 453.5t\n\
                \  }\n\
                \}\n"
                `shouldBe` Right
                    [ Directive
                        "train"
                        ["Shinkansen"]
                        [ Directive
                            "model"
                            ["E5"]
                            [ Directive "max-speed" ["320km/h"] []
                            , Directive "weight" ["453.5t"] []
                            ]
                        ]
                    ]