diff --git a/Network/Linklater.hs b/Network/Linklater.hs --- a/Network/Linklater.hs +++ b/Network/Linklater.hs @@ -1,49 +1,25 @@ -{-# LANGUAGE OverloadedStrings, GADTs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE NoImplicitPrelude #-} -- | -- Module: Network.Linklater -- Copyright: (c) The Linklaterteers -- License: BSD-style --- Maintainer: me@haolian.org +-- Maintainer: hi@haolian.org -- Stability: experimental -- Portability: GHC -- -- Here's a @/jpgto@ bot! If you run this program and then tell Slack -- about your server (incoming hook and custom slash command) and then -- type @/jpgto baby corgi@ in one of your channels, you'll get the --- image from . How, you say? /Screen scraping/. +-- image from @http://baby.corgi.jpg.to@. -- --- > -- Remaining imports left as an exercise to the reader. --- > import Network.Linklater (say, slashSimple, Command(..), Config(..), Message(..), Icon(..), Format(..)) --- > -- --- > --- > findUrl :: Text -> Maybe Text --- > findUrl = fmap fromStrict . maybeResult . parse (manyTill (notChar '\n') (string "src=\"") *> takeTill (== '"')) --- > --- > jpgto :: Maybe Command -> IO Text --- > jpgto (Just (Command user channel (Just text))) = do --- > message <- (fmap messageOf . findUrl . decodeUtf8 . flip (^.) responseBody) <$> get ("http://" <> (unpack subdomain) <> ".jpg.to/") --- > case (debug, message) of --- > (True, _) -> putStrLn ("+ Pretending to post " <> (unpack . decodeUtf8 . encode) message) >> return "" --- > (False, Just m) -> config' >>= say m >> return "" --- > (False, Nothing) -> return "Something went wrong!" --- > where config' = (Config "trello.slack.com" . filter (/= '\n') . pack) <$> readFile "token" --- > subdomain = (intercalate "." . fmap (filter isLetter . filter isAscii) . words) text --- > messageOf url = FormattedMessage (EmojiIcon "gift") "jpgtobot" channel [FormatAt user, FormatLink url (subdomain <> ".jpg.to>"), FormatString "no way!: &<>"] --- > debug = True --- > jpgto _ = return "Type more! (Did you know? jpgtobot is only 26 lines of Haskell. )" --- > --- > main :: IO () --- > main = let port = 3000 in putStrLn ("+ Listening on port " <> show port) >> run port (slashSimple jpgto) +-- -- --- One @\/jpgto baby corgi@, et voila. +-- One @/jpgto baby corgi@, et voila. -- -- <> --- --- For the full example (since this one is missing a ton of imports), --- see the @examples/@ directory on GitHub. --- --- module Network.Linklater ( @@ -59,17 +35,17 @@ Format(..) ) where -import Control.Applicative ((<$>)) -import Data.Aeson +import BasePrelude +import Data.Aeson import qualified Data.ByteString.Lazy as BSL import qualified Data.Map as M -import Data.Monoid -import Data.Text.Lazy (Text) +import Data.Text (Text) +import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TLE -import Network.HTTP.Types (status200) +import Network.HTTP.Types (status200) import qualified Network.Wai as W -import Network.Wreq hiding (params, headers) +import Network.Wreq hiding (params, headers) -- | Where 'slash' commands come from, and where 'Message's go. data Channel = @@ -85,6 +61,8 @@ -- | Incoming HTTP requests to the slash function get parsed into one -- of these babies. data Command = Command { + -- | The command name. + _commandName :: Text, -- | Who ran your slash command. _commandUser :: User, -- | Where the person ran your slash command. @@ -114,7 +92,7 @@ unformat (FormatAt user@(User u)) = unformat (FormatUser user u) unformat (FormatUser (User u) t) = "<@" <> u <> "|" <> t <> ">" unformat (FormatLink url t) = "<" <> url <> "|" <> t <> ">" -unformat (FormatString t) = foldr (\(bad, good) -> TL.replace bad good) t [("<", "<"), (">", ">"), ("&", "&")] +unformat (FormatString t) = foldr (uncurry T.replace) t [("<", "<"), (">", ">"), ("&", "&")] -- | Here's how you talk: you make one of these and pass it to 'say'. -- Before the day is done, Linklater will convert this to a JSON blob @@ -124,47 +102,45 @@ -- -- * Complex messages are parsed according to Slack formatting. See 'Format'. -- -data Message where - SimpleMessage :: Icon -> Text -> Channel -> Text -> Message - FormattedMessage :: Icon -> Text -> Channel -> [Format] -> Message +data Message = + SimpleMessage Icon Text Channel Text + | FormattedMessage Icon Text Channel [Format] +instance ToJSON Channel where + toJSON (GroupChannel c) = + String ("#" <> c) + toJSON (IMChannel im) = + String ("@" <> im) + instance ToJSON Message where toJSON m = case m of (FormattedMessage emoji username channel formats) -> - toJSON_ emoji username channel (TL.intercalate " " (fmap unformat formats)) False + toJSON_ emoji username channel (T.intercalate " " (fmap unformat formats)) False (SimpleMessage emoji username channel text) -> toJSON_ emoji username channel text True where toJSON_ (EmojiIcon emoji) username channel raw toParse = - object [ "channel" .= stringOfChannel channel - , "icon_emoji" .= TL.concat [":", emoji, ":"] + object [ "channel" .= channel + , "icon_emoji" .= (":" <> emoji <> ":") , "parse" .= String (if toParse then "full" else "poop") , "username" .= username , "text" .= raw , "unfurl_links" .= True ] - stringOfChannel (GroupChannel c) = TL.concat ["#", c] - stringOfChannel (IMChannel im) = TL.concat ["@", im] -- | Like a curiosity about the world, you'll need one of these to -- 'say' something. data Config = Config { - -- | This is where your Slack account is hosted. For example, - -- @"trello.slack.com"@. - _configHostname :: Text, - -- | This is the incoming web hook token that Slack gave you. It's - -- usually a long alphanumberic string of garbage. - _configIncomingHookToken :: Text + -- | This is the incoming web hook URL that Slack gave you. It's + -- usually @https://hooks.slack.com/services/...@. + _configHookURL :: Text } -- | The 'say' function posts a 'Message', with a capital M, to Slack. -- It'll, however, need a 'Config' (a.k.a. incoming token) first. say :: Message -> Config -> IO (Response BSL.ByteString) -say message config = - post (TL.unpack url) (encode message) - where - -- TODO: use a URL builder - url = TL.concat ["https://", _configHostname config, "/services/hooks/incoming-webhook?token=", _configIncomingHookToken config] +say message Config{..} = + post (T.unpack _configHookURL) (encode message) -- | A bot server for people who are in a hurry. Make a function that -- takes a 'Command' and returns some 'Text' in 'IO' world, and we'll @@ -172,11 +148,21 @@ -- control over the request and respond, see 'slash'. slashSimple :: (Maybe Command -> IO Text) -> W.Application slashSimple f = - slash (\command _ respond -> f command >>= (respond . makeResponse)) + slash (\command _ respond -> f command >>= (respond . makeResponse . TL.fromStrict)) where - headers = [("Content-type", "text/plain")] - makeResponse = W.responseLBS status200 headers . TLE.encodeUtf8 + headers = + [("Content-type", "text/plain")] + makeResponse = + W.responseLBS status200 headers . TLE.encodeUtf8 +channelOf :: User -> Text -> Maybe Channel +channelOf (User u) "directmessage" = + Just (IMChannel u) +channelOf _ "privategroup" = + Nothing +channelOf _ c = + Just (GroupChannel c) + -- | A bot server! As if by magic. This acts like a 'Network.WAI' -- middleware: Linklater wraps around your application. (Really, it -- just gives you a 'Command' to work with instead of a raw HTTP @@ -186,16 +172,19 @@ where command = do user <- userOf <$> wishFor "user_name" - channel <- wishFor "channel_name" >>= channelOf user - let text = wishFor "text" - return (Command user channel text) - wishFor key = case M.lookup (key :: Text) params of - Just (Just "") -> Nothing - Just (Just value) -> Just value - _ -> Nothing - userOf = User . TL.filter (/= '@') - channelOf (User u) "directmessage" = Just (IMChannel u) - channelOf _ "privategroup" = Nothing - channelOf _ c = Just (GroupChannel c) + Command <$> (nameOf <$> wishFor "command") + <*> return user + <*> (wishFor "channel_name" >>= channelOf user) + <*> return (wishFor "text") + wishFor key = + case M.lookup (key :: TL.Text) params of + Just (Just "") -> + Nothing + Just (Just value) -> + Just (TL.toStrict value) + _ -> + Nothing + userOf = User . T.filter (/= '@') + nameOf = T.filter (/= '/') params = M.fromList [(toText k, toText <$> v) | (k, v) <- W.queryString req] toText = TLE.decodeUtf8 . BSL.fromChunks . return diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -17,47 +17,15 @@ ## Show me an example! -Here's a `/jpgto` bot. If you run this program and then tell Slack -about your server (incoming hook and custom slash command) and then -type `/jpgto baby corgi` in one of your channels, you'll get the -image from [http://baby.corgi.jpg.to](baby.corgi.jpg.to). How, you say? _Screen scraping_. - -```haskell --- Remaining imports left as an exercise to the reader. -import Network.Linklater (say, slashSimple, Command(..), Config(..), Message(..), Icon(..), Format(..)) - -findUrl :: Text -> Maybe Text -findUrl = fmap fromStrict . maybeResult . parse (manyTill (notChar '\n') (string "src=\"") *> takeTill (== _quotedbl)) - -jpgto :: Maybe Command -> IO Text -jpgto (Just (Command user channel (Just text))) = do - message <- (fmap messageOf . findUrl . decodeUtf8 . flip (^.) responseBody) <$> get ("http://" <> (unpack subdomain) <> ".jpg.to/") - case (debug, message) of - (True, _) -> putStrLn ("+ Pretending to post " <> (unpack . decodeUtf8 . encode) message) >> return "" - (False, Just m) -> config' >>= say m >> return "" - (False, Nothing) -> return "Something went wrong!" - where config' = (Config "trello.slack.com" . filter (/= '\n') . pack) <$> readFile "token" - subdomain = (intercalate "." . fmap (filter isLetter . filter isAscii) . words) text - messageOf url = FormattedMessage (EmojiIcon "gift") "jpgtobot" channel [FormatAt user, FormatLink url (subdomain <> ".jpg.to>")] - debug = True -jpgto _ = return "Type more! (Did you know? jpgtobot is only 26 lines of Haskell. )" - -main :: IO () -main = let port = 3000 in putStrLn ("+ Listening on port " <> show port) >> run port (slashSimple jpgto) -``` - -For the full example (since this one is missing a ton of imports), see -the `examples/` directory on GitHub. - -Now! `/jpgto baby corgi`: - -![jpgtobot in action](corgi.jpg) +* [jpgtobot](https://github.com/hlian/jpgtobot/blob/master/Main.hs) is a slackbot that pastes the image at `foo.jpg.to` into chat. It even supports jpgto's flags: so `-- r+gif` will give you a GIF, randomly selected from all known images named `foo`. Thanks to the magic of -screen scraping-. + + ![jpgtobot in action](https://raw.githubusercontent.com/hlian/linklater/38536bebf00c60fb1214b2c3a741ce00485e87af/corgi.jpg) -So easy. Much fast. +* [hi5bot](https://github.com/hlian/hi5bot/blob/master/Main.hs) lets you high-five people. There are other amazing things it can do too. ## Features - * Uses 'Text' for state-of-the-art Unicode support; + * Uses `Text` for state-of-the-art Unicode support; * Lovely documentation with no misspelllllings to be found; * Supports [Slack's formatting syntax](https://api.slack.com/docs/formatting Slack's formatting syntax) * Comes with a fast mode (`slashSimple`) and a power mode (`slash`) @@ -67,6 +35,11 @@ ## Contributors -* [Hao Lian](https://hao.codes), author -* [Ian Henry](https://ianthehenry.com), design review and _future contributor_??? -* *Shields* (the Grizzly Bear album), which I listened all the way through for the first time while I was writing this ★★★★ +* [Hao Lian](https://hao.codes), author; +* [Ulysses Popple](http://upopple.com/); and +* [Ian Henry](https://ianthehenry.com/), who showed me the `flip (+) foo` -> `(+ foo)` trick; +* *Shields* (the Grizzly Bear album), which I listened all the way through for the first time while I was writing this ★★★★. + +## See also + +* [tightrope](https://github.com/ianthehenry/tightrope), a library Ian should really document diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,16 +1,14 @@ -*- markdown -*- -## 2014-07-27 2.0.0.1 +## 2014-07-27 2.0.0 * Documentation improved with links * jpgtobot code shortened due to market forces * slashSimple * FormattedMessage -## 2014-07-23 1.0.0.3 - -* Include extra source files in `.cabal` - -## 2014-07-23 1.0.0.2 (and 1.0.0.1) +## 2014-07-23 1.0.0 -* Lower dependency constraints for GHC 7.6.x users +* Initial release +* slash and run +* Command, Channel, User, Message, Icon diff --git a/corgi.jpg b/corgi.jpg Binary files a/corgi.jpg and b/corgi.jpg differ diff --git a/examples/JointPhotographicExpertsGroupTonga.hs b/examples/JointPhotographicExpertsGroupTonga.hs --- a/examples/JointPhotographicExpertsGroupTonga.hs +++ b/examples/JointPhotographicExpertsGroupTonga.hs @@ -18,7 +18,7 @@ findUrl = fmap fromStrict . maybeResult . parse (manyTill (notChar '\n') (string "src=\"") *> takeTill (== '"')) jpgto :: Maybe Command -> IO Text -jpgto (Just (Command user channel (Just text))) = do +jpgto (Just (Command commandText user channel (Just text))) = do message <- (fmap messageOf . findUrl . decodeUtf8 . flip (^.) responseBody) <$> get ("http://" <> (unpack subdomain) <> ".jpg.to/") case (debug, message) of (True, _) -> putStrLn ("+ Pretending to post " <> (unpack . decodeUtf8 . encode) message) >> return "" diff --git a/linklater.cabal b/linklater.cabal --- a/linklater.cabal +++ b/linklater.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: linklater -version: 2.0.0.3 +version: 3.1.0.0 synopsis: The fast and fun way to write Slack.com bots homepage: https://github.com/hlian/linklater bug-reports: https://github.com/hlian/linklater/issues @@ -16,7 +16,7 @@ description: . - __A library for writing Slack chat bots.__ + A library for writing Slack chat bots. . Tutorial: . @@ -36,11 +36,9 @@ . * Open source (BSD3). . - For example, maybe you want this little guy to show up in your channel: - . - <> + Shamelessly cute example: . - Find out how by clicking on "Network.Linklater"! + <> extra-source-files: examples/*.hs @@ -57,23 +55,21 @@ library default-language: Haskell2010 ghc-options: -Wall -fwarn-tabs - if flag(developer) - ghc-options: -Werror exposed-modules: Network.Linklater build-depends: - base >=4.6 && <4.8, - wreq >=0.1.0.1 && <0.2, - lens >=4.3 && <4.4, - aeson >=0.7.0.6 && <0.8, - bytestring >=0.10.4.0 && <0.11, - text >=1.1.1.3 && <1.2, - containers >=0.5 && <0.6, - wai >=3.0.0.2 && <3.1, - http-types >=0.8.5 && <0.9, - hscolour + -- cabal told me to upper-constrain base + base <= 4.7.0.1 + , base-prelude >= 0.1.16 + , wreq >=0.2 + , aeson >=0.8 + , bytestring >=0.10.4.0 + , text >=1.1.1.3 + , containers >=0.5 + , wai >=3.0.0.2 + , http-types >=0.8.5 source-repository head type: git