h-booru-0.3.0.0: Haskell library for retrieving data from various booru image sites

Copyright(c) Mateusz Kowalczyk 2013-2014
LicenseGPL-3
Maintainerfuuzetsu@fuuzetsu.co.uk
Stabilityexperimental
Safe HaskellNone
LanguageHaskell2010
Extensions
  • MonoLocalBinds
  • TemplateHaskell
  • TypeFamilies
  • DataKinds
  • TypeSynonymInstances
  • FlexibleInstances
  • MultiParamTypeClasses
  • FunctionalDependencies
  • UnicodeSyntax
  • KindSignatures
  • ExplicitNamespaces

HBooru.Types

Contents

Description

Module definining types used by the library.

Synopsis

Documentation

type Tag = String Source

Tags used for searching in sites. No special escaping is done. Note that many sites would treat a tag like "striped panties" as two separate tags and you wouldn't get the results you were after.

class DataFormat a Source

Data format used by various Sites. See instances for currently used formats.

data JSON Source

Used as one of the data formats.

Constructors

JSON 

class Response r => CoerceResponse x r | x -> r, r -> x where Source

Thanks to this class, we're able to provide instances converting from a DataFormat to Response. This is useful if we need a DataFormat while we only have a type that's an instance of Response. Note that the functional dependency currently requires that there is only one way to coerce between two types.

Methods

toResponse :: x -> String -> r Source

Given something and a String, we get the appropriate Response. For example with instance CoerceResponse XML XMLResponse:

>>> toResponse XML "<SomeXML></SomeXML>"
XMLReponse "<SomeXML></SomeXML>"

fromResponse :: r -> x Source

Given some kind of Response, we get the appropriate value back, depending on the class instance. For example with instance CoerceResponse XML XMLResponse:

>>> fromResponse $ XMLReponse "<SomeXML></SomeXML>"
XML

class (Site s, DataFormat r) => PostParser s r where Source

Class specifying a parser that can fetch posts. A post usually consists of links to the image, samples, and some meta-data. The reason for this class is that sometimes we might get different information based on the DataFormat we use so we use type families to denote this rather than forcing the library user to make do with our best guess on what goes into the post. It also allows us to use different post types for sites that provide different information.

Associated Types

type ImageTy s r Source

Methods

parseResponse :: CoerceResponse r r' => s -> r' -> [ImageTy s r] Source

Given a parser working with DataFormat specified by an instance of this class, we require through CoerceResponse that it is able to parse responses in the format so what we actually pass into this function is the Site this parser works with (so that we can pick the appropriate data type for the posts) and a Response matching the DataFormat (through a class instance). For PostParser Gelbooru XML instance, example use might go like

do fc <- XMLResponse $ readFile "gelbooruResponse.xml"
   -- the type of images is actually inferred for us
   let images ∷ [GelbooruPost]
       images = parseResponse Gelbooru fc
   return images

The cool thing is that we can't feed anything but XMLResponse to an XML parser.

class (Site s, DataFormat r) => Counted s r where Source

Describes whether a response from a Site in given DataFormat allows us to get the information about total number of posts matching our query. Some sites don't provide this information.

Methods

parseCount :: CoerceResponse r r' => s -> r' -> Integer Source

Parses out the number of available images from a response.

class (Counted s r, Postable s r) => PostablePaged s r where Source

Minimal complete definition

Nothing

Methods

postUrlPaged :: s -> r -> [Tag] -> Integer -> String Source

Similar to postUrl but requests images from specific page if the site allows it.

class PostParser s r => Postable s r where Source

If we can make an API request to Site in a specific DataFormat, we can use instances of this class to pass in

Methods

postUrl :: s -> r -> [Tag] -> String Source

Given a Site, a DataFormat and a list of Tags, an instance of this class should be able to return a String at which we can find data in DataFormat format that honours our tags. This is effectively a URL builder for POST requests.

hardLimit :: s -> r -> Limit Source

Provides information about whether there's a hard limit on the amount of posts we can fetch from the site at once. The reason for this function here rather than in Site is that we might be parsing data without an API we can post to at all and we're getting our data through other means.

class Site s Source

Describes a site for a parser. The reason why this isn't a simple data type is to allow us to write additional parsers in the future without modifying this library if we wish to do so.

data Rating Source

Rating used on *booru sites.

Constructors

Safe 
Questionable 
Explicit 

Instances

data Limit Source

Denotes whethere there's a hard limit on the number of posts we can fetch at a time from a site. NoLimit implies that we can fetch everything at once and not that we don't know. See Counted for a way to potentially retrieve number of posts present on the site.

Constructors

NoLimit 
Limit Integer 

Instances

data XMLResponse Source

One of the formats we can receive responses from sites in. For things like parsers parametrisation, use XML instead and use methods in CoerceResponse if you need to.

Constructors

XMLResponse String 

data JSONResponse Source

One of the formats we can receive responses from sites in. For things like parsers parametrisation, use JSON instead and use methods in CoerceResponse if you need to.

Constructors

JSONResponse String 

class Response r where Source

Specifies what is considered a response. You'll almost certainly also want new DataFormat and CoerceResponse instances if you're adding some here. This class assumes that all responses carry the response in a string we can extract. Note that this is not for use as network response if you're scraping, only for putting data into after you have done all the error checking and whatnot.

Methods

getResponse :: r -> String Source

Extract the response string.

bA :: ArrowApply cat => cat c' b -> (b -> cat c' c) -> cat c' c Source

newtype ParseFailure Source

Parse failures from various parsers

Constructors

PF String 

type Parse = Either ParseFailure Source

Alias for our parser monad with failure possibility

data ElF el Source

Constructors

ElF 

Instances

type App * Symbol ElF "actual_preview_height" = Integer 
type App * Symbol ElF "actual_preview_width" = Integer 
type App * Symbol ElF "author" = String 
type App * Symbol ElF "change" = Int 
type App * Symbol ElF "created_at" = String 
type App * Symbol ElF "creator_id" = Integer 
type App * Symbol ElF "file_size" = Integer 
type App * Symbol ElF "file_url" = String 
type App * Symbol ElF "frames" = String 
type App * Symbol ElF "frames_pending" = String 
type App * Symbol ElF "frames_pending_string" = String 
type App * Symbol ElF "frames_string" = String 
type App * Symbol ElF "has_children" = Bool 
type App * Symbol ElF "has_comments" = Maybe Bool 
type App * Symbol ElF "has_notes" = Maybe Bool 
type App * Symbol ElF "height" = Integer 
type App * Symbol ElF "id" = Integer 
type App * Symbol ElF "is_held" = Bool 
type App * Symbol ElF "is_shown_in_index" = Bool 
type App * Symbol ElF "jpeg_file_size" = Integer 
type App * Symbol ElF "jpeg_height" = Integer 
type App * Symbol ElF "jpeg_url" = String 
type App * Symbol ElF "jpeg_width" = Integer 
type App * Symbol ElF "md5" = String 
type App * Symbol ElF "parent_id" = Maybe Integer 
type App * Symbol ElF "preview_height" = Integer 
type App * Symbol ElF "preview_url" = String 
type App * Symbol ElF "preview_width" = Integer 
type App * Symbol ElF "rating" = Rating 
type App * Symbol ElF "sample_file_size" = Integer 
type App * Symbol ElF "sample_height" = Integer 
type App * Symbol ElF "sample_url" = String 
type App * Symbol ElF "sample_width" = Integer 
type App * Symbol ElF "score" = Integer 
type App * Symbol ElF "source" = String 
type App * Symbol ElF "status" = String 
type App * Symbol ElF "tags" = [Tag] 
type App * Symbol ElF "width" = Integer 

type R a = PlainRec ElF a Source

Handy synonym hiding ElF.

type PR a = Parse (R a) Source

R wrapped in a Parse.

Commonly used fields

height :: Proxy "height" Source

score :: Proxy "score" Source

file_url :: Proxy "file_url" Source

parent_id :: Proxy "parent_id" Source

sample_url :: Proxy "sample_url" Source

sample_width :: Proxy "sample_width" Source

sample_height :: Proxy "sample_height" Source

preview_url :: Proxy "preview_url" Source

rating :: Proxy "rating" Source

tags :: Proxy "tags" Source

id :: Proxy "id" Source

width :: Proxy "width" Source

change :: Proxy "change" Source

md5 :: Proxy "md5" Source

creator_id :: Proxy "creator_id" Source

has_children :: Proxy "has_children" Source

created_at :: Proxy "created_at" Source

status :: Proxy "status" Source

source :: Proxy "source" Source

has_notes :: Proxy "has_notes" Source

has_comments :: Proxy "has_comments" Source

preview_width :: Proxy "preview_width" Source

preview_height :: Proxy "preview_height" Source

author :: Proxy "author" Source

frames :: Proxy "frames" Source

frames_pending :: Proxy "frames_pending" Source

frames_pending_string :: Proxy "frames_pending_string" Source

frames_string :: Proxy "frames_string" Source

is_held :: Proxy "is_held" Source

is_shown_in_index :: Proxy "is_shown_in_index" Source

jpeg_file_size :: Proxy "jpeg_file_size" Source

jpeg_height :: Proxy "jpeg_height" Source

jpeg_url :: Proxy "jpeg_url" Source

jpeg_width :: Proxy "jpeg_width" Source

sample_file_size :: Proxy "sample_file_size" Source

actual_preview_height :: Proxy "actual_preview_height" Source

actual_preview_width :: Proxy "actual_preview_width" Source

file_size :: Proxy "file_size" Source