gdritter repos telml / 4c41cf9
start to do better error-handling Getty Ritter 1 year, 10 months ago
1 changed file(s) with 111 addition(s) and 19 deletion(s). Collapse all Expand all
+111
-19
telml-bin/src/Main.hs less more
1 {-# LANGUAGE DeriveAnyClass #-}
12 {-# LANGUAGE OverloadedStrings #-}
23
34 module Main where
45
6 import qualified Control.Exception.Base as Exn
57 import qualified Data.ByteString.Char8 as BS
68 import qualified Data.TeLML as TeLML
79 import qualified Data.Text as Text
810 import qualified Data.Text.Encoding as Text
11 import qualified Data.Text.IO as Text
912 import qualified HsLua.Core as Lua
1013 import qualified System.Console.GetOpt as Opt
1114 import qualified System.Environment as Sys
4851 (_, _, errors) ->
4952 error (unlines errors)
5053
54 data Error
55 = LuaError Lua.Exception
56 | TeLMLError Exn.SomeException
57 deriving (Show)
58
59 instance Exn.Exception Error where
60 displayException (LuaError err) = Exn.displayException err
61 displayException (TeLMLError err) = Exn.displayException err
62
63 instance Lua.LuaError Error where
64 popException = do
65 err <- Lua.changeErrorType Lua.popException
66 return (LuaError err)
67
68 pushException (LuaError err) = do
69 Lua.changeErrorType (Lua.pushException err)
70 pushException (TeLMLError err) = do
71 let str = BS.pack (Exn.displayException err)
72 Lua.pushstring str
73
74 luaException = LuaError . Lua.luaException
75
76 type LuaM r = Lua.LuaE Error r
77
78 throw :: Exn.Exception e => e -> LuaM a
79 throw =
80 Lua.liftIO . Exn.throwIO . TeLMLError . Exn.toException
81
5182 main :: IO ()
5283 main = do
5384 options <- parseOpts
6091 luaSource <- case optTagFile options of
6192 Nothing -> return ""
6293 Just f -> BS.readFile f
63 result <- Lua.run (luaMain luaSource telml)
64 print result
94 result <- Lua.runEither (luaMain luaSource telml)
95 case result of
96 Right msg -> Text.putStr msg
97 Left err -> putStrLn (Exn.displayException err)
6598 return ()
6699
67 luaMain :: BS.ByteString -> TeLML.Document -> Lua.LuaE Lua.Exception Text.Text
100 luaMain :: BS.ByteString -> TeLML.Document -> LuaM Text.Text
68101 luaMain luaSource doc = do
102 Lua.openbase
103 Lua.pop 1
104
69105 Lua.newtable
70 Lua.setglobal "telml" :: Lua.LuaE Lua.Exception ()
106 Lua.setglobal "telml"
71107 _ <- Lua.dostring luaSource
72108 telml <- Lua.getglobal "telml"
73109 if telml /= Lua.TypeTable
75111 else return ()
76112 handleDoc doc
77113
78 standardTags :: Text.Text -> [Text.Text] -> Maybe Text.Text
114 data BuiltinArityMismatch = BuiltinArityMismatch
115 { bamExpected :: Int,
116 bamProvided :: Int,
117 bamTagName :: Text.Text
118 }
119 deriving (Show)
120
121 instance Exn.Exception BuiltinArityMismatch where
122 displayException bam =
123 concat
124 [ "Tag `\\",
125 Text.unpack (bamTagName bam),
126 "`: expected ",
127 show (bamExpected bam),
128 " argument(s), got ",
129 show (bamProvided bam)
130 ]
131
132 data NoSuchTag = NoSuchTag {nstName :: Text.Text} deriving (Show)
133
134 instance Exn.Exception NoSuchTag where
135 displayException nst =
136 "No such tag: `" ++ Text.unpack (nstName nst) ++ "`"
137
138 data NotAFunction = NotAFunction
139 {nafName :: Text.Text, nafActual :: Lua.Type}
140 deriving (Show)
141
142 instance Exn.Exception NotAFunction where
143 displayException naf =
144 concat
145 [ "Lua definition of `telml.",
146 Text.unpack (nafName naf),
147 "` not a function, found ",
148 go (nafActual naf),
149 " instead"
150 ]
151 where
152 go Lua.TypeNil = "nil"
153 go Lua.TypeBoolean = "boolean"
154 go Lua.TypeLightUserdata = "userdata (light)"
155 go Lua.TypeNumber = "number"
156 go Lua.TypeString = "string"
157 go Lua.TypeTable = "table"
158 go Lua.TypeFunction = "function"
159 go Lua.TypeUserdata = "userdata"
160 go Lua.TypeThread = "thread"
161 go Lua.TypeNone = "something unspeakable"
162
163 standardTags :: Text.Text -> [Text.Text] -> LuaM Text.Text
79164 standardTags n ps =
80165 case (n, ps) of
81 ("em", [r]) -> Just ("<em>" <> r <> "</em>")
82 ("strong", [r]) -> Just ("<strong>" <> r <> "</strong>")
83 ("li", [r]) -> Just ("<li>" <> r <> "</li>")
84 _ -> Nothing
85
86 handleDoc :: TeLML.Document -> Lua.LuaE Lua.Exception Text.Text
166 -- \em to produce italics
167 ("em", [r]) -> pure ("<em>" <> r <> "</em>")
168 ("em", _) -> throw (BuiltinArityMismatch 1 (length ps) n)
169 -- \strong to produce bolding
170 ("strong", [r]) -> pure ("<strong>" <> r <> "</strong>")
171 ("strong", _) -> throw (BuiltinArityMismatch 1 (length ps) n)
172 -- \li to produce list items
173 ("li", [r]) -> pure ("<li>" <> r <> "</li>")
174 ("li", _) -> throw (BuiltinArityMismatch 1 (length ps) n)
175 _ -> throw (NoSuchTag n)
176
177 handleDoc :: TeLML.Document -> LuaM Text.Text
87178 handleDoc = fmap mconcat . sequence . map handleFrag
88179
89 handleFrag :: TeLML.Fragment -> Lua.LuaE Lua.Exception Text.Text
180 handleFrag :: TeLML.Fragment -> LuaM Text.Text
90181 handleFrag (TeLML.TextFrag text) = return text
91182 handleFrag (TeLML.TagFrag tag) = handleTag tag
92183
93 handleTag :: TeLML.Tag -> Lua.LuaE Lua.Exception Text.Text
184 handleTag :: TeLML.Tag -> LuaM Text.Text
94185 handleTag (TeLML.Tag n ps) = do
95186 ps' <- mapM handleDoc ps
96187 Lua.pushstring (Text.encodeUtf8 n)
97188 typ <- Lua.gettable 1
98189 case typ of
99 Lua.TypeNil -> case standardTags n ps' of
100 Just r -> return r
101 Nothing -> error ("No such tag " ++ show n)
190 Lua.TypeNil -> standardTags n ps'
102191 Lua.TypeFunction -> do
103192 mapM_ (Lua.pushstring . Text.encodeUtf8) ps'
104193 Lua.call (Lua.NumArgs (fromIntegral (length ps'))) 1
105194 result <- Lua.tostring 2
106195 case result of
107 Nothing -> error "expected string"
108 Just r -> return (Text.decodeUtf8 r)
109 _ -> error ("Expected function, not " ++ show typ)
196 Nothing -> do
197 actualtyp <- Lua.ltype 2
198 error ("expected string, got" ++ show actualtyp)
199 Just r -> do
200 return (Text.decodeUtf8 r)
201 _ -> throw (NotAFunction n typ)