5
\$\begingroup\$

I developed a script to transform a Japanese word in Furigana thanks to the jisho website. But the code is very ugly, especially the extractHiraganaFromHTML and filterBetween functions. What kind of improvements are possible?

module Main
where

import Network.HTTP
import Network.URI
import Text.HTML.TagSoup
import Data.Text (unpack)
import Data.Text.Encoding (decodeUtf8)
import Data.ByteString.Char8 (pack)
import System.Environment (getArgs)

jishoUrlFor :: String -> String 
jishoUrlFor word = (escapeURIString isUnescapedInURI) $ "http://jisho.org/word/"++word

getJishoHTML :: String -> IO String
getJishoHTML w  = simpleHTTP (getRequest $ jishoUrlFor w) >>=  getResponseBody

extractHiraganaFromHTML :: String -> String
extractHiraganaFromHTML = unicodeToString . strip . innerText . filter(~== TagText "") . filterBetween . head . partitions  (~== "<span class=\"furigana\">") . parseTags

convertWordToHiragana :: String -> IO String 
convertWordToHiragana w = do 
    html <- getJishoHTML w
    return $ extractHiraganaFromHTML html 


filterBetween :: [Tag String] -> [Tag String]
filterBetween p = fst $ sfoldl step ([],0) $  p
where step (x,a) tag | tag ~== "<span>" = (tag:x,a+1)             
      step (x,a) tag | tag ~== TagClose "span" = (tag:x,a-1)
      step (x,a) tag = (tag:x,a)

      sfoldl step (a,1) (TagClose "span":xs) = (reverse (TagClose "span":a),0) -- stop condition
      sfoldl step (a,b) (x:xs) = sfoldl step (step (a,b) x) xs 
      sfoldl step (a,b) [] = (a,b)



wchars = " \t\r\n"

strip :: String -> String
strip = lstrip . rstrip

lstrip :: String -> String
lstrip = dropWhile (`elem` wchars)

rstrip :: String -> String
rstrip = reverse . lstrip . reverse

unicodeToString = Data.Text.unpack . Data.Text.Encoding.decodeUtf8 . Data.ByteString.Char8.pack

main = do
    (word:_) <- getArgs
    a <- convertWordToHiragana word
    putStrLn a
\$\endgroup\$
2
  • \$\begingroup\$ Each Kanji might have multiple pronunciations based on context, right? How do you handle that? \$\endgroup\$ – 200_success Dec 7 '16 at 3:18
  • \$\begingroup\$ Actually I just use jisho data. I don't research Kanji alone but words. Currently, if a word have multiple pronunciations (like 明日) I take the first one. It will be easy to add other ones because all pronunciations are in the HTML. \$\endgroup\$ – neo2500 Dec 7 '16 at 4:23
3
\$\begingroup\$

Let's inline stuff that's only used once and replace recursion with library combinators.

import Control.Monad.State (evalState, modify, gets)
import Control.Monad.Loops (takeWhileM)
import Control.Applicative ((*>))
import Data.Char (isSpace)

filterBetween :: [Tag String] -> [Tag String]
filterBetween = (`evalState` 1) . takeWhileM step where
  step tag = modify (+ bracket tag) *> gets (>0)
  bracket tag
    | tag ~== "<span>" = 1
    | tag ~== TagClose "span" = -1
    | otherwise = 0

main = do
  [word] <- getArgs
  http <- simpleHTTP $ getRequest $ escapeURIString isUnescapedInURI $ "http://jisho.org/word/" ++ word
  html <- getResponseBody http
  putStrLn
    $ Data.Text.unpack $ Data.Text.Encoding.decodeUtf8 $ Data.ByteString.Char8.pack
    $ dropWhile isSpace $ reverse $ dropWhile isSpace $ reverse
    $ innerText $ filter (~== TagText "")
    $ filterBetween
    $ tail $ head $ partitions (~== "<span class=\"furigana\">") $ parseTags html

I left the <span> and </span> tags themselves out of what is printed, that's easier to code up so might be the correct way.

Edit: More existing combinators :D

{-# LANGUAGE OverloadedStrings #-}
import Text.HTML.TagSoup.Match (getTagContent)
import Data.Text (strip)
import Data.Text.Encoding (decodeUtf8)
import qualified Data.Text.IO as T

main = do
  [word] <- getArgs
  http <- simpleHTTP $ getRequest $ escapeURIString isUnescapedInURI
    $ "http://jisho.org/word/" ++ word
  html <- getResponseBody http
  T.putStrLn $ strip $ decodeUtf8 $ innerText
    $ getTagContent "span" (== [("class","furigana")]) $ parseTags html
\$\endgroup\$
2
  • \$\begingroup\$ Thanks for your answer. I really need to go deeper in Haskell's structures. I don't understand your code for filterBetween yet. For inlining, it's shorter but is it easier to read with names ? \$\endgroup\$ – neo2500 Dec 8 '16 at 15:44
  • 1
    \$\begingroup\$ (`evalState` 1) runs the incoming stateful computation with the initial state 1. takeWhileM runs the effectful (in this case stateful) step on elements of the list until that returns False for an element, taking all the previous elements. step keeps the number of currently open brackets accurate and keeps taking as long as an open bracket remains. \$\endgroup\$ – Gurkenglas Dec 8 '16 at 17:57
3
\$\begingroup\$

Working with text is easier with Data.Text. E.g. it has strip already defined.

Tagsoup understands Data.Text so you don't need many type conversions.

For greater amounts of data it will be notably faster and much more memory efficient.

Instead of defining filterBetween you can convert tag stream into tag tree, take first node and convert it back to stream:

import Text.HTML.TagSoup.Tree (tagTree, flattenTree)
filterBetween = flattenTree . take 1 . tagTree

It is really better to have many small and named functions with type annotations. This not only documents code but also helps to localize type errors while developing.

Please note qualified imports. It is considered idiomatic to import qualified modules like Data.Text, Data.ByteString, Data.Map and some other. This prevents name clashes with Prelude.

import Control.Monad ((>=>))
import Data.Maybe (fromJust)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Encoding as T
import Network.HTTP
import Network.URI
import Text.HTML.TagSoup
import Text.HTML.TagSoup.Tree (tagTree, flattenTree)
import System.Environment (getArgs)


wordUri :: String -> URI
wordUri word = fromJust
  $ parseURI
  $ "http://jisho.org/word/" ++ escapeURIString isUnescapedInURI word

getJishoHTML :: String -> IO Text
getJishoHTML w
  = simpleHTTP (mkRequest GET $ wordUri w)
  >>= fmap T.decodeUtf8 . getResponseBody

hiraganaFromHTML :: Text -> [Text]
hiraganaFromHTML
  = map (T.strip . innerText . flattenTree . take 1 . tagTree)
  . partitions (~== "<span class=\"furigana\">")
  . parseTags

wordToHiragana :: String -> IO [Text]
wordToHiragana = fmap hiraganaFromHTML . getJishoHTML

main :: IO ()
main = getArgs >>= mapM_ (wordToHiragana >=> T.putStrLn . head)
\$\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.