gdritter repos telml / 9ab5f06
Clean up code and remove an undefined Getty Ritter 6 years ago
1 changed file(s) with 18 addition(s) and 21 deletion(s). Collapse all Expand all
+18
-21
telml-markup/Data/TeLML/Markup.hs less more
1 {-# LANGUAGE LambdaCase #-}
2 {-# LANGUAGE GADTs #-}
31 {-# LANGUAGE ScopedTypeVariables #-}
42 {-# LANGUAGE ExistentialQuantification #-}
5 {-# LANGUAGE TypeOperators #-}
63 {-# LANGUAGE OverloadedStrings #-}
74 {-# LANGUAGE FlexibleInstances #-}
5 {-# LANGUAGE TypeFamilies #-}
86
97 module Data.TeLML.Markup where
108
9492
9593 -- | The 'Str' newtype will match a literal chunk of non-formatted,
9694 -- non-structured text.
97 newtype Str = Str { fromStr :: T.Text } deriving (Eq, Show)
95 newtype Str = Str { fromStr :: T.Text }
9896
9997 -- | The 'H' newtype will match a single, pre-rendered argument
100 newtype H = H Html
98 newtype H = H { fromHtml :: Html }
10199
102100 -- | The 'Hs' newtype will match a concatenated set of pre-rendered
103101 -- arguments
104 newtype Hs = Hs Html
102 newtype Hs = Hs { fromHtmlList :: Html }
105103
106104 mkTag :: TagArguments t => T.Text -> t -> TagDescription
107105 mkTag = TagDescription
108
109 exec :: T.Text -> [Document] -> [TagDescription] -> Either String Html
110 exec name args (TagDescription tag func:_)
111 | name == tag = case taExec func args undefined of
112 Nothing -> Left $ unwords [ "Tag"
113 , T.unpack ('\\' `T.cons` name)
114 , "expects argument structure"
115 , T.unpack ('\\' `T.cons` name `T.append`
116 T.intercalate "|" (toType func))
117 ]
118 Just x -> x
119 exec name args (_:rs) = exec name args rs
120 exec name args [] = Left $
121 "Error: no match for tag " ++ T.unpack name ++ "/" ++ show (length args)
122106
123107 -- The built-in set of tags (subject to change)
124108 basicTags :: [TagDescription]
150134 ]
151135
152136 simpleTag :: T.Text -> (Markup -> Html) -> TagDescription
153 simpleTag name tag = mkTag name (\ (H h) -> tag h)
137 simpleTag name tag = mkTag name (tag . fromHtml)
154138
155139 listTag :: T.Text -> (Markup -> Html) -> TagDescription
156140 listTag name tag = mkTag name (\ (Hs hs) -> tag hs)
160144 renderPara taglist ds = fmap (p . sequence_) (mapM go ds)
161145 where go (TextFrag ts) = Right (toMarkup ts)
162146 go (TagFrag (Tag tx rs)) = exec tx rs taglist
147 exec name args (TagDescription tag func:_)
148 | name == tag = case taExec func args go of
149 Nothing -> Left $ unwords
150 [ "Tag"
151 , T.unpack ('\\' `T.cons` name)
152 , "expects argument structure"
153 , T.unpack ('\\' `T.cons` name `T.append`
154 T.intercalate "|" (toType func))
155 ]
156 Just x -> x
157 exec name args (_:rs) = exec name args rs
158 exec name args [] = Left $
159 "Error: no match for tag " ++ T.unpack name ++ "/" ++ show (length args)