packages feed

linklater 3.2.0.0 → 4.0.0.0

raw patch · 12 files changed

+413/−425 lines, 12 filesdep +exceptionsdep +lensdep +lens-aesondep ~basesetup-changed

Dependencies added: exceptions, lens, lens-aeson, linklater, mtl, safe-exceptions, tasty, tasty-hunit, uri-bytestring

Dependency ranges changed: base

Files

LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2014, Hao Lian+Copyright (c) 2014-2016, Hao Lian  All rights reserved.
− Network/Linklater.hs 
@@ -1,189 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE NoImplicitPrelude #-}---- |--- Module: Network.Linklater--- Copyright: (c) The Linklaterteers--- License: BSD-style--- 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 @http://baby.corgi.jpg.to@.------ <https://github.com/hlian/linklater/blob/master/examples/JointPhotographicExpertsGroupTonga.hs>------ One @/jpgto baby corgi@, et voila.------ <<https://raw.githubusercontent.com/hlian/linklater/6232b950a333cfa6d5fffea997ec9ab8c2ce31ba/corgi.jpg>>--module Network.Linklater-       (-         say,-         slash,-         slashSimple,-         Channel(..),-         User(..),-         Message(..),-         Config(..),-         Command(..),-         Icon(..),-         Format(..)-       ) where--import           BasePrelude-import           Data.Aeson--import qualified Data.ByteString.Lazy as BSL-import qualified Data.Map as M-import           Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Encoding as TE-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Encoding as TLE-import           Network.HTTP.Types (status200, parseSimpleQuery)-import qualified Network.Wai as W-import           Network.Wreq hiding (params, headers)---- | 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 ;).-  | IMChannel Text-  deriving (Eq, Ord, Show)---- | A username: no at-signs, just text!-newtype User = User Text deriving (Eq, Ord, Show)---- | 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.-  _commandChannel :: Channel,-  -- | Text for the slash command, if any.-  _commandText :: Maybe 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)---- | 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 (uncurry T.replace) 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 =-    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 (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" .= channel-               , "icon_emoji" .= (":" <> emoji <> ":")-               , "parse" .= String (if toParse then "full" else "poop")-               , "username" .= username-               , "text" .= raw-               , "unfurl_links" .= True-               ]---- | Like a curiosity about the world, you'll need one of these to--- 'say' something.-data Config = Config {-  -- | 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 (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--- 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 . TL.fromStrict))-  where-    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)--paramsIO :: W.Request -> IO (M.Map Text Text)-paramsIO req = do-  body <- W.strictRequestBody req-  return (M.fromList ((second TE.decodeUtf8 . first TE.decodeUtf8) <$> parseSimpleQuery (BSL.toStrict body)))---- | 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 = do-  params <- paramsIO req-  f (command (`M.lookup` params)) req respond-  where-    command paramOf = do-      user <- userOf <$> paramOf "user_name"-      Command <$> (nameOf <$> paramOf "command")-              <*> return user-              <*> (paramOf "channel_name" >>= channelOf user)-              <*> return (paramOf "text")-    userOf = User . T.filter (/= '@')-    nameOf = T.filter (/= '/')
− README.md 
@@ -1,45 +0,0 @@-## Who let you in here?--Relax! I'm here to make your life easier. Has your company ever-switched to using [Slack](https://slack.com), and then you wanted to-write silly Slack bots in Haskell as a way to learn Haskell?--<sup>Really?<sup>Wow<sup>That was a pretty specific question.</sup></sup>--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!--* [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)--* [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;-  * 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`)-  * A warm, receptive maintainer with beautiful brown eyes;-  * Fully Haddock'd methods and module;-  * Open source (BSD3).--## Contributors--* [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
− Setup.hs 
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
− changelog 
@@ -1,33 +0,0 @@--*- markdown -*---## 2015-07-21 3.2.0--* Slack.com seems to have broken GET incoming hooks, so we're switching to POST-* Support for Stack-* Unconstrained dependencies--## 2015-04-01 3.1.0--* Removed: silly usage of GADTs-* Simpler: incoming hook tokens are now incoming hook URLs-* Corgi picture: made bigger-* Added: Command now carries the name of the command-  * Patch by Ulysses Popple-* Text: stricter!-  * I decided to make the library take strict texts only,-    as they are simpler to reason about and lead to fewer-    conversions: really only WAI vends lazy text-  * Sorry for the churn!--## 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--* Initial release-* slash and run-* Command, Channel, User, Message, Icon
− corgi.jpg

binary file changed (140843 → absent bytes)

− examples/JointPhotographicExpertsGroupTonga.hs 
@@ -1,93 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE NoImplicitPrelude #-}---- If writing Slack bots intrigues you, check out: https://github.com/hlian/linklater--import qualified Data.Text as T-import qualified Data.Text.Lazy as TL--import           Control.Lens ((^.))-import           Control.Monad.IO.Class (liftIO)-import           Control.Monad.Trans.Maybe (MaybeT, runMaybeT)-import           Data.Aeson (encode)-import           Data.ByteString.Lazy (ByteString)-import           Data.Char (isAlphaNum, isAscii)-import           Data.Text (Text)-import           Data.Text.Lazy.Encoding (decodeUtf8)-import           Network.HTTP.Base (urlEncode)-import           Network.Wai.Handler.Warp (run)---- Naked imports.-import           BasePrelude hiding (words, intercalate)-import           Data.Attoparsec.Text.Lazy-import           Network.Linklater-import           Network.Wreq hiding (params)--findURL :: ByteString -> Maybe Text-findURL =-  encode . parse (manyTill (notChar '\n') (string "src=\"") *> takeTill (== '"')) . decode-  where-    encode =-      maybeResult-    decode =-      decodeUtf8--configIO :: IO Config-configIO =-  Config <$> (T.filter (/= '\n') . T.pack <$> readFile "hook")--urlOf :: Text -> Text -> String-urlOf query path =-  "http://" <> urlEncode (T.unpack query) <> ".jpg.to/" <> T.unpack path--parseText :: Text -> Maybe (Text, Text)-parseText text =-  f (filter (/= "") (T.strip <$> T.splitOn "--" text))-  where-    f []             = mzero-    f [raw]          = return (parseRaw raw, "")-    f [raw, options] = return (parseRaw raw, "/" <> options)-    f _              = mzero-    parseRaw         = T.intercalate "." . T.words--liftMaybe :: Maybe a -> MaybeT IO a-liftMaybe = maybe mzero return--messageOfCommand :: Command -> MaybeT IO Message-messageOfCommand (Command "jpeg" _ _ (Nothing)) =-  mzero-messageOfCommand (Command "jpeg" user channel (Just text)) = do-  (query, path) <- liftMaybe (parseText text)-  response <- liftIO (get (urlOf query path))-  url <- liftMaybe (findURL $ response ^. responseBody)-  return (messageOf [FormatAt user, FormatLink url (query <> ".jpg.to" <> path)])-  where-    messageOf =-      FormattedMessage (EmojiIcon "gift") "jpgtobot" channel--jpgto :: Maybe Command -> IO Text-jpgto Nothing = do-  return "Unrecognized Slack request!"--jpgto (Just command) = do-  putStrLn ("+ Incoming command: " <> show command)-  config <- configIO-  message <- (runMaybeT . messageOfCommand) command-  putStrLn ("+ Outgoing messsage: " <> show (encode <$> message))-  case (debug, message) of-    (False, Just m) -> do-      say m config-      return ""-    (False, Nothing) ->-      return "*FRIZZLE* ERROR PROCESSING INPUT; BEGIN SELF-DETONATION; PLEASE FILE ISSUE AT <https://github.com/hlian/jpgtobot>"-    _ ->-      return ""-  where-    debug = False--main :: IO ()-main = do-  putStrLn ("+ Listening on port " <> show port)-  run port (slashSimple jpgto)-    where-      port = 3333
+ lib/Network/Linklater.hs view
@@ -0,0 +1,134 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE NoImplicitPrelude #-}++-- |+-- Module: Network.Linklater+-- Copyright: (c) The Linklaterteers+-- License: BSD-style+-- 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 @http://baby.corgi.jpg.to@.+--+-- <https://github.com/hlian/linklater/blob/master/examples/JointPhotographicExpertsGroupTonga.hs>+--+-- One @/jpgto baby corgi@, et voila.+--+-- <<https://raw.githubusercontent.com/hlian/linklater/6232b950a333cfa6d5fffea997ec9ab8c2ce31ba/corgi.jpg>>++module Network.Linklater+       (+         -- * Types+         Channel(..),+         User(..),+         Message(..),+         Config(..),+         Command(..),+         Icon(..),+         Format(..),+         -- * API calls+         say,+         startRTM,+         startRTMWithOptions,+         -- * HTTP bot servers+         slash,+         slashSimple,+       ) where++import qualified Data.Aeson as Aeson+import           Network.HTTP.Types (status200, status400, parseSimpleQuery, ResponseHeaders)+import           Network.Wai (responseLBS, strictRequestBody, Application, Request)+import qualified Network.Wai as Wai+import qualified URI.ByteString as URI++import           Control.Lens+import           Control.Monad.Except+import           Data.Aeson.Lens+import           Data.Text.Strict.Lens+import           Network.Linklater.Batteries+import           Network.Linklater.Types+import           Network.Wreq hiding (Response, params, headers)+++headers :: ResponseHeaders+headers =+  [("Content-type", "text/plain")]++responseOf :: Status -> Text -> Wai.Response+responseOf status message =+  responseLBS status headers (message ^. (re utf8 . lazy))++-- | 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 :: (Command -> IO Text) -> Application+slashSimple f =+  slash (\command _ respond -> f command >>= (respond . responseOf status200))++-- | 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 :: (Command -> Application) -> Application+slash inner req respond = do+  params <- _paramsIO req+  case commandOfParams params of+    Right command ->+      inner command req respond+    Left msg ->+      respond (responseOf status400 ("linklater: unable to parse request: " <> msg ^. packed))++----------------------------------------+-- ~ API calls ~++-- | I POST a 'Message' to Slack and return the HTTP response.+-- However, I need a 'Config' (containing an incoming hook configured+-- through Slack administration) first.+--+-- Guaranted to not throw an unchecked exception.+say :: (MonadError RequestError m, MonadIO m) => Message -> Config -> m ()+say message Config{..} = do+  _ <- tryRequest (postWith _reasonableOptions (_configHookURL ^. unpacked) (Aeson.encode message))+  pure ()++-- | I GET a WebSocket 'URI' from Slack's real-time messaging+-- endpoint. However, I need an 'APIToken' (configured through Slack+-- administration) first.+--+-- Guaranted to not throw an unchecked exception.+startRTM :: (MonadError RequestError m, MonadIO m) => APIToken -> m URI.URI+startRTM token =+  startRTMWithOptions (_reasonableOptions & authenticate)+  where+    authenticate =+       (param "token" .~ [view coerced token]) . (param "simple_latest" .~ ["1"]) . (param "no_unreads" .~ ["1"])++startRTMWithOptions :: (MonadError RequestError m, MonadIO m) => Options -> m URI.URI+startRTMWithOptions opts = do+  response <- tryRequest (getWith opts (_u "/api/rtm.start"))+  (value :: Aeson.Value) <- Aeson.eitherDecode (response ^. responseBody) & promoteEither response id+  rawURI <- value ^? key "url" . _String . re utf8 & promoteMaybe response (show value)+  URI.parseURI URI.strictURIParserOptions rawURI & promoteEither response show++----------------------------------------+-- ~ Helpers ~++-- | Disables Wreq's default behavior of throwing exceptions, which+-- seems reckless+_reasonableOptions :: Options+_reasonableOptions =+  defaults & checkResponse .~ Nothing++_paramsIO :: Request -> IO (Map Text Text)+_paramsIO req = do+  lazyBytes <- strictRequestBody req+  let query = lazyBytes ^.. (strict . to parseSimpleQuery . traverse . to (both %~ view utf8))+  return (fromList query)++_u :: String -> String+_u = ("https://slack.com" ++)
+ lib/Network/Linklater/Batteries.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Network.Linklater.Batteries (module X) where++import BasePrelude as X hiding ((&), lazy)+import Control.Monad.Catch as X+  (MonadThrow(..))+import Control.Monad.Reader as X+  (MonadIO(..))+import Data.Map as X (Map)+import Data.Text as X (Text)+import GHC.Exts as X (fromList)
+ lib/Network/Linklater/Types.hs view
@@ -0,0 +1,168 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Network.Linklater.Types where++import qualified Control.Exception.Safe as Ex+import qualified Data.ByteString.Lazy as LazyBytes+import qualified Data.Map as Map+import           Data.Text (Text)+import qualified Data.Text as Text+import qualified Network.Wreq as Wreq++import           BasePrelude+import           Control.Lens hiding ((.=))+import           Control.Monad.Except+import           Data.Aeson++-- | The unique 'C<number>' Slack assigns to each channel. Used to+-- 'say' things.+type ChannelID = Text++-- | Where 'slash' commands come from and where 'Message's go.+data Channel = Channel !ChannelID !Text deriving (Eq, Ord, Show)++-- | A username: no at-signs, just text!+newtype User = User Text deriving (Eq, Ord, Show)++-- | 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.+  _commandChannel :: !Channel,+  -- | Text for the slash command, if any.+  _commandText :: !(Maybe 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)++-- | 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++-- | 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 =+    SimpleMessage !Icon !Text !Channel !Text+  | FormattedMessage !Icon !Text !Channel ![Format]++-- | Like a curiosity about the world, you'll need one of these to+-- 'say' something.+data Config = Config {+  -- | This is the incoming web hook URL that Slack gave you. It's+  -- usually @https://hooks.slack.com/services/...@.+  _configHookURL :: !Text+  }++-- | An API token, either a tester token or one obtained through+-- OAuth.+--+-- See:+--+--  * @https://api.slack.com/docs/oauth-test-tokens@+--+--  * @https://api.slack.com/docs/oauth@+newtype APIToken =+  APIToken Text+  deriving (Show, Eq, Ord)++type Response = Wreq.Response LazyBytes.ByteString++-- | Rather than throwing unchecked exceptions from our HTTP requests,+-- we catch all unchecked exceptions and convert them to checked+-- 'RequestError' values.+data RequestError =+  RequestError { _requestErrorException :: !(Maybe SomeException)+                 -- ^ An unchecked exception, typically 'IOException', occurred+               , _requestErrorResponse :: !(Maybe Response)+                 -- ^ Something awry with the response, typically a non-2xx response+               , _requestErrorDecoding :: !(Maybe String)+                 -- ^ Something awry with the JSON decoding+               } deriving Show++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 (uncurry Text.replace) t (asList [("<", "&lt;"), (">", "&gt;"), ("&", "&amp;")])++commandOfParams :: Map.Map Text Text -> Either String Command+commandOfParams params = do+  user <- userOf <$> paramOf "user_name"+  channel <- Channel <$> paramOf "channel_id" <*> paramOf "channel_name"+  Command <$> (nameOf <$> paramOf "command")+          <*> pure user+          <*> pure channel+          <*> pure (either (const Nothing) Just (paramOf "text"))+  where+    userOf = User . Text.filter (/= '@')+    nameOf = Text.filter (/= '/')+    paramOf key = case params ^. at key of+      Just value -> Right value+      Nothing -> Left ("paramOf: no key: " <> show key)++tryRequest :: (MonadIO m, MonadError RequestError m) => IO Response -> m Response+tryRequest io = do+  either_ <- liftIO $ Ex.try io+  case either_ of+    Left e ->+      throwError (RequestError (Just e) Nothing Nothing)+    Right response -> do+      let code = response ^. Wreq.responseStatus . Wreq.statusCode+      if code >= 200 && code < 300 then+        pure response+      else+        throwError (RequestError Nothing (Just response) Nothing)++promoteEither :: MonadError RequestError m => Response -> (l -> String) -> Either l r -> m r+promoteEither response l2s =+  \case Left l -> throwError $ RequestError Nothing (Just response) (Just $ l2s l)+        Right r -> pure r++promoteMaybe :: MonadError RequestError m => Response -> String -> Maybe r -> m r+promoteMaybe response s =+  \case Nothing -> throwError $ RequestError Nothing (Just response) (Just s)+        Just r -> pure r++asList :: [a] -> [a]+asList = id++instance ToJSON Channel where+  toJSON (Channel cid _) = toJSON cid++instance ToJSON Message where+  toJSON m = case m of+    (FormattedMessage emoji username channel formats) ->+      toJSON_ emoji username channel (Text.unwords (unformat <$> formats)) False+    (SimpleMessage emoji username channel text) ->+      toJSON_ emoji username channel text True+    where+      toJSON_ (EmojiIcon emoji) username channel raw toParse =+        object [ "channel" .= channel+               , "icon_emoji" .= (":" <> emoji <> ":")+               , "parse" .= String (if toParse then "full" else "poop")+               , "username" .= username+               , "text" .= raw+               , "unfurl_links" .= True+               ]
linklater.cabal view
@@ -1,72 +1,71 @@--- Initial linklater.cabal generated by cabal init. For further--- documentation, see http://haskell.org/cabal/users-guide/--name: linklater-version: 3.2.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 <me@haolian.org>-maintainer: me@haolian.org-category: Network-build-type: Simple-cabal-version: >=1.10--description:-  .-  A library for writing <https://slack.com/> Slack chat bots.-  .-  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;-  .-  * Supports <https://api.slack.com/docs/formatting Slack's formatting syntax>-  .-  * Comes with a fast mode (@slashSimple@) and a power mode (@slash@)-  .-  * A warm, receptive maintainer with beautiful brown eyes;-  .-  * Fully Haddock'd methods and module;-  .-  * Open source (BSD3).-  .-  Shamelessly cute example:-  .-  <<https://raw.githubusercontent.com/hlian/linklater/38536bebf00c60fb1214b2c3a741ce00485e87af/corgi.jpg>>--extra-source-files:-  examples/*.hs-  README.md-  changelog+-- This file has been generated from package.yaml by hpack version 0.17.0.+--+-- see: https://github.com/sol/hpack -extra-doc-files:-  corgi.jpg+name:           linklater+version:        4.0.0.0+synopsis:       A Haskell library for the Slack API+description:    <https://github.com/hlian/linklater/blob/master/README.md ~please see our lovely README.md~>+category:       Network+homepage:       https://github.com/hlian/linklater+bug-reports:    https://github.com/hlian/linklater/issues+author:         Hao Lian <hi@haolian.org>+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10  library-  default-language: Haskell2010-  ghc-options: -Wall -fwarn-tabs-+  hs-source-dirs:+      lib/+  default-extensions: FlexibleContexts LambdaCase OverloadedLists OverloadedStrings ScopedTypeVariables+  build-depends:+      aeson+    , base >= 4.9.1.0 && < 5+    , base-prelude+    , bytestring+    , containers+    , exceptions+    , http-types+    , lens+    , lens-aeson+    , mtl+    , safe-exceptions+    , tasty+    , tasty-hunit+    , text+    , uri-bytestring+    , wai+    , wreq   exposed-modules:-    Network.Linklater+      Network.Linklater+      Network.Linklater.Batteries+      Network.Linklater.Types+  default-language: Haskell2010 +test-suite linklater-tests+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs:+      test/+  default-extensions: FlexibleContexts LambdaCase OverloadedLists OverloadedStrings ScopedTypeVariables   build-depends:-    -- cabal told me to upper-constrain base-      base < 4.9+      aeson+    , base >= 4.9.1.0 && < 5     , base-prelude-    , wreq-    , aeson     , bytestring-    , text     , containers-    , wai+    , exceptions     , http-types--source-repository head-  type: git-  location: https://github.com/hlian/linklater+    , lens+    , lens-aeson+    , mtl+    , safe-exceptions+    , tasty+    , tasty-hunit+    , text+    , uri-bytestring+    , wai+    , wreq+    , linklater+  default-language: Haskell2010
+ test/Main.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import qualified Data.Map as Map++import Network.Linklater.Types++import Test.Tasty+import Test.Tasty.HUnit++commandOfParamsTest :: Assertion+commandOfParamsTest =+  commandOfParams incoming @?= fixture+  where+    fixture =+      Right (Command "prove" (User "Knuth") (Channel "C2147483705" "test") (Just "text"))+    incoming = Map.fromList [+        ("token", "XXXXXXXXXXXXXXXXXX")+      , ("team_id", "T0001")+      , ("team_domain", "example")+      , ("channel_id", "C2147483705")+      , ("channel_name", "test")+      , ("timestamp", "1355517523.000005")+      , ("user_id", "U2147483697")+      , ("user_name", "Knuth")+      , ("text", "text")+      , ("command", "/prove")+      ]++unitTests :: TestTree+unitTests =+  testGroup "unit" [testCase "commandOfParams" commandOfParamsTest]++main :: IO ()+main =+  defaultMain unitTests