module Bamboo.Plugin.Photo (photo) where
import Bamboo.Plugin.Photo.Config
import Data.ByteString.Lazy.Char8 (pack, unpack)
import Hack
import Hack.Contrib.Middleware.Censor
import MPSUTF8 hiding (at)
import Prelude hiding ((.), (>), (^), (/))
import Text.XML.HXT.Arrow hiding (first, mkText)
import Text.XML.HXT.Parser.HtmlParsec
import qualified Bamboo.Plugin.Photo.Model as Model
import qualified Bamboo.Plugin.Photo.View as View
photo :: Middleware
photo = censor code
where
code r = do
bodies <- r.body.unpack.play
let b = if bodies.null then r.body else bodies.first.pack
return r {body = b}
play :: String -> IO [String]
play s = runX (processor s)
processor :: String -> IOSArrow XmlTree String
processor s =
readString
[ (a_validate,"0")
, (a_parse_html, "1")
, (a_encoding, utf8)
] s
> process_source
> writeDocumentToString
[ (a_output_encoding, utf8)
, (a_output_html, "1")
, (a_no_empty_elements, "1")
]
where
process_source = processBottomUp (highlight_code `when` is_code_block)
highlight_code = replaceChildren highlighted
> changeElemName (const $ mkName "div")
highlighted = proc x -> do
name <- getAttrValue "name" -< x
prefix <- getAttrValue "prefix" -< x
show_desc <- getAttrValue "show_description" -< x
album_type <- getAttrValue "album_type" -< x
let {
args =
[ ("name", name)
, ("prefix", prefix)
, ("show_description", show_desc)
, ("album_type", album_type)
]
}
h <- arrIO plug -< args
returnA -< parseHtmlContent h .first
is_code_block =
isElem
> hasName plugin_id
> hasAttrValue plugin_type_key (is plugin_type_value)
plug :: [(String, String)] -> IO String
plug args = args.Model.from_list ^ View.render ^ show