packages feed

linklater 1.0.0.3 → 2.0.0.0

raw patch · 5 files changed

+191/−174 lines, 5 filesdep +http-typesbinary-addedPVP ok

version bump matches the API change (PVP)

Dependencies added: http-types

API changes (from Hackage documentation)

- Network.Linklater: Message :: Channel -> Text -> Icon -> Message
- Network.Linklater: _messageChannel :: Message -> Channel
- Network.Linklater: _messageIcon :: Message -> Icon
- Network.Linklater: _messageText :: Message -> Text
- Network.Linklater: instance Eq Message
- Network.Linklater: instance Ord Message
- Network.Linklater: instance Show Message
+ Network.Linklater: FormatAt :: User -> Format
+ Network.Linklater: FormatLink :: Text -> Text -> Format
+ Network.Linklater: FormatString :: Text -> Format
+ Network.Linklater: FormatUser :: User -> Text -> Format
+ Network.Linklater: FormattedMessage :: Icon -> Text -> Channel -> [Format] -> Message
+ Network.Linklater: SimpleMessage :: Icon -> Text -> Channel -> Text -> Message
+ Network.Linklater: data Format
+ Network.Linklater: slashSimple :: (Maybe Command -> IO Text) -> Application

Files

Network/Linklater.hs view
@@ -1,59 +1,44 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, GADTs #-}  -- | -- Module: Network.Linklater -- Copyright: (c) The Linklaterteers--- -- License: BSD-style+-- Maintainer: me@haolian.org -- Stability: experimental -- Portability: GHC ----- Features:------ * Uses @Text@ everywhere so you can send your slash commands crazy Unicode characters all day long.--- * Lovely documentation.--- * Battle-tested.--- -- 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 diplomatico@ in one of your channels, you'll get the--- image from @http://diplomatico.jpg.to@. How, you say? /Screen scraping/.------ @--- urlParser :: Parser B.ByteString--- urlParser = p---   where---     p = garbage *> url---     garbage = string "src=\"" <|> (P.take 1 *> garbage)---     url = takeTill (== _quotedbl)+-- type @/jpgto baby corgi@ in one of your channels, you'll get the+-- image from @http://baby.corgi.jpg.to@. How, you say? /Screen scraping/. ----- urlFor :: Text -> IO Text--- urlFor search = do---   r <- get (T.unpack $ F.format "http://{}.jpg.to/" [search])---   (return . handle . parse urlParser . strictly) (r ^. responseBody)---   where---     strictly = B.concat . L.toChunks---     handle (Fail i ctxs s) = error (show (i, ctxs, s))---     handle (Partial f) = handle (f "")---     handle (Done _ r) = toText r+-- > -- 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. <https://github.com/hlian/jpgtobot/blob/master/Main.hs>)"+-- >+-- > main :: IO ()+-- > main = let port = 3000 in putStrLn ("+ Listening on port " <> show port) >> run port (slashSimple jpgto) ----- jpgto :: Maybe Command -> Application--- jpgto (Just (Command (User user) channel text)) req respond = do---   url <- urlFor (maybe "spolsky" id text)---   say (Message channel (response url) (EmojiIcon "gift")) config---   (respond . responseLBS status200 headers) ""---   where---     response url = F.format "@{} {}" (user, url)---     config = Config token "trello.slack.com"---     headers = [("Content-Type", "text/plain")]+-- One @/jpgto baby corgi@, et voila. ----- main :: IO ()--- main = do---   let port = 80---   putStrLn (F.format "+ Listening on port {}" [port])---   run port (slash jpgto)---    return ()--- @+-- <<corgi.jpg>> -- -- For the full example (since this one is missing a ton of imports), -- see the @examples/@ directory on GitHub.@@ -64,29 +49,33 @@        (          say,          slash,+         slashSimple,          Channel(..),          User(..),          Message(..),          Config(..),          Command(..),          Icon(..),+         Format(..)        ) where  import Control.Applicative ((<$>)) import Data.Aeson-import Data.ByteString.Lazy as BSL+import qualified Data.ByteString.Lazy as BSL import qualified Data.Map as M+import Data.Monoid import Data.Text.Lazy (Text)-import qualified Data.Text.Lazy.Encoding as TLE import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TLE+import Network.HTTP.Types (status200) import qualified Network.Wai as W-import Network.Wreq hiding (params)+import Network.Wreq hiding (params, headers) --- | Where slash commands can come from, and where messages can go.+-- | Where 'slash' commands come from, and where 'Message's go. data Channel =    -- | A public or private group.     GroupChannel Text-  -- | A private conversation with your best friend (or lover?).+  -- | A private conversation with your best friend -- or lover ;).   | IMChannel Text   deriving (Eq, Ord, Show) @@ -104,55 +93,94 @@   _commandText :: Maybe Text   } deriving (Eq, Ord, Show) --- | For example, @":stars2:"@. Future versions should support actual--- images, I GUESS.-newtype Icon = EmojiIcon Text deriving (Eq, Ord, Show)+-- | The icon next to the messages you `say`. (Images unsupported+-- right now, sorry.)+newtype Icon =+  -- | For example, ":stars2:".+  EmojiIcon Text deriving (Eq, Ord, Show) --- | Here's how you talk.-data Message = Message {-  -- | You need a channel. It can be a group channel or a private IM.-  -- Alert: if it's a private IM, it'll look like it came from-  -- slackbot (as of writing).-  _messageChannel :: Channel,-  -- | What you want to say. This will be parsed in full (parse=full).-  -- In the future I'll support other forms of parsing, hopefully.-  -- Poke me with a pull request if I forget.-  _messageText :: Text,-  -- | The icon you want your message to appear as.-  _messageIcon :: Icon-  } deriving (Eq, Ord, Show)+-- | A little DSL for <https://api.slack.com/docs/formatting Slack formatting>.+data Format =+  -- | @"\<\@user|user>"@+    FormatAt User+  -- | @"\<\@user|user did this and that>"@+  | FormatUser User Text+  -- | @"\<http://example.com|user did this and that>"@+  | FormatLink Text Text+  -- | @"user did this &amp; that"@+  | FormatString Text +unformat :: Format -> Text+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 [("<", "&lt;"), (">", "&gt;"), ("&", "&amp;")]++-- | 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+-- using 'Data.Aeson'.+--+--   * Simple messages are parsed by Slack with parse=full (i.e. as if you had typed it into the input box).+--+--   * 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+ instance ToJSON Message where-  toJSON (Message channel text (EmojiIcon emoji)) =-    object [ "channel" .= stringOfChannel channel-           , "icon_emoji" .= TL.concat [":", emoji, ":"]-           , "parse" .= String "full"-           , "username" .= String "jpgtobot"-           , "text" .= text-           ]+  toJSON m = case m of+    (FormattedMessage emoji username channel formats) ->+      toJSON_ emoji username channel (TL.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, ":"]+               , "parse" .= String (if toParse then "full" else "poop")+               , "username" .= username+               , "text" .= raw+               , "unfurl_links" .= True+               ]       stringOfChannel (GroupChannel c) = TL.concat ["#", c]-      stringOfChannel (IMChannel m) = TL.concat ["@", m]+      stringOfChannel (IMChannel im) = TL.concat ["@", im] --- | Like a curiosity about the world, you'll need one of these to say something.+-- | Like a curiosity about the world, you'll need one of these to+-- 'say' something. data Config = Config {-  -- | This is the incoming web hook token that Slack gave you. It's usually a long alphanumberic string of garbage.-  _configIncomingHookToken :: Text,-  -- | This is where your Slack account is hosted. For example, 'trello.slack.com'.-  _configHostname :: Text+  -- | 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   } --- | The 'say' function posts a Message, with a capital M, to Slack.--- It'll, ahem, need your token first though.-say :: Message -> Config -> IO (Response ByteString)+-- | 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] --- | A bot server! As if by magic. This acts like a WAI middleware in--- that you let us wrap around your application.+-- | 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+-- convert it into a 'Network.WAI' application. If you want more+-- control over the request and respond, see 'slash'.+slashSimple :: (Maybe Command -> IO Text) -> W.Application+slashSimple f =+  slash (\command _ respond -> f command >>= (respond . makeResponse))+  where+    headers = [("Content-type", "text/plain")]+    makeResponse = W.responseLBS status200 headers . TLE.encodeUtf8++-- | 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+-- request.) slash :: (Maybe Command -> W.Application) -> W.Application slash f req respond = f command req respond   where
README.md view
@@ -8,6 +8,13 @@  Uh, do you want to be friends? Well let's talk about it later, because right now I have an example for you. +But you'll have to grab me first:++* `cabal sandbox init`+* `cabal install linklater`++If you don't have Haskell, it's quite easy: [Windows](http://www.haskell.org/platform/), [Mac](http://ghcformacosx.github.io/), and [Linux](https://gist.githubusercontent.com/hlian/b5a975252997cb3e0020/raw/e4ecab3042225d321a88ee74e804c38ead38ed52/gistfile1.txt).+ ## Show me an example!  Here's a `/jpgto` bot. If you run this program and then tell Slack@@ -16,42 +23,27 @@ image from [http://diplomatico.jpg.to](http://diplomatico.jpg.to). How, you say? _Screen scraping_.  ```haskell-import Network.Linklater (say, slash,-                          Command(..), Config(..), Icon(..), Message(..), User(..))--urlParser :: Parser B.ByteString-urlParser = p-  where-    p = garbage *> url-    garbage = string "src=\"" <|> (P.take 1 *> garbage)-    url = takeTill (== _quotedbl)+-- Remaining imports left as an exercise to the reader.+import Network.Linklater (say, slashSimple, Command(..), Config(..), Message(..), Icon(..), Format(..)) -urlFor :: Text -> IO Text-urlFor search = do-  r <- get (T.unpack $ F.format "http://{}.jpg.to/" [search])-  (return . handle . parse urlParser . strictly) (r ^. responseBody)-  where-    strictly = B.concat . L.toChunks-    handle (Fail i ctxs s) = error (show (i, ctxs, s))-    handle (Partial f) = handle (f "")-    handle (Done _ r) = toText r+findUrl :: Text -> Maybe Text+findUrl = fmap fromStrict . maybeResult . parse (manyTill (notChar '\n') (string "src=\"") *> takeTill (== '"')) -jpgto :: Maybe Command -> Application-jpgto (Just (Command (User user) channel text)) req respond = do-  url <- urlFor (maybe "spolsky" id text)-  say (Message channel (response url) (EmojiIcon "gift")) config-  (respond . responseLBS status200 headers) ""-  where-    response url = F.format "@{} {}" (user, url)-    config = Config token "trello.slack.com"-    headers = [("Content-Type", "text/plain")]+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. <https://github.com/hlian/jpgtobot/blob/master/Main.hs>)"  main :: IO ()-main = do-  let port = 80-  putStrLn (F.format "+ Listening on port {}" [port])-  run port (slash jpgto)-  return ()+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
+ corgi.jpg view

binary file changed (absent → 84648 bytes)

examples/JointPhotographicExpertsGroupTonga.hs view
@@ -1,63 +1,37 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, NoImplicitPrelude #-} +-- Full package here: https://github.com/hlian/jpgtobot/ module JointPhotographicExpertsGroupTonga where -import           Control.Applicative-import           Control.Lens hiding ((.=))-import           Control.Monad-import           Data.Attoparsec.ByteString-import qualified Data.Attoparsec.ByteString as P-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as L-import qualified Data.Text.Format as F-import           Data.Text.Lazy (Text)-import qualified Data.Text.Lazy as T-import           Data.Text.Lazy.Encoding (decodeUtf8)-import           Data.Text.Lazy.IO-import           Data.Word8-import           Network.HTTP.Types (status200)-import           Network.Linklater-import           Network.Wai-import           Network.Wai.Handler.Warp (run)-import           Network.Wreq hiding (params, headers)-import           Prelude hiding (readFile, writeFile, putStrLn)--toText :: B.ByteString -> Text-toText = decodeUtf8 . L.fromChunks . return--token :: Text-token = undefined+import BasePrelude hiding (words, intercalate)+import Control.Lens ((^.))+import Data.Attoparsec.Text.Lazy+import Data.Text.Lazy hiding (filter)+import Data.Text.Lazy.Encoding (decodeUtf8)+import Network.HTTP.Types (status200)+import Network.Linklater (say, slash, Channel(..), Command(..), User(..), Config(..), Message(..), Icon(..))+import Network.Wai (Application, responseLBS)+import Network.Wai.Handler.Warp (run)+import Network.Wreq hiding (params) -urlParser :: Parser B.ByteString-urlParser = p-  where-    p = garbage *> url-    garbage = string "src=\"" <|> (P.take 1 *> garbage)-    url = takeTill (== _quotedbl)+findUrl :: Text -> Maybe Text+findUrl = fmap fromStrict . maybeResult . parse (manyTill (notChar '\n') (string "src=\"") *> takeTill (== '"')) -urlFor :: Text -> IO Text-urlFor search = do-  r <- get (T.unpack $ F.format "http://{}.jpg.to/" [search])-  (return . handle . parse urlParser . strictly) (r ^. responseBody)-  where-    strictly = B.concat . L.toChunks-    handle (Fail i ctxs s) = error (show (i, ctxs, s))-    handle (Partial f) = handle (f "")-    handle (Done _ r) = toText r+messageOf :: User -> Channel -> Text -> Text -> Message+messageOf (User u) c search = Message (EmojiIcon "gift") c . mappend (mconcat ["@", u, " Hello, wanderer. I found you this for \"", search, "\": "])  jpgto :: Maybe Command -> Application-jpgto (Just (Command (User user) channel text)) req respond = do-  url <- urlFor (maybe "spolsky" id text)-  say (Message channel (response url) (EmojiIcon "gift")) config-  (respond . responseLBS status200 headers) ""-  where-    response url = F.format "@{} {}" (user, url)-    config = Config token "trello.slack.com"-    headers = [("Content-Type", "text/plain")]+jpgto (Just (Command user channel (Just text))) _ respond = do+  message <- get url >>= (return . fmap (messageOf user channel text) . findUrl . decodeUtf8 . flip (^.) responseBody)+  case (debug, message) of+    (True, _) -> putStrLn ("+ Pretending to post " <> show message) >> respondWith ""+    (False, Just m) -> config' >>= say m >> respondWith ""+    (False, Nothing) -> respondWith "Something went wrong!"+  where ourHeaders = [("Content-Type", "text/plain")]+        respondWith = respond . responseLBS status200 ourHeaders+        config' = (Config "trello.slack.com" . pack . filter (/= '\n')) <$> readFile "token"+        url = "http://" <> (unpack . intercalate "." . words $ text) <> ".jpg.to/"+        debug = True  main :: IO ()-main = do-  let port = 80-  putStrLn (F.format "+ Listening on port {}" [port])-  run port (slash jpgto)-  return ()+main = let port = 3000 in putStrLn ("+ Listening on port " <> show port) >> run port (slash jpgto)
linklater.cabal view
@@ -2,12 +2,13 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name: linklater-version: 1.0.0.3-synopsis: Write bots for your Slack account, and then go to sleep (because it's so easy and late at night)+version: 2.0.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 license: BSD3 license-file: LICENSE-author: Hao Lian+author: Hao Lian <me@haolian.org> maintainer: me@haolian.org category: Network build-type: Simple@@ -15,15 +16,32 @@  description:   .-  A library for writing <https://slack.com/> Slack chat bots.+  __A library for writing <https://slack.com/> Slack chat bots.__   .-  A mistake?+  Tutorial: <https://github.com/hlian/linklater/wiki/Tutorial>+  .+  Features you could take advantage of /right now, should you choose/:+  .+  * Uses 'Text' for state-of-the-art Unicode support;+  * Lovely documentation with no misspelllllings to be found;+  * A warm, receptive maintainer with beautiful brown eyes;+  * Fully Haddock'd methods and module;+  * Open source (BSD3).+  .+  For example, maybe you want this little guy to show up in your channel:+  .+  <<corgi.jpg>>+  .+  Find out how by clicking on "Network.Linklater"!  extra-source-files:   examples/*.hs   README.md   changelog +extra-doc-files:+  corgi.jpg+ flag developer   default: False   manual: True@@ -45,4 +63,9 @@     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+    wai >=3.0.0.2 && <3.1,+    http-types >=0.8.5 && <0.9++source-repository head+  type: git+  location: https://github.com/hlian/linklater