196 lines
5.7 KiB
Factor
196 lines
5.7 KiB
Factor
|
USING: kernel xml.syntax xml.traversal accessors words sequences calendar calendar.parser combinators io.streams.string assocs xml unicode arrays splitting html.components math.parser ;
|
||
|
USING: musicbrainz.entities ;
|
||
|
|
||
|
USING: prettyprint ;
|
||
|
IN: musicbrainz.parser
|
||
|
|
||
|
XML-NS: mb http://musicbrainz.org/ns/mmd-2.0#
|
||
|
|
||
|
ERROR: invalid-timestamp ;
|
||
|
|
||
|
: string>word ( str -- word )
|
||
|
"musicbrainz.entities" lookup-word ;
|
||
|
|
||
|
: string>timestamp ( str -- timestamp )
|
||
|
[ length ] keep
|
||
|
[
|
||
|
{
|
||
|
{ 4 [ read-0000 1 1 <date-gmt> ] }
|
||
|
{ 7 [ read-0000 "-" expect read-00 1 <date-gmt> ] }
|
||
|
{ 10 [ read-ymd <date-gmt> ] }
|
||
|
[ drop invalid-timestamp ]
|
||
|
} case
|
||
|
] with-string-reader ;
|
||
|
|
||
|
TAGS: mb-entity ( tag -- entity )
|
||
|
TAGS: entity-property ( entity tag -- entity )
|
||
|
|
||
|
TAG: name entity-property
|
||
|
children>string >>name ;
|
||
|
|
||
|
TAG: sort-name entity-property
|
||
|
children>string >>sort-name ;
|
||
|
|
||
|
TAG: disambiguation entity-property
|
||
|
children>string >>disambiguation ;
|
||
|
|
||
|
TAG: country entity-property
|
||
|
children>string >>country ;
|
||
|
|
||
|
TAG: packaging entity-property
|
||
|
children>string >>packaging ;
|
||
|
|
||
|
TAG: gender entity-property
|
||
|
children>string >lower string>word >>gender ;
|
||
|
|
||
|
TAG: iso-3166-2-code-list entity-property
|
||
|
children-tags [ children>string ] map >array >>iso-codes ;
|
||
|
|
||
|
TAG: iso-3166-1-code-list entity-property
|
||
|
children-tags [ children>string ] map >array >>iso-codes ;
|
||
|
|
||
|
TAG: isni-list entity-property
|
||
|
children-tags [ children>string ] map >array >>isnis ;
|
||
|
|
||
|
TAG: begin entity-property
|
||
|
children>string string>timestamp >>begin ;
|
||
|
TAG: end entity-property
|
||
|
children>string string>timestamp >>end ;
|
||
|
|
||
|
TAG: title entity-property
|
||
|
children>string >>title ;
|
||
|
TAG: language entity-property
|
||
|
children>string >>language ;
|
||
|
TAG: script entity-property
|
||
|
children>string >>script ;
|
||
|
|
||
|
TAG: status entity-property
|
||
|
children>string string>word >>status ;
|
||
|
TAG: quality entity-property
|
||
|
children>string string>word >>quality ;
|
||
|
TAG: text-representation entity-property
|
||
|
children-tags text-representation new [ entity-property ] reduce
|
||
|
>>text-representation ;
|
||
|
TAG: barcode entity-property
|
||
|
children>string >>barcode ;
|
||
|
|
||
|
TAG: artwork entity-property
|
||
|
children>string string>boolean >>artwork? ;
|
||
|
TAG: count entity-property
|
||
|
children>string string>number >>count ;
|
||
|
TAG: front entity-property
|
||
|
children>string string>boolean >>front? ;
|
||
|
TAG: back entity-property
|
||
|
children>string string>boolean >>back? ;
|
||
|
TAG: cover-art-archive entity-property
|
||
|
children-tags cover-art-archive new [ entity-property ] reduce
|
||
|
>>cover-art-archive ;
|
||
|
|
||
|
TAG: release-event-list entity-property
|
||
|
children-tags [ mb-entity ] map >array >>release-events ;
|
||
|
|
||
|
TAG: date entity-property
|
||
|
children>string string>timestamp >>date ;
|
||
|
|
||
|
TAG: life-span entity-property
|
||
|
children-tags life-span new [ entity-property ] reduce
|
||
|
>>life-span ;
|
||
|
|
||
|
TAG: ended entity-property
|
||
|
children>string string>boolean >>ended? ;
|
||
|
|
||
|
TAG: position entity-property
|
||
|
children>string string>number >>position ;
|
||
|
TAG: length entity-property
|
||
|
children>string string>number >>length ;
|
||
|
TAG: number entity-property
|
||
|
children>string string>number >>number ;
|
||
|
TAG: format entity-property
|
||
|
children>string >>format ;
|
||
|
TAG: editor entity-property
|
||
|
children>string >>editor ;
|
||
|
|
||
|
TAG: track mb-entity
|
||
|
[ children-tags track new [ entity-property ] reduce ]
|
||
|
[ attrs>> "id" of ] bi
|
||
|
>>mbid ;
|
||
|
|
||
|
! TODO: turn this into an mb-entity
|
||
|
TAG: alias-list entity-property
|
||
|
children-tags
|
||
|
[
|
||
|
[ children>string ]
|
||
|
[
|
||
|
attrs>>
|
||
|
[ "sort-name" of ]
|
||
|
[ "type" of >lower " " split "-" join string>word ]
|
||
|
[ "locale" of ] tri
|
||
|
] bi
|
||
|
alias boa
|
||
|
] map >array >>aliases ;
|
||
|
|
||
|
TAG: area entity-property
|
||
|
[ children-tags area new [ entity-property ] reduce ]
|
||
|
[ attrs>> [ "id" of ] [ "type" of string>word ] bi ] bi
|
||
|
[ >>mbid ] dip >>type >>area ;
|
||
|
|
||
|
TAG: begin-area entity-property
|
||
|
[ children-tags area new [ entity-property ] reduce ]
|
||
|
[ attrs>> [ "id" of ] [ "type" of string>word ] bi ] bi
|
||
|
[ >>mbid ] dip >>type >>begin-area ;
|
||
|
|
||
|
TAG: release-list mb-entity
|
||
|
children-tags [ mb-entity ] map >array ;
|
||
|
TAG: release-list entity-property
|
||
|
children-tags [ mb-entity ] map >array >>releases ;
|
||
|
|
||
|
TAG: asin entity-property
|
||
|
children>string >>asin ;
|
||
|
|
||
|
TAG: artist mb-entity
|
||
|
[ children-tags artist new [ entity-property ] reduce ]
|
||
|
[ attrs>> [ "id" of ] [ "type" of string>word ] bi ] bi
|
||
|
[ >>mbid ] dip >>type ;
|
||
|
|
||
|
TAG: release-event mb-entity
|
||
|
children-tags release-event new [ entity-property ] reduce ;
|
||
|
|
||
|
TAG: release mb-entity
|
||
|
[ children-tags release new [ entity-property ] reduce ]
|
||
|
[ attrs>> "id" of ] bi >>mbid ;
|
||
|
|
||
|
TAG: collection mb-entity
|
||
|
[ children-tags collection new [ entity-property ] reduce ]
|
||
|
[ attrs>> "id" of ] bi >>mbid ;
|
||
|
|
||
|
TAG: collection-list mb-entity
|
||
|
children-tags [ mb-entity ] map >array ;
|
||
|
|
||
|
TAG: medium-list entity-property
|
||
|
children-tags [ mb-entity ] map >array >>mediums ;
|
||
|
|
||
|
TAG: track-list entity-property
|
||
|
children-tags [ mb-entity ] map >array >>tracks ;
|
||
|
|
||
|
TAG: medium mb-entity
|
||
|
children-tags medium new [ entity-property ] reduce ;
|
||
|
|
||
|
TAG: artist-credit entity-property
|
||
|
"artist" deep-tag-named mb-entity >>artist ;
|
||
|
|
||
|
TAG: label-info-list entity-property
|
||
|
children-tags [ mb-entity ] map >array >>label-info ;
|
||
|
|
||
|
TAG: label-info mb-entity
|
||
|
first-child-tag
|
||
|
[ children-tags label new [ entity-property ] reduce ]
|
||
|
[ attrs>> [ "id" of ] [ "type" of ] bi ] bi
|
||
|
[ >>mbid ] dip >>type ;
|
||
|
|
||
|
TAG: recording entity-property
|
||
|
[ children-tags recording new [ entity-property ] reduce ]
|
||
|
[ attrs>> "id" of ] bi >>mbid >>recording ;
|
||
|
|
||
|
: parse-mb-response ( str -- entity )
|
||
|
string>xml first-child-tag mb-entity ;
|