scmdoc

 1{-# LANGUAGE OverloadedStrings #-}
 2
 3-- | This module implements comment-preserving pseudo macro expansion
 4-- for record type definitions. All relevant record type comments are
 5-- expanded to dummy procedure definitions, allowing for them to be
 6-- formatter with the 'SchemeDoc.Formatter.Procedure' formatter later.
 7module SchemeDoc.Format.Record (expand) where
 8
 9import Data.Maybe (fromMaybe)
10import qualified Data.Text as T
11import SchemeDoc.Format.Util
12import SchemeDoc.Types
13
14-- Return a new list where the element at the given index has
15-- been modified according to the given function. If the index
16-- is out of range, or if the functions returns 'Nothing', then
17-- 'Nothing' is returned. Indices start at zero.
18modifyAt :: (a -> Maybe a) -> [a] -> Int -> Maybe [a]
19modifyAt f ls i
20    | i < 0 = Nothing
21    | otherwise = go i ls
22  where
23    go 0 (x : xs) = (: xs) <$> f x
24    go n (x : xs) = (x :) <$> go (n - 1) xs
25    go 0 [] = Just []
26    go _ _ = Nothing
27
28objIdx :: Int -> [Sexp] -> Maybe Int
29objIdx n' = go n' 0
30  where
31    go :: Int -> Int -> [Sexp] -> Maybe Int
32    go n i ((DocComment _) : xs) = go n (i + 1) xs
33    go n i (_ : xs) = if n == 0 then Just i else go (n - 1) (i + 1) xs
34    go _ _ _ = Nothing
35
36mkProc :: [Sexp] -> T.Text -> Sexp
37mkProc params name = List [Id "define", List $ Id name : params, Id "_"]
38
39------------------------------------------------------------------------
40
41-- Expand a record type constructor into a dummy procedure definition.
42--
43-- > <constructor> → (<identifier> <field name>*)
44expandCons :: [Sexp] -> Maybe [Sexp]
45expandCons xs = do
46    idx <- objIdx 0 xs
47    modifyAt expandCons' xs idx
48  where
49    expandCons' (List (Id consName : fields)) = Just $ mkProc fields consName
50    expandCons' _ = Nothing
51
52-- Expand a record type predicate into a dummy procedure definition.
53expandPred :: [Sexp] -> Maybe [Sexp]
54expandPred xs = objIdx 1 xs >>= modifyAt (onId $ mkProc [Id "obj"]) xs
55
56-- Expand a record field spec into a dummy procedure definition.
57--
58-- > <field spec> → (<field name> <accessor>)
59-- >    | (<field name> <accessor> <mutator>)
60expandField :: T.Text -> Sexp -> Maybe Sexp
61expandField typeName (List xs) = do
62    -- Expand accessor procedure (must be present).
63    idx <- objIdx 1 xs
64    expanded <- modifyAt (onId $ mkProc [Id typeName]) xs idx
65
66    pure (List $ Id "begin" : fromMaybe expanded (mutator expanded))
67  where
68    -- Optionally expand mutator procedure.
69    mutator lst = do
70        idx <- objIdx 2 lst
71        modifyAt (onId $ mkProc [Id typeName, Id "new-value"]) lst idx
72expandField _ _ = Nothing
73
74-- Expand multiple record type field specs into dummy procedures.
75expandFields :: T.Text -> [Sexp] -> Maybe [Sexp]
76expandFields typeName exprs = do
77    -- Extract all fields.
78    idx <- objIdx 2 exprs
79    let (xs, fields) = splitAt idx exprs
80
81    -- Expand all fields and append them to the existing list.
82    (xs ++) <$> mapM (expandField typeName) fields
83
84-- | Expand a record type definition into multiple dummy procedures
85-- while preserving documentation comments. Thereby, allowing record
86-- type constructors, predicates, and field accessors/mutators to be
87-- documented as procedures.
88--
89-- > (define-record-type <identifier>
90-- >    <constructor> <identifier> <field spec>*)
91--
92-- TODO: Use SyntaxError errors.
93expand :: Sexp -> Maybe Sexp
94expand (List (Id "define-record-type" : Id typeName : xs)) = do
95    e <- expandCons xs >>= expandPred >>= expandFields (T.toLower typeName)
96    Just $ List (Id "begin" : e)
97expand _ = Nothing