Transform a Japanese word to furigana 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 -&gt; String 
jishoUrlFor word = (escapeURIString isUnescapedInURI) $ "http://jisho.org/word/"++word

getJishoHTML :: String -&gt; IO String
getJishoHTML w  = simpleHTTP (getRequest $ jishoUrlFor w) &gt;&gt;=  getResponseBody

extractHiraganaFromHTML :: String -&gt; String
extractHiraganaFromHTML = unicodeToString . strip . innerText . filter(~== TagText "") . filterBetween . head . partitions  (~== "&lt;span class=\"furigana\"&gt;") . parseTags

convertWordToHiragana :: String -&gt; IO String 
convertWordToHiragana w = do 
    html &lt;- getJishoHTML w
    return $ extractHiraganaFromHTML html 


filterBetween :: [Tag String] -&gt; [Tag String]
filterBetween p = fst $ sfoldl step ([],0) $  p
where step (x,a) tag | tag ~== "&lt;span&gt;" = (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 -&gt; String
strip = lstrip . rstrip

lstrip :: String -&gt; String
lstrip = dropWhile (`elem` wchars)

rstrip :: String -&gt; String
rstrip = reverse . lstrip . reverse

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

main = do
    (word:_) &lt;- getArgs
    a &lt;- convertWordToHiragana word
    putStrLn a
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 ((*&gt;))
import Data.Char (isSpace)

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

main = do
  [word] &lt;- getArgs
  http &lt;- simpleHTTP $ getRequest $ escapeURIString isUnescapedInURI $ "http://jisho.org/word/" ++ word
  html &lt;- 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 (~== "&lt;span class=\"furigana\"&gt;") $ parseTags html


I left the &lt;span&gt; and &lt;/span&gt; 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] &lt;- getArgs
  http &lt;- simpleHTTP $ getRequest $ escapeURIString isUnescapedInURI
    $ "http://jisho.org/word/" ++ word
  html &lt;- getResponseBody http
  T.putStrLn $ strip $ decodeUtf8 $ innerText
    $ getTagContent "span" (== [("class","furigana")]) $ parseTags html