scmdoc

 1{-# LANGUAGE OverloadedStrings #-}
 2
 3module Record where
 4
 5import Test.Tasty
 6import Test.Tasty.HUnit
 7
 8import Data.Text ()
 9import SchemeDoc.Format.Record (expand)
10import Util
11
12------------------------------------------------------------------------
13
14record :: TestTree
15record =
16    testGroup
17        "Tests for Scheme record syntax macro expansion"
18        [ testCase "Expand macro w/o comments and single field" $ do
19            {- FOURMOLU_DISABLE -}
20            let (Right s) = parse "                  \
21                \ (define-record-type                \
22                \     my-type                        \
23                \     (my-cons my-field)             \
24                \     my-pred                        \
25                \     (my-field getter))"
26
27            let (Right exp) = parse "                \
28                \ (begin                             \
29                \     (define (my-cons my-field) _)  \
30                \     (define (my-pred obj) _)       \
31                \     (begin                         \
32                \         my-field                   \
33                \         (define (getter my-type) _)))"
34            {- FOURMOLU_ENABLE -}
35
36            assertEqual "" (Just $ head exp) (expand $ head s)
37
38        , testCase "Expand macro with comments and multiple fields" $ do
39            {- FOURMOLU_DISABLE -}
40            let (Right s) = parse "                               \
41                \ (define-record-type <pare>                      \
42                \     ;;> Documentation for my constructor.     \n\
43                \     (cons x y)                                  \
44                \     ;;> Documentation for my predicate.       \n\
45                \     pare?                                       \
46                \     (x                                          \
47                \         ;;> My getter                         \n\
48                \         kar                                     \
49                \         ;;> My setter                         \n\
50                \         set-kar!)                               \
51                \     (y kdr))"
52
53            let (Right exp) = parse "                             \
54                \ (begin                                          \
55                \     ;;> Documentation for my constructor.     \n\
56                \     (define (cons x y) _)                       \
57                \     ;;> Documentation for my predicate.       \n\
58                \     (define (pare? obj)    _)                   \
59                \     (begin                                      \
60                \         x                                       \
61                \         ;;> My getter                         \n\
62                \         (define (kar <pare>) _)                 \
63                \         ;;> My setter                         \n\
64                \         (define (set-kar! <pare> new-value) _)) \
65                \     (begin                                      \
66                \         y                                       \
67                \         (define (kdr <pare>) _)))"
68            {- FOURMOLU_ENABLE -}
69
70            assertEqual "" (Just $ head exp) (expand $ head s)
71        ]