scmdoc

 1-- | Data types for the SchemeDoc library.
 2module SchemeDoc.Types (Documented, Sexp (..), Walk (..), walk)
 3where
 4
 5import Data.Complex
 6import qualified Data.Text as T
 7
 8-- | A documented S-expression, i.e. an S-expression which is preceeded
 9-- by a 'DocComment`.
10type Documented = (T.Text, Sexp)
11
12-- | Algebraic data type representing Scheme S-expressions.
13data Sexp
14    = Str T.Text -- "foo"
15    | Id T.Text -- foo
16    | Symbol T.Text -- 'foo
17    | Char Char -- #\f
18    | Boolean Bool -- #t
19    | List [Sexp] -- ["foo" "bar"]
20    | Number Integer
21    | Float Double
22    | Complex (Complex Double)
23    | Rational Rational
24    | DocComment T.Text
25    deriving (Eq)
26
27instance Show Sexp where
28    show (Str s) = "\"" ++ T.unpack s ++ "\"" -- TODO: Perform escaping
29    show (Id i) = T.unpack i
30    show (Symbol s) = "'" ++ T.unpack s
31    show (Char c) = "#\\" ++ [c]
32    show (Boolean b) = if b then "#t" else "#f"
33    show (List a) = "(" ++ unwords (map show a) ++ ")"
34    show (Number n) = show n
35    show (Float n) = show n
36    show (Complex n) = show n
37    show (Rational n) = show n
38    show (DocComment c) = ";;> " ++ T.unpack c
39
40-- | Type used for the return value of the closure passed to 'walk'.
41-- The type is used to indicate whether 'walk' should recurse deeper
42-- into a 'List' S-expression.
43data Walk a = Recur a | Rise a
44
45getValue :: Walk a -> a
46getValue (Recur v) = v
47getValue (Rise v) = v
48
49-- | Traverse a Scheme source, i.e. a list of S-expressions.
50--
51-- For `List`s, the function used for traversal will first
52-- be passed the `List` expression itself and then each
53-- element of the list from left to right. If `proc` returns
54-- 'False' as a first tuple element for a list, then the `List`
55-- wont't be iterated over.
56walk :: (b -> Sexp -> Walk b) -> b -> [Sexp] -> b
57walk proc =
58    foldl
59        ( \a x -> case x of
60            List exprs -> case proc a x of
61                Recur r -> walk proc r exprs
62                Rise r -> r
63            expr -> getValue $ proc a expr
64        )