| 1 |
{-# LANGUAGE OverloadedStrings #-}
|
| 2 |
|
| 3 |
module Main where
|
| 4 |
|
| 5 |
import qualified Data.ByteString.Char8 as BS
|
| 6 |
import qualified Data.TeLML as TeLML
|
| 7 |
import qualified Data.Text as Text
|
| 8 |
import qualified Data.Text.Encoding as Text
|
| 9 |
import qualified HsLua.Core as Lua
|
| 10 |
import qualified System.Console.GetOpt as Opt
|
| 11 |
import qualified System.Environment as Sys
|
| 12 |
|
| 13 |
data Options = Options
|
| 14 |
{ optInputFile :: Maybe String,
|
| 15 |
optUseDefaultTags :: Bool,
|
| 16 |
optTagFile :: Maybe String
|
| 17 |
}
|
| 18 |
deriving (Eq, Show)
|
| 19 |
|
| 20 |
opts :: [Opt.OptDescr (Options -> Options)]
|
| 21 |
opts =
|
| 22 |
[ Opt.Option
|
| 23 |
['n']
|
| 24 |
["no-default-tags"]
|
| 25 |
(Opt.NoArg (\o -> o {optUseDefaultTags = False}))
|
| 26 |
"Do not include any default tags",
|
| 27 |
Opt.Option
|
| 28 |
['t']
|
| 29 |
["tags"]
|
| 30 |
(Opt.ReqArg (\f o -> o {optTagFile = Just f}) "[file]")
|
| 31 |
"The file of tag definitions to use"
|
| 32 |
]
|
| 33 |
|
| 34 |
parseOpts :: IO Options
|
| 35 |
parseOpts = do
|
| 36 |
args <- Sys.getArgs
|
| 37 |
let def =
|
| 38 |
Options
|
| 39 |
{ optInputFile = Nothing,
|
| 40 |
optUseDefaultTags = True,
|
| 41 |
optTagFile = Nothing
|
| 42 |
}
|
| 43 |
case Opt.getOpt Opt.Permute opts args of
|
| 44 |
(flags, [], []) ->
|
| 45 |
return (foldl (flip id) def flags)
|
| 46 |
(flags, [input], []) ->
|
| 47 |
return (foldl (flip id) def flags) {optInputFile = Just input}
|
| 48 |
(_, _, errors) ->
|
| 49 |
error (unlines errors)
|
| 50 |
|
| 51 |
main :: IO ()
|
| 52 |
main = do
|
| 53 |
options <- parseOpts
|
| 54 |
telmlSource <- case optInputFile options of
|
| 55 |
Nothing -> getContents
|
| 56 |
Just f -> readFile f
|
| 57 |
let telml = case TeLML.parse telmlSource of
|
| 58 |
Right str -> str
|
| 59 |
Left err -> error err
|
| 60 |
luaSource <- case optTagFile options of
|
| 61 |
Nothing -> return ""
|
| 62 |
Just f -> BS.readFile f
|
| 63 |
result <- Lua.run (luaMain luaSource telml)
|
| 64 |
print result
|
| 65 |
return ()
|
| 66 |
|
| 67 |
luaMain :: BS.ByteString -> TeLML.Document -> Lua.LuaE Lua.Exception Text.Text
|
| 68 |
luaMain luaSource doc = do
|
| 69 |
Lua.newtable
|
| 70 |
Lua.setglobal "telml" :: Lua.LuaE Lua.Exception ()
|
| 71 |
_ <- Lua.dostring luaSource
|
| 72 |
telml <- Lua.getglobal "telml"
|
| 73 |
if telml /= Lua.TypeTable
|
| 74 |
then Lua.liftIO (putStrLn "wrong type")
|
| 75 |
else return ()
|
| 76 |
handleDoc doc
|
| 77 |
|
| 78 |
standardTags :: Text.Text -> [Text.Text] -> Maybe Text.Text
|
| 79 |
standardTags n ps =
|
| 80 |
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
|
| 87 |
handleDoc = fmap mconcat . sequence . map handleFrag
|
| 88 |
|
| 89 |
handleFrag :: TeLML.Fragment -> Lua.LuaE Lua.Exception Text.Text
|
| 90 |
handleFrag (TeLML.TextFrag text) = return text
|
| 91 |
handleFrag (TeLML.TagFrag tag) = handleTag tag
|
| 92 |
|
| 93 |
handleTag :: TeLML.Tag -> Lua.LuaE Lua.Exception Text.Text
|
| 94 |
handleTag (TeLML.Tag n ps) = do
|
| 95 |
ps' <- mapM handleDoc ps
|
| 96 |
Lua.pushstring (Text.encodeUtf8 n)
|
| 97 |
typ <- Lua.gettable 1
|
| 98 |
case typ of
|
| 99 |
Lua.TypeNil -> case standardTags n ps' of
|
| 100 |
Just r -> return r
|
| 101 |
Nothing -> error ("No such tag " ++ show n)
|
| 102 |
Lua.TypeFunction -> do
|
| 103 |
mapM_ (Lua.pushstring . Text.encodeUtf8) ps'
|
| 104 |
Lua.call (Lua.NumArgs (fromIntegral (length ps'))) 1
|
| 105 |
result <- Lua.tostring 2
|
| 106 |
case result of
|
| 107 |
Nothing -> error "expected string"
|
| 108 |
Just r -> return (Text.decodeUtf8 r)
|
| 109 |
_ -> error ("Expected function, not " ++ show typ)
|