module Text.Search.Sphinx.Indexable (Indexable (..), SchemaType (..), AttrType (..), Id,
SphinxSchema (..), serialize)
where
import Text.XML.Light
data Indexable = NumAttr Int
| StrAttr String
| Field String
data SchemaType = TField
| TAttribute AttrType
data AttrType = AString | AInt
type Id = Int
class SphinxSchema a where
toDocument :: a -> (Id, [(String, Indexable)])
schema :: a -> [(String, SchemaType)]
serialize :: SphinxSchema a => [a] -> Element
serialize items =
sphinxEl "docset" << (
sphinxEl "schema" << (map schemaField $ schema (head $ items))
: map (doc . toDocument) items
)
doc :: (Id, [(String, Indexable)]) -> Element
doc (id, fields) = sphinxEl "document" ! [("id", show id)] <<
map docEl fields
docEl :: (String, Indexable) -> Element
docEl (name, content) = normalEl name `text` indexableEl content
indexableEl (NumAttr i) = simpleText $ show i
indexableEl (StrAttr f) = simpleText $ f
indexableEl (Field f) = simpleText $ f
simpleText s = CData { cdVerbatim = CDataText
, cdData = s
, cdLine = Nothing
}
schemaField :: (String, SchemaType) -> Element
schemaField (name, TField) = sphinxEl "field" ! [("name", name)]
schemaField (name, TAttribute t) = sphinxEl "attr" ! [("name", name), ("type", attrType t)]
attrType :: AttrType -> String
attrType AString = "str2ordinal"
attrType AInt = "int"
text :: Element -> CData -> Element
text el dat = el {elContent = [Text dat]}
(<<) :: Element -> [Element] -> Element
a << b = a {elContent = map Elem b}
(!) :: Element -> [(String, String)] -> Element
el ! attrs = el {elAttribs = [Attr (unqual name) value | (name, value) <- attrs]}
sphinxEl :: String -> Element
sphinxEl name = Element { elName = sphinxNm name
, elAttribs = []
, elContent = []
, elLine = Nothing
}
normalEl :: String -> Element
normalEl name = Element { elName = unqual name
, elAttribs = []
, elContent = []
, elLine = Nothing
}
sphinxNm name = blank_name { qPrefix = Just "sphinx"
, qURI = Nothing
, qName = name
}