module Text.Search.Sphinx.Indexable (
SchemaType (..), Id,
SphinxSchema (..), serialize
)
where
import Data.Text (unpack)
import qualified Text.Search.Sphinx.Types as T
import Text.XML.Light
data SchemaType = TField
| TAttribute T.AttrT
| TFieldString
type Id = Int
class SphinxSchema a where
toDocument :: a -> (Id, [(String, T.Attr)])
schema :: a -> [(String, SchemaType)]
serialize :: SphinxSchema a => [a] -> Element
serialize :: forall a. SphinxSchema a => [a] -> Element
serialize [a]
items =
String -> Element
sphinxEl String
"docset" Element -> [Element] -> Element
<< (
String -> Element
sphinxEl String
"schema" Element -> [Element] -> Element
<< (((String, SchemaType) -> Element)
-> [(String, SchemaType)] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (String, SchemaType) -> Element
schemaField ([(String, SchemaType)] -> [Element])
-> [(String, SchemaType)] -> [Element]
forall a b. (a -> b) -> a -> b
$ a -> [(String, SchemaType)]
forall a. SphinxSchema a => a -> [(String, SchemaType)]
schema ([a] -> a
forall a. HasCallStack => [a] -> a
head ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ [a]
items))
Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: (a -> Element) -> [a] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map ((Id, [(String, Attr)]) -> Element
doc ((Id, [(String, Attr)]) -> Element)
-> (a -> (Id, [(String, Attr)])) -> a -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (Id, [(String, Attr)])
forall a. SphinxSchema a => a -> (Id, [(String, Attr)])
toDocument) [a]
items
)
doc :: (Id, [(String, T.Attr)]) -> Element
doc :: (Id, [(String, Attr)]) -> Element
doc (Id
id, [(String, Attr)]
fields) = String -> Element
sphinxEl String
"document" Element -> [(String, String)] -> Element
! [(String
"id", Id -> String
forall a. Show a => a -> String
show Id
id)] Element -> [Element] -> Element
<<
((String, Attr) -> Element) -> [(String, Attr)] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (String, Attr) -> Element
docEl [(String, Attr)]
fields
docEl :: (String, T.Attr) -> Element
docEl :: (String, Attr) -> Element
docEl (String
name, Attr
content) = String -> Element
normalEl String
name Element -> CData -> Element
`text` Attr -> CData
indexableEl Attr
content
indexableEl :: Attr -> CData
indexableEl (T.AttrUInt Id
i) = String -> CData
simpleText (String -> CData) -> String -> CData
forall a b. (a -> b) -> a -> b
$ Id -> String
forall a. Show a => a -> String
show Id
i
indexableEl (T.AttrString Text
s) = String -> CData
simpleText (String -> CData) -> String -> CData
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
s
indexableEl (T.AttrFloat Float
f) = String -> CData
simpleText (String -> CData) -> String -> CData
forall a b. (a -> b) -> a -> b
$ Float -> String
forall a. Show a => a -> String
show Float
f
indexableEl Attr
_ = String -> CData
forall a. HasCallStack => String -> a
error String
"not implemented"
simpleText :: String -> CData
simpleText String
s = CData { cdVerbatim :: CDataKind
cdVerbatim = CDataKind
CDataText
, cdData :: String
cdData = String
s
, cdLine :: Maybe Line
cdLine = Maybe Line
forall a. Maybe a
Nothing
}
schemaField :: (String, SchemaType) -> Element
schemaField :: (String, SchemaType) -> Element
schemaField (String
name, SchemaType
TField) = String -> Element
sphinxEl String
"field" Element -> [(String, String)] -> Element
! [(String
"name", String
name)]
schemaField (String
name, TAttribute AttrT
t) = String -> Element
sphinxEl String
"attr" Element -> [(String, String)] -> Element
! [(String
"name", String
name), (String
"type", AttrT -> String
attrType AttrT
t)]
schemaField (String
name, SchemaType
TFieldString) = String -> Element
sphinxEl String
"field_string" Element -> [(String, String)] -> Element
! [(String
"name", String
name), (String
"type", AttrT -> String
attrType AttrT
T.AttrTString)]
attrType :: T.AttrT -> String
attrType :: AttrT -> String
attrType AttrT
T.AttrTString = String
"string"
attrType AttrT
T.AttrTStr2Ordinal = String
"str2ordinal"
attrType AttrT
T.AttrTUInt = String
"int"
attrType AttrT
T.AttrTFloat = String
"float"
attrType AttrT
_ = String -> String
forall a. HasCallStack => String -> a
error String
"not implemented"
text :: Element -> CData -> Element
text :: Element -> CData -> Element
text Element
el CData
dat = Element
el {elContent = [Text dat]}
(<<) :: Element -> [Element] -> Element
Element
a << :: Element -> [Element] -> Element
<< [Element]
b = Element
a {elContent = map Elem b}
(!) :: Element -> [(String, String)] -> Element
Element
el ! :: Element -> [(String, String)] -> Element
! [(String, String)]
attrs = Element
el {elAttribs = [Attr (unqual name) value | (name, value) <- attrs]}
sphinxEl :: String -> Element
sphinxEl :: String -> Element
sphinxEl String
name = Element { elName :: QName
elName = String -> QName
sphinxNm String
name
, elAttribs :: [Attr]
elAttribs = []
, elContent :: [Content]
elContent = []
, elLine :: Maybe Line
elLine = Maybe Line
forall a. Maybe a
Nothing
}
normalEl :: String -> Element
normalEl :: String -> Element
normalEl String
name = Element { elName :: QName
elName = String -> QName
unqual String
name
, elAttribs :: [Attr]
elAttribs = []
, elContent :: [Content]
elContent = []
, elLine :: Maybe Line
elLine = Maybe Line
forall a. Maybe a
Nothing
}
sphinxNm :: String -> QName
sphinxNm String
name = QName
blank_name { qPrefix = Just "sphinx"
, qURI = Nothing
, qName = name
}