scmdoc

 1{-# LANGUAGE OverloadedStrings #-}
 2
 3module Formatter where
 4
 5import Test.Tasty
 6import Test.Tasty.HUnit
 7
 8import Data.Text ()
 9import SchemeDoc.Format.Procedure
10import SchemeDoc.Format.Variable
11import SchemeDoc.Types
12import Util
13
14makeFmt :: (Sexp -> Maybe a) -> String -> (Maybe a)
15makeFmt func scm = case parse scm of
16    Left _ -> Nothing
17    Right s -> func $ head s
18
19------------------------------------------------------------------------
20
21formatter :: TestTree
22formatter =
23    testGroup
24        "Tests for Scheme formatters"
25        [variableFmt, procedureFmt]
26
27variableFmt :: TestTree
28variableFmt =
29    testGroup
30        "Formatter for Variable definitions"
31        [ testCase "Simple variable definition" $ do
32            assertEqual "String variable" (Just $ Variable "foo" (Id "bar")) $
33                makeFmt mkVariable "(define foo bar)"
34
35            assertEqual "Number variable" (Just $ Variable "x" (Number 42)) $
36                makeFmt mkVariable "(define   x   42)"
37        , testCase "Invalid variable definition" $ do
38            assertEqual "" Nothing $ makeFmt mkVariable "(define (foo) bar)"
39        ]
40
41procedureFmt :: TestTree
42procedureFmt =
43    testGroup
44        "Formatter for procedure definitions"
45        [ testCase "Simple procedure definition" $ do
46            assertEqual "" (Just $ Procedure "foo" ["bar", "baz"] [(List [(Id "list"), (Id "bar")])]) $
47                makeFmt mkProcedure "(define (foo bar baz) (list bar))"
48
49            assertEqual "" (Just $ Procedure "id" ["x"] [(Id "x")]) $
50                makeFmt mkProcedure "(define (id x) x)"
51        , testCase "Procedure definition with period" $ do
52            assertEqual
53                "Multiple parameters"
54                (Just $ Procedure "foo" ["bar", ".", "baz"] [(Id "baz")])
55                $ makeFmt mkProcedure "(define (foo bar . baz) baz)"
56
57            assertEqual
58                "Single parameter"
59                (Just $ Procedure "parse-seq" [".", "o"] [(List [(Id "parse-seq-list"), (Id "o")])])
60                $ makeFmt mkProcedure "(define (parse-seq . o) (parse-seq-list o))"
61        ]