scmdoc

Automatically generate documentation from comments in R7RS Scheme code

git clone https://git.8pit.net/scmdoc.git

 1{-# LANGUAGE OverloadedStrings #-}
 2
 3module Library where
 4
 5import Test.Tasty
 6import Test.Tasty.HUnit
 7
 8import Data.Text ()
 9import SchemeDoc
10import qualified SchemeDoc.Format.Library as L
11import SchemeDoc.Types
12import Util
13
14getLibs :: String -> [L.Library]
15getLibs input = map snd libraries
16  where
17    -- Scheme S-expressions for the parsed input.
18    (Right expr) = parse input
19
20    -- Documented library definitions in the input
21    (Right libraries) = findDocLibs expr
22
23getLib :: String -> L.Library
24getLib = head . getLibs
25
26------------------------------------------------------------------------
27
28libraryParser :: TestTree
29libraryParser =
30    testGroup
31        "Tests for the Library parser"
32        [ testCase "Library with exports and without declarations" $ do
33            let lib = getLib ";;> my comment\n(define-library (foo) (export string-length))"
34
35            assertEqual "Library name" "foo" $ L.name lib
36            assertEqual "Exports string-length" True $ L.exports lib "string-length"
37            assertEqual "Doesn't export foo" False $ L.exports lib "foo"
38        , testCase "Library with renamed identifier" $ do
39            let lib = getLib ";;> my comment\n(define-library (foo) (export (rename string-length strlen)))"
40
41            assertEqual "Exports renamed internal" True $ L.exports lib "string-length"
42            assertEqual "Doesn't export renamed external" False $ L.exports lib "strlen"
43            assertEqual "Renamed identifier" (Just "strlen") $ L.externalId lib "string-length"
44            assertEqual "Unknown identifier" Nothing $ L.externalId lib "foo"
45        , testCase "Multiple lib definitions in a single file" $ do
46            let libs = getLibs ";;> foo lib\n(define-library (foo))\n;;> bar library\n(define-library (bar))"
47            assertEqual "Amount of libraries" 2 $ length libs
48
49            assertEqual "First lib name" "foo" $ L.name (libs !! 0)
50            assertEqual "Second lib name" "bar" $ L.name (libs !! 1)
51        , testCase "Multipart lib name" $ do
52            let lib = getLib ";;> my comment\n(define-library (foo  42 bar   23 baz))"
53            assertEqual "" "foo 42 bar 23 baz" $ L.name lib
54        , testCase "Library with lib declaration" $ do
55            let lib = getLib ";;> scheme example lib\n(define-library (scheme example) (begin (define x 23) (define y 42)))"
56            expanded <- L.expand lib
57
58            assertEqual
59                ""
60                [ List
61                    [ Id "begin"
62                    , List [Id "define", Id "x", Number 23]
63                    , List [Id "define", Id "y", Number 42]
64                    ]
65                ]
66                expanded
67        , testCase "Library with multiple declarations" $ do
68            let lib = getLib ";;> my lib\n(define-library (scheme example) (begin (define x 23)) (begin (define y 42)))"
69            expanded <- L.expand lib
70
71            assertEqual
72                ""
73                [ List [Id "begin", List [Id "define", Id "y", Number 42]]
74                , List [Id "begin", List [Id "define", Id "x", Number 23]]
75                ]
76                expanded
77        , testCase "Library with include" $ do
78            let lib = getLib ";;> doc comment\n(define-library (some example) (include \"test/testdata/simple-include.scm\"))"
79            expanded <- L.expand lib
80
81            assertEqual "" [List [Id "begin", List [Id "define", Id "x", Str "foo"]]] expanded
82        ]