gemmula-1.2.0: test/Test.hs

{-# LANGUAGE OverloadedStrings #-}

module Main (main) where

import Control.Monad
import Data.Text (Text, unlines)
import System.Exit (exitFailure)
import Test.HUnit (Test (..), failures, runTestTT, (~=?))
import Prelude hiding (unlines)

import Text.Gemini (GemDocument, GemItem (..))
import qualified Text.Gemini as G

-- | Query the test cases.
main :: IO ()
main = do
    count <-
        runTestTT . TestList $
            decoding <> encoding <> title
    when (failures count > 0) exitFailure

decoding :: [Test]
decoding =
    [ -- `GemText'
      GemText "" ~=? G.decodeLine ""
    , GemText "text" ~=? G.decodeLine "text"
    , GemText "   whitespaces" ~=? G.decodeLine "   whitespaces "
    , GemText "new lines" ~=? G.decodeLine "new\CR\LFlines"
    , -- `GemLink'
      GemText "=>" ~=? G.decodeLine "=> "
    , GemLink "link" Nothing ~=? G.decodeLine "=>link"
    , GemLink "link" (Just "description  text") ~=? G.decodeLine "=>  link    description  text"
    , GemLink "new" (Just "lines") ~=? G.decodeLine "=> new\CR\LFlines"
    , -- `GemHeading'
      GemHeading 1 "" ~=? G.decodeLine "#"
    , GemHeading 1 "title" ~=? G.decodeLine "#title"
    , GemHeading 2 "spaced" ~=? G.decodeLine "##  spaced "
    , GemHeading 3 "# oops" ~=? G.decodeLine "#### oops"
    , -- `GemList'
      GemList [""] ~=? G.decodeLine "* "
    , GemList ["item"] ~=? G.decodeLine "*  item "
    , -- `GemQuote'
      GemQuote "" ~=? G.decodeLine ">"
    , GemQuote "quote" ~=? G.decodeLine ">quote"
    , GemQuote "spaced" ~=? G.decodeLine ">  spaced   "
    , -- `GemDocument'
      document ~=? G.decode raw
    ]

encoding :: [Test]
encoding =
    [ -- `GemText'
      "" ~=? G.encodeItem (GemText "")
    , "=>" ~=? G.encodeItem (GemText "=>  ")
    , "   whitespaces" ~=? G.encodeItem (GemText "   whitespaces")
    , "new lines" ~=? G.encodeItem (GemText "new\CR\LFlines\CR\LF")
    , " => escaped" ~=? G.encodeItem (GemText "=> escaped")
    , -- `GemLink'
      "=> link" ~=? G.encodeItem (GemLink "link" Nothing)
    , "=> with%20spaces" ~=? G.encodeItem (GemLink "with spaces" Nothing)
    , "=> also%20newline like so" ~=? G.encodeItem (GemLink "also\LFnewline " (Just " like\CR\LFso "))
    , "=> link with description" ~=? G.encodeItem (GemLink "link" (Just " with description"))
    , -- `GemHeading'
      "#" ~=? G.encodeItem (GemHeading 1 "")
    , "# title" ~=? G.encodeItem (GemHeading 1 "title")
    , "## subtitle" ~=? G.encodeItem (GemHeading 2 " subtitle ")
    , "### # oops" ~=? G.encodeItem (GemHeading 3 "# oops")
    , -- `GemList'
      "* " ~=? G.encodeItem (GemList [""])
    , "* multiple\CR\LF* items" ~=? G.encodeItem (GemList [" multiple   ", "items"])
    , -- `GemQuote'
      ">" ~=? G.encodeItem (GemQuote "")
    , "> quote" ~=? G.encodeItem (GemQuote "quote")
    , "> new line" ~=? G.encodeItem (GemQuote "  new\CR\LFline ")
    , -- `GemPre'
      "```\CR\LF pre \CR\LF```" ~=? G.encodeItem (GemPre [" pre "] Nothing)
    , "``` alt text\CR\LF```" ~=? G.encodeItem (GemPre [] (Just "alt\CR\LFtext  "))
    , -- `GemDocument'
      pretty ~=? G.encode document
    ]

title :: [Test]
title =
    [ Nothing ~=? G.documentTitle [GemText "titleless"]
    , Just "title" ~=? G.documentTitle [GemHeading 3 "title", GemHeading 1 "not title"]
    , Just "also title" ~=? G.documentTitle [GemText "text", GemHeading 1 "also title"]
    ]

-- | The parsed `GemDocument' to match for `GemDocument' tests
document :: GemDocument
document =
    [ GemHeading 1 "gemmula"
    , GemText " < unit tests!! >"
    , GemPre
        [" ~ i am too lazy to put an ascii art here ~ "]
        (Just "ascii art of a heart")
    , GemText ""
    , GemList
        [ "list item 1"
        , "list item 2"
        ]
    , GemText ""
    , GemQuote "thank you for checking gemmula!"
    , GemLink "gemini://geminiprotocol.net" (Just "check Gemini")
    ]

-- | `document' encoded back into a `Text'
pretty :: Text
pretty =
    unlines . map (<> "\CR") $
        [ "# gemmula"
        , " < unit tests!! >"
        , "``` ascii art of a heart"
        , " ~ i am too lazy to put an ascii art here ~ "
        , "```"
        , ""
        , "* list item 1"
        , "* list item 2"
        , ""
        , "> thank you for checking gemmula!"
        , "=> gemini://geminiprotocol.net check Gemini"
        ]

-- | The raw `Text' that will hopefully be decoded into `document'
raw :: Text
raw =
    unlines
        [ "#gemmula"
        , " < unit tests!! > "
        , "```ascii art of a heart "
        , " ~ i am too lazy to put an ascii art here ~ "
        , "```"
        , "   "
        , "* list item 1 "
        , "* list item 2"
        , ""
        , ">thank you for checking gemmula!   "
        , "=>gemini://geminiprotocol.net    check Gemini"
        ]