tellbot 0.5.1.4 → 0.6
raw patch · 3 files changed
+39/−28 lines, 3 filesdep −errors
Dependencies removed: errors
Files
- src/HTML.hs +4/−2
- src/Main.hs +24/−17
- tellbot.cabal +11/−9
src/HTML.hs view
@@ -1,6 +1,7 @@ module HTML where import Control.Exception ( SomeException, catch )+import Control.Concurrent ( threadDelay ) import Control.Monad ( guard ) import Data.ByteString.Lazy ( toStrict ) import Data.List ( isPrefixOf )@@ -13,12 +14,13 @@ htmlTitle :: FilePath -> String -> IO (Maybe String) htmlTitle regPath url = do regexps <- flip catch handleException . fmap lines $ readFile regPath - print regexps if (safeHost regexps url) then do title <- flip catch handleException $ fmap (extractTitle . concat . lines . unpack . decodeUtf8 . toStrict) $ simpleHttp httpPrefixedURL case title of Just _ -> pure title- Nothing -> flip catch handleException $ fmap (extractTitle . unpack . decodeUtf8 . toStrict) $ simpleHttp httpsPrefixedURL+ Nothing -> do+ threadDelay 500+ flip catch handleException $ fmap (extractTitle . unpack . decodeUtf8 . toStrict) $ simpleHttp httpsPrefixedURL else pure Nothing where
src/Main.hs view
@@ -1,12 +1,12 @@ import Control.Concurrent ( threadDelay ) import Control.Exception ( SomeException, try )-import Control.Error import Control.Monad-import Control.Monad.Identity import Control.Monad.Trans+import Control.Monad.Trans.Except import Control.Monad.Trans.RWS import Data.Bifunctor ( bimap, second ) import Data.Char ( toLower )+import Data.Foldable ( toList ) import Data.List ( intersperse ) import Data.List.Split ( chunksOf, splitOn ) import Data.Foldable ( traverse_ )@@ -20,10 +20,10 @@ import System.IO version :: Version-version = Version [0,5,1,4] ["Apfelschorle"]+version = Version [0,6] ["Apfelschorle"] -type Failable = EitherT String Identity-type FailableIO = EitherT String IO+type Failable = Except String+type FailableIO = ExceptT String IO type Server = String type Chan = String type Session = RWST ConInfo () Stories IO@@ -84,11 +84,11 @@ noticeIRC :: String -> String -> Session () noticeIRC to msg = toIRC $ "NOTICE " ++ to ++ " :" ++ msg -runFailable :: EitherT e Identity a -> Either e a-runFailable = runIdentity . runEitherT+runFailable :: Failable a -> Either String a+runFailable = runExcept -runFailableIO :: EitherT e IO a -> IO (Either e a)-runFailableIO = runEitherT+runFailableIO :: FailableIO a -> IO (Either String a)+runFailableIO = runExceptT main :: IO () main = do@@ -101,14 +101,14 @@ getChan :: [String] -> Failable (Server,Chan,String,String) getChan args = do- unless ( length args == 4 ) . left $+ unless ( length args == 4 ) . throwE $ "expected server host, chan, nick and admin password" let [host,chan,nick,pwd] = args return (host,chan,nick,pwd) start :: [String] -> FailableIO () start args = do- (serv,chan,nick,pwd) <- hoistEither . runFailable $ getChan args+ (serv,chan,nick,pwd) <- ExceptT . pure . runFailable $ getChan args liftIO . withSocketsDo $ connectIRC serv chan nick pwd connectIRC :: Server -> Chan -> String -> String -> IO ()@@ -143,9 +143,6 @@ joinChan :: Session () joinChan = asks conChan >>= toIRC . ("JOIN "++) -quitChan :: Session ()-quitChan = toIRC "QUIT"- ircSession :: Session () ircSession = forever $ fromIRC >>= onContent . purgeContent @@ -224,8 +221,8 @@ msgIRC chan $ from ++ ": you sonavabitch." where (from',_,content) = emitterRecipientContent msg- from = tailSafe from'- kicked = tailSafe $ dropWhile (/=':') content+ from = tailSafe from'+ kicked = tailSafe $ dropWhile (/=':') content -- Extract the emitter, the recipient and the message. emitterRecipientContent :: String -> (String,String,String)@@ -323,7 +320,7 @@ -- FIXME: host & ident tellStories :: String -> Session () tellStories nick = do- stories <- gets (maybeToList . M.lookup (show $ Nick nick))+ stories <- gets (toList . M.lookup (show $ Nick nick)) let cstories = concat stories chunks = map (mapM_ $ msgIRC nick) . chunksOf floodThreshold $ cstories@@ -331,3 +328,13 @@ unless (null stories) $ do sequence_ tells modify (M.delete . show $ Nick nick)++err :: (MonadIO m) => String -> m ()+err = liftIO . hPutStr stderr++errLn :: (MonadIO m) => String -> m ()+errLn = liftIO . hPutStrLn stderr++tailSafe :: [a] -> [a]+tailSafe [] = []+tailSafe (_:xs) = xs
tellbot.cabal view
@@ -1,5 +1,5 @@ name: tellbot-version: 0.5.1.4+version: 0.6 synopsis: IRC tellbot description: An IRC bot that can be used to create queuing message. It also offers a simple administration IRC bot interface.@@ -8,6 +8,8 @@ author: Dimitri Sabadie <dimitri.sabadie@gmail.com> maintainer: Dimitri Sabadie <dimitri.sabadie@gmail.com> category: Network+homepage: https://github.com/phaazon/tellbot+bug-reports: https://github.com/phaazon/tellbot/issues build-type: Simple extra-source-files: CHANGELOG.md@@ -21,22 +23,22 @@ main-is: Main.hs other-modules: HTML+ default-extensions: FlexibleInstances build-depends: base >= 4.5 && < 5- , network >= 2.4 && < 2.7- , errors >= 1.4 && < 1.5- , mtl >= 2.1 && < 2.3- , transformers >= 0.3 && < 0.5- , split >= 0.2 && < 0.3- , containers >= 0.4 && < 0.6 , bifunctors >= 4.1 && < 4.3- , time >= 1.4 && < 1.6+ , bytestring >= 0.10 && < 0.11+ , containers >= 0.4 && < 0.6 , http-conduit >= 2.1 && < 2.2+ , mtl >= 2.1 && < 2.3+ , network >= 2.4 && < 2.7 , regex-posix >= 0.95 && < 0.96+ , split >= 0.2 && < 0.3 , text >= 1.2 && < 1.3- , bytestring >= 0.10 && < 0.11 , tagsoup >= 0.13 && < 0.14+ , time >= 1.4 && < 1.6+ , transformers >= 0.3 && < 0.5 hs-source-dirs: src