tellbot 0.6.0.10 → 0.6.0.11

raw patch · 2 files changed

+21/−13 lines, 2 filesdep ~bifunctors

Dependency ranges changed: bifunctors

Files

• src/HTML.hs +19/−11
• tellbot.cabal +2/−2

@@ -14,8 +14,13 @@     regexps <- fmap Prelude.lines $ readFile regPath      if (safeHost regexps url) then do       putStrLn $ url ++ " is safe"-      resp <- simpleHttp url-      evaluate $ extractTitle . unpack . T.concat . T.lines . decodeUtf8 $ toStrict resp+      if url =~ "https?://www\\.youtube\\.com"+      then do+        resp <- simpleHttp ("http://www.getlinkinfo.com/info?link=" ++ url)+        evaluate $ extractTitle True . unpack . T.concat . T.lines . decodeUtf8 $ toStrict resp+      else do+        resp <- simpleHttp url+        evaluate $ extractTitle False . unpack . T.concat . T.lines . decodeUtf8 $ toStrict resp       else         pure Nothing   where@@ -24,16 +29,19 @@       putStrLn $ "Exception: " ++ show e       pure Nothing     -extractTitle :: String -> Maybe String-extractTitle body =-  case dropTillTitle (parseTags body) of-    (TagText title:TagClose "title":_) -> pure ("\ETX7«\ETX6 " ++ chomp title ++ " \ETX7»\SI")-    _ -> Nothing+extractTitle :: Bool -> String -> Maybe String+extractTitle True body = case dropTillTitle True (parseTags body) of+  (TagText title:TagClose "b":TagClose "dd":_) -> pure ("\ETX7«\ETX6 " ++ chomp title ++ " \ETX7»\SI")+  _ -> Nothing+extractTitle False body = case dropTillTitle False (parseTags body) of+  (TagText title:TagClose "title":_) -> pure ("\ETX7«\ETX6 " ++ chomp title ++ " \ETX7»\SI")+  _ -> Nothing -dropTillTitle :: [Tag String] -> [Tag String]-dropTillTitle [] = []-dropTillTitle (TagOpen "title" _ : xs) = xs-dropTillTitle (_:xs) = dropTillTitle xs+dropTillTitle :: Bool -> [Tag String] -> [Tag String]+dropTillTitle _ [] = []+dropTillTitle True (TagOpen "dt" [("class","link-title")]:TagText _:TagClose "dt":TagText _:TagOpen "dd" []:TagOpen "b" []:xs) = xs+dropTillTitle False (TagOpen "title" _:xs) = xs+dropTillTitle b (_:xs) = dropTillTitle b xs  chomp :: String -> String chomp = filter (\c -> ord c >= 32 && (isAlphaNum c || isPunctuation c || c == ' ')) . unpack . strip . pack

@@ -1,5 +1,5 @@ name:                tellbot-version:             0.6.0.10+version:             0.6.0.11 synopsis:            IRC tellbot description:         An IRC bot that can be used to create queuing message.                      It also offers a simple administration IRC bot interface.@@ -27,7 +27,7 @@   default-extensions:  FlexibleInstances    build-depends:       base         >= 4.5  && < 5-                     , bifunctors   >= 4.1  && < 5.2+                     , bifunctors   >= 4.1  && < 5.3                      , bytestring   >= 0.10 && < 0.11                      , containers   >= 0.4  && < 0.6                      , http-conduit >= 2.1  && < 2.2