ogmarkup-5.0: test/ParserSpec.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies      #-}

module ParserSpec where

import           Data.Either
import           Data.Void                    (Void)
import           Test.Hspec
import           Test.Hspec.Megaparsec
import           Text.Megaparsec

import qualified Text.Ogmarkup.Private.Ast    as Ast
import qualified Text.Ogmarkup.Private.Parser as Parser

parse' :: (Show b, Eq b)
      => Parser.OgmarkupParser String b
      -> String
      -> String
      -> Either (ParseError Char Void) b
parse' = Parser.parse

spec :: Spec
spec = do
    describe "atom" $ do
      it "should not parse an empty string" $ parse' Parser.atom "" `shouldFailOn` ""

      it "should parse one word" $ parse' Parser.atom "" hiStr `shouldParse` hiAtom

      it "should parse one punctuation mark" $
        parse' Parser.atom "" exclamationStr `shouldParse` exclamationAtom

      it "should parse exotic punctuation marks" $
        parse' Parser.atom "" "??" `shouldParse` Ast.Punctuation Ast.Irony

    describe "format" $ do
      it "should parse one quote" $
        parse' Parser.format "" quoteStr `shouldParse` quoteFormat

      it "should support french quotes" $
        parse' Parser.format "" frenchQuoteStr `shouldParse` frenchQuoteFormat

      it "should fail if the quote is ill-formed (no closing quote)" $
        parse' Parser.format "" `shouldFailOn` illQuoteStr

      it "should parse nested formats" $
        parse' Parser.format "" nestedFormatsStr `shouldParse` nestedFormatsFormat

      it "should fail with nested same format" $ do
        parse' Parser.format "" `shouldFailOn` nestedEmphStr
        parse' Parser.format "" `shouldFailOn` nestedStrongEmphStr

    describe "reply" $
      it "should accept spaces at the beginning of dialogs" $ do
        parse' (Parser.reply '[' ']') "" dialogStartingWithSpaceStr `shouldParse` dialogStartingWithSpaceReply
        parse' (Parser.reply '[' ']') "" clauseStartingWithSpaceStr `shouldParse` clauseStartingWithSpaceReply

    describe "section" $ do
      it "should parse aside with class" $
        parse' Parser.section "" asideWithClassStr `shouldParse` asideWithClassAst

      it "should parse aside without class" $
        parse' Parser.section "" asideWithoutClassStr `shouldParse` asideWithoutClassAst

    describe "ill-formed paragraphs" $ do
      it "ill-formed components should be accepted as-is" $ do
        parse' Parser.component "" illQuoteStr  `shouldParse` Ast.IllFormed illQuoteStr
        parse' Parser.component "" nestedEmphStr  `shouldParse` Ast.IllFormed nestedEmphStr
        parse' Parser.component "" nestedStrongEmphStr  `shouldParse` Ast.IllFormed nestedStrongEmphStr
      it "an ill-formed paragraph should not prevent parsing correctly the others" $
        parse' Parser.story "" secondParagraphIllFormed `shouldParse` secondParagraphIllFormedPartialCompilation

    describe "document" $
      it "should try its best to compile an ill-formed document" $
        parse' Parser.document "" (storyStr ++ "\n\n" ++ asideIllFormed) `shouldParse`
           [ storyAst
           , Ast.Failing "_______letter______"
           , Ast.Aside (Just "letter") [ [ Ast.Teller [ Ast.Raw [ Ast.Word "Test"
                                                                , Ast.Punctuation Ast.Point
                                                                ]
                                                      ]
                                         ]
                                       ]
           ]

hiStr = "hi"
hiAtom = Ast.Word "hi"

exclamationStr = "!"
exclamationAtom = Ast.Punctuation Ast.Exclamation

quoteStr = "\"hi everyone.\""
quoteFormat = Ast.Quote [Ast.Raw [hiAtom, Ast.Word "everyone", Ast.Punctuation Ast.Point]]

frenchQuoteStr = "« hi everyone. »"
frenchQuoteFormat = Ast.Quote [Ast.Raw [hiAtom, Ast.Word "everyone", Ast.Punctuation Ast.Point]]

illQuoteStr = "\"hi"

nestedFormatsStr    = "*hi.. \"everyone\".*"
nestedFormatsFormat = Ast.Emph [ Ast.Raw [ Ast.Word "hi"
                                         , Ast.Punctuation Ast.SuspensionPoints
                                         ]
                               , Ast.Quote [ Ast.Raw [ Ast.Word "everyone" ] ]
                               , Ast.Raw [ Ast.Punctuation Ast.Point ]
                               ]

nestedEmphStr = "*hi \"*miss*\"*"
nestedStrongEmphStr = "+hi \"+miss+\"+"

dialogStartingWithSpaceStr    = "[ hi]"
dialogStartingWithSpaceReply  = Ast.Simple [ Ast.Raw [hiAtom] ]

clauseStartingWithSpaceStr    = "[hi| he said|]"
clauseStartingWithSpaceReply  = Ast.WithSay [  Ast.Raw [hiAtom] ]
                                            [  Ast.Raw [ Ast.Word "he"
                                                       , Ast.Word "said"
                                                       ]
                                            ]
                                            [ ]

secondParagraphIllFormed = hiStr ++ "\n\n" ++ illQuoteStr ++ "\n\n" ++ hiStr
secondParagraphIllFormedPartialCompilation =
    Ast.Story [ [ Ast.Teller [ Ast.Raw [ hiAtom ] ] ]
              , [ Ast.IllFormed illQuoteStr ]
              , [ Ast.Teller [ Ast.Raw [ hiAtom ] ] ]
              ]

storyStr = hiStr
storyAst = Ast.Story [ [ Ast.Teller [ Ast.Raw [ hiAtom ] ] ] ]

asideWithClassStr = "____class_____\n\n" ++ hiStr ++ "\n_______"
asideWithClassAst = Ast.Aside (Just "class") [ [ Ast.Teller [ Ast.Raw [ hiAtom ] ] ] ]

asideWithoutClassStr = "_________\n\n" ++ hiStr ++ "\n_______"
asideWithoutClassAst = Ast.Aside Nothing [ [ Ast.Teller [ Ast.Raw [ hiAtom ] ] ] ]

asideIllFormed = "_______letter______\n\n_______letter______\n\nTest.\n\n____________"