4
\$\begingroup\$

I wrote a converter from anki-style furigana to HTML-style furigana. Eventually I want to do it as a parser, but as a first step I do it without. Furigana is used to write the pronunciation over certain characters in Japanese.

Example:

An example of furigana I found on google images

  • Anki would write it like this:

    林[はやし]さんは 英語[えいご]は 話[はな]せます。
    

    []contains what's written over the char sequence in question and the char seq in question goes from the last ] to the next [. But if the next sequence begins only later (e.g. 英語), space is used to indicate that (\n works too and there is no nesting of brackets).

  • HTML has several ways, and I use this:

    <ruby><rb>林<rt>はやし</ruby>さんは<ruby><rb>英語<rt>えいご</ruby>は<ruby><rb>話<rt>はな</ruby>せます。 
    

    A sequence and its pronunciation are enclosed by <ruby>, <rb> and <rt> to indicate what's on top and on the bottom.

The idea is that the string first gets converted into a sequence of tags that may hold text. That sequence is then grouped and after that the tags are converted to HTML.

I'm just wondering if it is OK so far.

import System.Environment

main :: IO ()
main = do
    args <- getArgs
    file <- readFile (head args)
    putStrLn (anki_2_html file)

anki_2_html = translate_2_html . group . parse'

data Tag = Kana String | Uptext String
     | Furigana String String
     | Blank | Newline

--convert string to tags                                                                                   
parse' :: String -> [Tag]
parse' string = parse string ""

parse :: String -> String -> [Tag]
parse [] []  = []
parse [] acc = [Kana acc]
parse (l:ls) ""  | l == '['  = parseUpText ls ""
                 | l == ' '  = Blank   : parse ls ""
                 | l == '\n' = Newline : parse ls ""
                 | otherwise = parse ls [l]

parse (l:ls) acc | l == '['        = Kana acc : parseUpText ls ""
                 | l `elem` " \n"  = Kana acc : parse (l:ls) ""
                 | otherwise       = parse ls (acc++[l])

parseUpText :: String -> String -> [Tag]
parseUpText  [] []  = []
parseUpText  [] acc = [Kana (' ':acc)]
parseUpText  (l:ls) []  | l == ']'  = parse  ls ""
                        | otherwise = parseUpText ls [l]

parseUpText  (l:ls) acc | l == ']'   = Uptext acc : parse  ls ""
                        | otherwise = parseUpText ls (acc++[l])

--group patterns of Tags                                                                                   
group :: [Tag] -> [Tag]
group (Blank   : Kana kj : Uptext ka : ms) = Furigana kj ka : group ms
group           (Kana kj : Uptext ka : ms) = Furigana kj ka : group ms
group (m:ms) = m : group ms
group [] = []

translate_2_html ::  [Tag] -> String
translate_2_html = foldl1 (++) . map m2s
          where
            m2s (Furigana below above) = "<ruby><rb>"++below++"<rt>"++above++"</ruby>"
            m2s (Kana k) = k
            m2s (Uptext f) = "<f>" ++ f ++ "</f>"
            m2s Blank  = " "
            m2s Newline= "<br>\n"
\$\endgroup\$
2
\$\begingroup\$

Building a list like ((... ++ [_]) ++ [_]) ++ [_] takes quadratic time, break doesn't.

parse :: String -> [Tag]
parse lss = case break (`elem` "[ \n") lss of
  ([],         []) -> []
  ([],     '[':ls) -> parseUpText ls
  ([],     ' ':ls) -> Blank     : parse ls
  ([],    '\n':ls) -> Newline   : parse ls
  (kana,       ls) -> Kana kana : parse ls

parseUpText :: String -> [Tag]
parseUpText lss = case break (== ']') lss of
  ([],         []) -> []
  (kana,       []) -> [Kana (' ':kana)]
  ([],     ']':ls) -> parse ls
  (uptext, ']':ls) -> Uptext uptext : parse ls
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.