1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
|
{- |
Module : RunTests
Description : Run the graphviz test suite.
Copyright : (c) Ivan Lazar Miljenovic
License : 3-Clause BSD-style
Maintainer : Ivan.Miljenovic@gmail.com
This module exists solely to make a Main module to build and run
the test suite.
-}
module Main where
import Data.GraphViz.Testing( Test(name, lookupName)
, defaultTests, runChosenTests)
import Data.Char(toLower)
import Data.Maybe(mapMaybe)
import qualified Data.Map as Map
import Data.Map(Map)
import Control.Arrow((&&&))
import Control.Monad(when)
import System.Environment(getArgs, getProgName)
import System.Exit(ExitCode(ExitSuccess), exitWith)
-- -----------------------------------------------------------------------------
main :: IO ()
main = do opts <- getArgs
let opts' = map (map toLower) opts
hasArg arg = any (arg==) opts'
when (hasArg "help") helpMsg
let tests = if hasArg "all"
then defaultTests
else mapMaybe getTest opts'
tests' = if null tests
then defaultTests
else tests
runChosenTests tests'
testLookup :: Map String Test
testLookup = Map.fromList
$ map (lookupName &&& id) defaultTests
getTest :: String -> Maybe Test
getTest = (`Map.lookup` testLookup)
helpMsg :: IO ()
helpMsg = getProgName >>= (putStr . msg) >> exitWith ExitSuccess
where
msg nm = unlines
[ "This utility is the test-suite for the graphviz library for Haskell."
, "Various tests are available; see the table below for a complete list."
, "There are several ways of running this program:"
, ""
, " " ++ nm ++ " Run all of the tests"
, " " ++ nm ++ " all Run all of the tests"
, " " ++ nm ++ " help Get this help message"
, " " ++ nm ++ " <key> Run the test associated with each key,"
, " (where <key> denotes a space-separated list of keys"
, " from the table below)."
, ""
, helpTable
]
helpTable :: String
helpTable = unlines $ fmtName ((lnHeader,lnHeaderLen),(nHeader,nHeaderLen))
: line
: map fmtName testNames
where
andLen = ((id &&& length) .)
testNames = map (andLen lookupName &&& andLen name) defaultTests
fmtName ((ln,lnl),(n,_)) = concat [ ln
, replicate (maxLN-lnl+spacerLen) ' '
, n
]
line = replicate (maxLN + spacerLen + maxN) '-'
maxLN = maximum $ map (snd . fst) testNames
maxN = maximum $ map (snd . snd) testNames
spacerLen = 3
lnHeader = "Key"
lnHeaderLen = length lnHeader
nHeader = "Description"
nHeaderLen = length nHeader
|
