+ where
+ formatItem :: (ArrowXml a, ArrowChoice a, ArrowIO a) => URI -> a XmlTree XmlTree
+ formatItem baseURI
+ = ( eelem "div"
+ += sattr "class" "searchResult"
+ += ( eelem "a"
+ += attr "href" ( getAttrValue "name"
+ >>>
+ arr (\ x -> uriToString id (mkPageURI baseURI x) "")
+ >>>
+ mkText
+ )
+ += (getAttrValue "name" >>> mkText)
+ )
+ += ( eelem "div"
+ += sattr "class" "date"
+ += ( getAttrValue "lastModified"
+ >>>
+ arr (zonedTimeToUTC . fromJust . parseW3CDateTime)
+ >>>
+ arrIO utcToLocalZonedTime
+ >>>
+ arr formatRFC1123DateTime
+ >>>
+ mkText
+ )
+ )
+ += ( eelem "p"
+ += ( getChildren
+ >>>
+ choiceA [ isText :-> this
+ , hasName "boundary" :-> txt " ... "
+ , hasName "hit" :-> ( eelem "span"
+ += sattr "class" "highlighted"
+ += getChildren
+ )
+ ]
+ )
+ )
+ )
+
+ formatPager :: (ArrowChoice a, ArrowXml a) => URI -> a (String, (Maybe String, (Int, Int))) XmlTree
+ formatPager baseURI
+ = ( eelem "div"
+ += sattr "class" "pager"
+ += txt "Page."
+ += ( ( arr fst
+ &&&
+ arr (fst . snd)
+ &&&
+ arr (fst . snd . snd)
+ &&&
+ ( arr (snd . snd)
+ >>>
+ mkSectionWindow
+ )
+ )
+ >>>
+ proc (query, (order, (currentSection, section)))
+ -> if currentSection == section then
+ ( txt " "
+ <+>
+ eelem "span"
+ += sattr "class" "currentSection"
+ += (arr show >>> mkText)
+ ) -< section
+ else
+ ( txt " "
+ <+>
+ eelem "a"
+ += attr "href" ( mkSectionURI baseURI
+ >>>
+ uriToText
+ )
+ += (arr (show . snd . snd) >>> mkText)
+ ) -< (query, (order, section))
+ )
+ )
+
+ mkSectionWindow :: ArrowList a => a (Int, Int) Int
+ mkSectionWindow
+ = proc (currentSection, totalSections)
+ -> let windowWidth = min maxSectionWindowSize totalSections
+ windowBegin = currentSection - (windowWidth `div` 2)
+ (begin, end) = if windowBegin < 0 then
+ -- 左に溢れた
+ (0, windowWidth - 1)
+ else
+ if windowBegin + windowWidth >= totalSections then
+ -- 右に溢れた
+ (totalSections - windowWidth, totalSections - 1)
+ else
+ -- どちらにも溢れない
+ (windowBegin, windowBegin + windowWidth - 1)
+ in
+ arrL id -< [begin .. end]
+
+
+ mkSectionURI :: Arrow a => URI -> a (String, (Maybe String, Int)) URI
+ mkSectionURI baseURI
+ = arr $ \ (query, (order, section))
+ -> baseURI {
+ uriPath = uriPath baseURI </> "search.html"
+ , uriQuery = '?' : mkQueryString ( [ ("q" , query)
+ , ("from", show $ section * resultsPerSection)
+ , ("to" , show $ (section + 1) * resultsPerSection - 1)
+ ]
+ ++
+ case order of
+ Just o -> [("order", o)]
+ Nothing -> []
+ )
+ }
+
+ uriToText :: ArrowXml a => a URI XmlTree
+ uriToText = arr (\ uri -> uriToString id uri "") >>> mkText