ParserTest.hs

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}

module IO.Keyboard.ParserTest
    ( test_parser
    ) where

import ClassyPrelude

import Test.Tasty
import Test.Tasty.HUnit

import Data.FileEmbed    (embedFile)
import Text.RawString.QQ (r)

import qualified Events.Actions.Types as A
import           IO.Keyboard.Parser   (bindings)
import           IO.Keyboard.Types

basic :: Text
basic = "quit = q"

basicResult :: Bindings
basicResult = [(BChar 'q', A.Quit)]

basicMulti :: Text
basicMulti =
    [r|
        quit = q
        detail = <Enter>
    |]

basicMultiResult :: Bindings
basicMultiResult = [(BChar 'q', A.Quit), (BKey "Enter", A.Detail)]

ini :: Text
ini = decodeUtf8 $(embedFile "test/IO/Keyboard/data/bindings.ini")

iniResult :: Bindings
iniResult =
    [ (BChar 'q', A.Quit)
    , (BChar 'u', A.Undo)
    , (BChar '/', A.Search)
    , (BChar '?', A.Help)
    , (BChar 'k', A.Previous)
    , (BChar 'j', A.Next)
    , (BChar 'h', A.Left)
    , (BChar 'l', A.Right)
    , (BChar 'g', A.Bottom)
    , (BChar 'a', A.New)
    , (BChar 'O', A.NewAbove)
    , (BChar 'o', A.NewBelow)
    , (BChar 'e', A.Edit)
    , (BChar 'A', A.Edit)
    , (BChar 'i', A.Edit)
    , (BChar 'C', A.Clear)
    , (BChar 'D', A.Delete)
    , (BKey "Enter", A.Detail)
    , (BChar '@', A.DueDate)
    , (BChar 'K', A.MoveUp)
    , (BChar 'J', A.MoveDown)
    , (BChar 'H', A.MoveLeft)
    , (BChar 'L', A.MoveRight)
    , (BKey "Space", A.MoveRight)
    , (BChar 'm', A.MoveMenu)
    , (BChar 'N', A.ListNew)
    , (BChar 'E', A.ListEdit)
    , (BChar 'X', A.ListDelete)
    , (BChar '>', A.ListRight)
    , (BChar '<', A.ListLeft)
    ]

comma :: Text
comma = "quit = ,"

commaResult :: Bindings
commaResult = [(BChar ',', A.Quit)]

test_parser :: TestTree
test_parser =
    testGroup
        "IO.Keyboard.Parser"
        [ testCase "basic" (assertEqual "Parses quit" (Right basicResult) (bindings basic))
        , testCase
              "basic multiline"
              (assertEqual "Parses both" (Right basicMultiResult) (bindings basicMulti))
        , testCase "full ini file" (assertEqual "Parses all" (Right iniResult) (bindings ini))
        , testCase "comma" (assertEqual "Parses comma" (Right commaResult) (bindings comma))
        ]