-- ------------------------------------------------------------
module Holumbus.Crawler.RobotTypes
where
import Control.DeepSeq
import Data.Binary ( Binary )
import qualified Data.Binary as B
import Data.Char
import qualified Data.Map as M
import Holumbus.Crawler.URIs
import Text.XML.HXT.Core
{-
import Text.XML.HXT.RelaxNG.XmlSchema.RegexMatch
import qualified Debug.Trace as D
-}
-- ------------------------------------------------------------
type Robots = M.Map URI RobotRestriction
type RobotRestriction = [RobotSpec]
type RobotSpec = (URI, RobotAction)
data RobotAction = Disallow | Allow
deriving (Eq, Show, Read, Enum)
type AddRobotsAction = URI -> Robots -> IO Robots
-- ------------------------------------------------------------
instance Binary RobotAction where
put = B.put . fromEnum
get = do
b <- B.get
return (toEnum b)
instance NFData RobotAction where
rnf x = x `seq` ()
instance XmlPickler RobotAction where
xpickle = xpPrim
xpRobots :: PU Robots
xpRobots = xpElem "robots" $
xpMap "robot" "host" xpText xpRobotRestriction
xpRobotRestriction :: PU RobotRestriction
xpRobotRestriction = xpList $
xpElem "restriction" $
xpPair ( xpAttr "href" $ xpText )
( xpAttr "access" $ xpickle )
-- ------------------------------------------------------------
emptyRobots :: Robots
emptyRobots = M.singleton "" []
robotsExtend :: String -> AddRobotsAction
robotsExtend _robotName _uri robots
= return robots -- TODO
robotsIndex :: URI -> Robots -> Bool
robotsIndex _uri _robots
= True -- TODO
robotsFollow :: URI -> Robots -> Bool
robotsFollow _uri _robots
= True -- TODO
-- ------------------------------------------------------------
robotsNo :: String -> LA XmlTree XmlTree
robotsNo what = none
`when`
( this
/> hasName "html"
/> hasName "head"
/> hasName "meta" -- getByPath ["html", "head", "meta"]
>>>
hasAttrValue "name" ( map toUpper
>>>
(== "ROBOTS")
)
>>>
getAttrValue0 "content"
>>>
isA ( map (toUpper
>>>
(\ x -> if isLetter x then x else ' ')
)
>>>
words
>>>
(what `elem`)
)
)
-- | robots no index filter. This filter checks HTML documents
-- for a \<meta name=\"robots\" content=\"noindex\"\> in the head of the document
robotsNoIndex :: ArrowXml a => a XmlTree XmlTree
robotsNoIndex = fromLA $ robotsNo "NOINDEX"
-- | robots no follow filter. This filter checks HTML documents
-- for a \<meta name=\"robots\" content=\"nofollow\"\> in the head of the document
robotsNoFollow :: ArrowXml a => a XmlTree XmlTree
robotsNoFollow = fromLA $ robotsNo "NOFOLLOW"
-- ------------------------------------------------------------