module HBooru.Parsers.GenericBooru where
import Prelude hiding (id)
import Data.String
import HBooru.Types
import HBooru.Parsers.GenericBooru.TH
import Text.Read (readMaybe)
import Text.XML.HXT.Core hiding (mkName)
import Language.Haskell.TH (mkName)
$(makePost (mkName "GenericPost"))
parsePost ∷ ArrowXml cat ⇒ cat XmlTree GenericPost
parsePost = hasName "post" >>> proc x → do
height <- getAttrValue "height" -< x
score <- getAttrValue "score" -< x
file_url <- getAttrValue "file_url" -< x
parent_id <- getAttrValue "parent_id" -< x
sample_url <- getAttrValue "sample_url" -< x
sample_width <- getAttrValue "sample_width" -< x
sample_height <- getAttrValue "sample_height" -< x
preview_url <- getAttrValue "preview_url" -< x
rating <- getAttrValue "rating" -< x
tags <- getAttrValue "tags" -< x
id <- getAttrValue "id" -< x
width <- getAttrValue "width" -< x
change <- getAttrValue "change" -< x
md5 <- getAttrValue "md5" -< x
creator_id <- getAttrValue "creator_id" -< x
has_children <- getAttrValue "has_children" -< x
created_at <- getAttrValue "created_at" -< x
status <- getAttrValue "status" -< x
source <- getAttrValue "source" -< x
has_notes <- getAttrValue "has_notes" -< x
has_comments <- getAttrValue "has_comments" -< x
preview_width <- getAttrValue "preview_width" -< x
preview_height <- getAttrValue "preview_height" -< x
returnA -< GenericPost
{ heightT = read height
, scoreT = read score
, file_urlT = file_url
, parent_idT = readMaybe parent_id
, sample_urlT = sample_url
, sample_widthT = read sample_width
, sample_heightT = read sample_height
, preview_urlT = preview_url
, ratingT = parseRating rating
, tagsT = parseTags tags
, idT = read id
, widthT = read width
, changeT = change
, md5T = md5
, creator_idT = read creator_id
, has_childrenT = parseBool has_children
, created_atT = created_at
, statusT = status
, sourceT = source
, has_notesT = parseBool has_notes
, has_commentsT = parseBool has_comments
, preview_widthT = read preview_width
, preview_heightT = read preview_height
}
parseRating :: String -> Rating
parseRating "e" = Explicit
parseRating "s" = HBooru.Types.Safe
parseRating "q" = Questionable
parseTags :: String -> [Tag]
parseTags = words
parseBool :: String -> Maybe Bool
parseBool "false" = Just False
parseBool "true" = Just True
parseBool _ = Nothing