gitter 0.2.0 → 0.3.0

raw patch · 8 files changed

+136/−138 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• gitter.cabal +5/−6
• src/Control/Monad/Trans/X.hs +0/−6
• src/Gitter.hs +78/−0
• src/Gitter/Monad.hs +12/−0
• src/Gitter/Types.hs +41/−0
• src/Network/Gitter.hs +0/−78
• src/Network/Gitter/Monad.hs +0/−13
• src/Network/Gitter/Types.hs +0/−35

@@ -1,5 +1,5 @@ name:           gitter-version:        0.2.0+version:        0.3.0                 -- ^ SemVer synopsis:       Gitter.im API client description:    Gitter.im is a programmers-oriented GitHub-based web-chat.@@ -24,12 +24,11 @@                       , text        >= 1.2.2.1  && < 1.3                       , wreq        >= 0.5.0.1  && < 0.6     default-language:   Haskell2010-    exposed-modules:    Network.Gitter-                        Network.Gitter.Monad-                        Network.Gitter.Types+    exposed-modules:    Gitter+                        Gitter.Monad+                        Gitter.Types     hs-source-dirs:     src-    other-modules:      Control.Monad.Trans.X-                        Data.String.X+    other-modules:      Data.String.X  source-repository head     type:     git

@@ -1,6 +0,0 @@-module Control.Monad.Trans.X where--import           Control.Monad.Trans--lift2 :: (Monad m, MonadTrans t) => (a -> b -> m c) -> a -> b -> t m c-lift2 f a b = lift (f a b)

@@ -0,0 +1,78 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}++module Gitter+    ( Gitter (..)+    , GitterT+    , runGitterT+    , sendChatMessage+    , withRoom+    ) where++import           Control.Lens ((&~), (?=), (^.), (^?))+import           Control.Monad (void)+import           Control.Monad.Catch (MonadThrow)+import           Control.Monad.IO.Class (MonadIO, liftIO)+import           Control.Monad.Reader (ReaderT, ask, runReaderT)+import           Control.Monad.Trans (MonadTrans, lift)+import           Data.Aeson (Value (String), object)+import           Data.Aeson.Lens (key, _String)+import qualified Data.ByteString.Char8 as ByteString+import qualified Data.List as List+import           Data.Monoid ((<>))+import           Data.Text (Text)+import qualified Data.Text as Text+import           Network.Wreq (asJSON, auth, defaults, oauth2Bearer, postWith,+                               responseBody)++import Gitter.Monad (MonadGitter (runGitterAction))+import Gitter.Types (Gitter (..), ResourcePath, Room (ONETOONE, REPO), RoomId,+                     RoomUri)++newtype GitterT m a = GitterT (ReaderT Gitter m a)+    deriving (Applicative, Functor, Monad, MonadIO, MonadThrow, MonadTrans)++runGitterT :: Gitter -> GitterT m a -> m a+runGitterT gitter (GitterT readerAction) = runReaderT readerAction gitter++newtype GitterRoomT m a = GitterRoomT (ReaderT Room m a)+    deriving Functor++roomUri :: Room -> RoomUri+roomUri (ONETOONE user)  = user+roomUri (REPO user repo) = user <> "/" <> repo++withRoom :: Room -> GitterRoomT gitter a -> gitter a+withRoom room (GitterRoomT readerAction) =+    runReaderT readerAction room++sendChatMessage :: MonadGitter m => Text -> GitterRoomT m ()+sendChatMessage text =+    void . runRoomAction ["chatMessages"] $ object [("text", String text)]++runRoomAction :: MonadGitter m => ResourcePath -> Value -> GitterRoomT m Value+runRoomAction path request = GitterRoomT $ do+    room <- ask+    roomId <- lift $ joinRoom room+    lift $ runGitterAction (["rooms", roomId] <> path) request++joinRoom :: MonadGitter m => Room -> m RoomId+joinRoom room = do+    jsonResponse <- runGitterAction ["rooms"] $+        object [("uri", String $ roomUri room)]+    maybe (fail "joining room must return a string \"id\"") return $+        jsonResponse ^? key "id" . _String++instance (MonadIO io, MonadThrow io) => MonadGitter (GitterT io) where+    runGitterAction path apiRequest = GitterT $ do+        Gitter{gitterBaseUrl, gitterTokenFile} <- ask+        tokenFileContents <- liftIO $ ByteString.readFile gitterTokenFile+        let token = normalizeSpace tokenFileContents+            url = List.intercalate "/" (gitterBaseUrl : fmap Text.unpack path)+            opts = defaults &~ auth ?= oauth2Bearer token+        response <- liftIO (postWith opts url apiRequest)+        jsonResponse <- asJSON response+        return (jsonResponse ^. responseBody)+      where+        normalizeSpace = ByteString.unwords . ByteString.words

@@ -0,0 +1,12 @@+module Gitter.Monad (MonadGitter (..)) where++import Control.Monad.Reader (ReaderT, lift)+import Data.Aeson (Value)++import Gitter.Types (ResourcePath)++class Monad m => MonadGitter m where+    runGitterAction :: ResourcePath -> Value -> m Value++instance MonadGitter m => MonadGitter (ReaderT r m) where+    runGitterAction path = lift . runGitterAction path

@@ -0,0 +1,41 @@+{-# LANGUAGE TemplateHaskell #-}++module Gitter.Types+    ( Gitter (..)+    , ResourcePath+    , Room (..)+    , RoomId+    , RoomUri+    ) where++import Data.Aeson.TH (SumEncoding (TaggedObject), contentsFieldName,+                      defaultOptions, deriveJSON, fieldLabelModifier,+                      sumEncoding, tagFieldName)+import Data.String.X (dropPrefix)+import Data.Text (Text)++type ResourcePath = [Text]+type UserName = Text+type RepoName = Text+type RoomId = Text+type RoomUri = Text++data Room+    = ONETOONE UserName+    | REPO UserName RepoName+    deriving Show++deriveJSON+    defaultOptions+        { sumEncoding =+              TaggedObject{tagFieldName = "type", contentsFieldName = "uri"}+        }+    ''Room++data Gitter = Gitter+    { gitterBaseUrl   :: String+    , gitterRoom      :: Room+    , gitterTokenFile :: FilePath+    }++deriveJSON defaultOptions{fieldLabelModifier = dropPrefix "gitter"} ''Gitter

@@ -1,78 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE NamedFieldPuns             #-}-{-# LANGUAGE OverloadedStrings          #-}--module Network.Gitter-    ( Gitter(..)-    , GitterT-    , runGitterT-    , sendChatMessage-    , withRoom-    ) where--import           Control.Lens           ((&~), (?=), (^.), (^?))-import           Control.Monad          (void)-import           Control.Monad.Catch    (MonadThrow)-import           Control.Monad.IO.Class (MonadIO, liftIO)-import           Control.Monad.Reader   (ReaderT, ask, runReaderT)-import           Control.Monad.Trans    (MonadTrans, lift)-import           Data.Aeson             (Value (String), object)-import           Data.Aeson.Lens        (key, _String)-import qualified Data.ByteString.Char8  as ByteString-import qualified Data.List              as List-import           Data.Monoid            ((<>))-import           Data.Text              (Text)-import qualified Data.Text              as Text-import           Network.Wreq           (asJSON, auth, defaults, oauth2Bearer,-                                         postWith, responseBody)--import           Network.Gitter.Monad   (MonadGitter (runGitterAction))-import           Network.Gitter.Types   (Gitter (..), ResourcePath,-                                         Room (ONETOONE, REPO), RoomId, RoomUri)--newtype GitterT m a = GitterT (ReaderT Gitter m a)-    deriving (Applicative, Functor, Monad, MonadIO, MonadThrow, MonadTrans)--runGitterT :: Gitter -> GitterT m a -> m a-runGitterT gitter (GitterT readerAction) = runReaderT readerAction gitter--newtype GitterRoomT m a = GitterRoomT (ReaderT Room m a)-    deriving Functor--roomUri :: Room -> RoomUri-roomUri (ONETOONE user)  = user-roomUri (REPO user repo) = user <> "/" <> repo--withRoom :: Room -> GitterRoomT gitter a -> gitter a-withRoom room (GitterRoomT readerAction) =-    runReaderT readerAction room--sendChatMessage :: MonadGitter m => Text -> GitterRoomT m ()-sendChatMessage text =-    void . runRoomAction ["chatMessages"] $ object [("text", String text)]--runRoomAction :: MonadGitter m => ResourcePath -> Value -> GitterRoomT m Value-runRoomAction path request = GitterRoomT $ do-    room <- ask-    roomId <- lift $ joinRoom room-    lift $ runGitterAction (["rooms", roomId] <> path) request--joinRoom :: MonadGitter m => Room -> m RoomId-joinRoom room = do-    jsonResponse <- runGitterAction ["rooms"] $-        object [("uri", String $ roomUri room)]-    maybe (fail "joining room must return a string \"id\"") return $-        jsonResponse ^? key "id" . _String--instance (MonadIO io, MonadThrow io) => MonadGitter (GitterT io) where-    runGitterAction path apiRequest = GitterT $ do-        Gitter{gitter_baseUrl, gitter_tokenFile} <- ask-        tokenFileContents <- liftIO $ ByteString.readFile gitter_tokenFile-        let token = normalizeSpace tokenFileContents-            url = List.intercalate "/" (gitter_baseUrl : fmap Text.unpack path)-            opts = defaults &~ auth ?= oauth2Bearer token-        response <- liftIO (postWith opts url apiRequest)-        jsonResponse <- asJSON response-        return (jsonResponse ^. responseBody)-      where-        normalizeSpace = ByteString.unwords . ByteString.words

@@ -1,13 +0,0 @@-module Network.Gitter.Monad where--import           Network.Gitter.Types--import           Control.Monad.Reader-import           Control.Monad.Trans.X-import           Data.Aeson--class Monad m => MonadGitter m where-    runGitterAction :: ResourcePath -> Value -> m Value--instance MonadGitter m => MonadGitter (ReaderT r m) where-    runGitterAction = lift2 runGitterAction

@@ -1,35 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}--module Network.Gitter.Types where--import           Data.Aeson.TH (SumEncoding (TaggedObject), contentsFieldName,-                                defaultOptions, deriveJSON, fieldLabelModifier,-                                sumEncoding, tagFieldName)-import           Data.String.X (dropPrefix)-import           Data.Text     (Text)--type ResourcePath = [Text]-type UserName = Text-type RepoName = Text-type RoomId = Text-type RoomUri = Text--data Room-    = ONETOONE UserName-    | REPO UserName RepoName-    deriving Show--deriveJSON-    defaultOptions-        { sumEncoding =-              TaggedObject{tagFieldName = "type", contentsFieldName = "uri"}-        }-    ''Room--data Gitter = Gitter-    { gitter_baseUrl   :: String-    , gitter_room      :: Room-    , gitter_tokenFile :: FilePath-    }--deriveJSON defaultOptions{fieldLabelModifier = dropPrefix "gitter_"} ''Gitter