telega (empty) → 0.1.0
raw patch · 20 files changed
+472/−0 lines, 20 filesdep +aesondep +basedep +http-clientsetup-changed
Dependencies added: aeson, base, http-client, lens, text, transformers, wreq
Files
- CHANGELOG.md +0/−0
- LICENSE +29/−0
- Network/Telegram/API/Bot.hs +6/−0
- Network/Telegram/API/Bot/Capacity.hs +5/−0
- Network/Telegram/API/Bot/Capacity/Editable.hs +28/−0
- Network/Telegram/API/Bot/Capacity/Postable.hs +28/−0
- Network/Telegram/API/Bot/Capacity/Purgeable.hs +28/−0
- Network/Telegram/API/Bot/Core.hs +28/−0
- Network/Telegram/API/Bot/Object.hs +9/−0
- Network/Telegram/API/Bot/Object/Button.hs +30/−0
- Network/Telegram/API/Bot/Object/Callback.hs +13/−0
- Network/Telegram/API/Bot/Object/Chat.hs +31/−0
- Network/Telegram/API/Bot/Object/From.hs +52/−0
- Network/Telegram/API/Bot/Object/Keyboard.hs +25/−0
- Network/Telegram/API/Bot/Object/Message.hs +68/−0
- Network/Telegram/API/Bot/Object/Update.hs +30/−0
- Network/Telegram/API/Bot/Property.hs +3/−0
- Network/Telegram/API/Bot/Property/Identifiable.hs +7/−0
- Setup.hs +2/−0
- telega.cabal +50/−0
+ CHANGELOG.md view
+ LICENSE view
@@ -0,0 +1,29 @@+BSD 3-Clause License++Copyright (c) 2019, Murat Kasimov+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++* Neither the name of the copyright holder nor the names of its+ contributors may be used to endorse or promote products derived from+ this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Network/Telegram/API/Bot.hs view
@@ -0,0 +1,6 @@+module Network.Telegram.API.Bot (module Exports) where++import Network.Telegram.API.Bot.Property as Exports+import Network.Telegram.API.Bot.Capacity as Exports+import Network.Telegram.API.Bot.Object as Exports+import Network.Telegram.API.Bot.Core as Exports
+ Network/Telegram/API/Bot/Capacity.hs view
@@ -0,0 +1,5 @@+module Network.Telegram.API.Bot.Capacity (module Exports) where++import Network.Telegram.API.Bot.Capacity.Purgeable as Exports+import Network.Telegram.API.Bot.Capacity.Postable as Exports+import Network.Telegram.API.Bot.Capacity.Editable as Exports
+ Network/Telegram/API/Bot/Capacity/Editable.hs view
@@ -0,0 +1,28 @@+module Network.Telegram.API.Bot.Capacity.Editable (Editable (..), Substitution) where++import "aeson" Data.Aeson (FromJSON, Value, decode)+import "base" Control.Exception (try)+import "base" Control.Monad (join)+import "base" Data.Maybe (fromJust)+import "http-client" Network.HTTP.Client (Response (responseBody))+import "text" Data.Text (unpack)+import "transformers" Control.Monad.Trans.Class (lift)+import "transformers" Control.Monad.Trans.Except (ExceptT (ExceptT))+import "transformers" Control.Monad.Trans.Reader (ask)++import qualified "wreq" Network.Wreq.Session as Wreq (post)++import Network.Telegram.API.Bot.Core (Telegram, Token (Token), Ok, result)++type family Substitution a = r | r -> a++class FromJSON a => Editable a where+ {-# MINIMAL substitution_value, edit_endpoint #-}+ substitution_value :: Substitution a -> Value+ edit_endpoint :: Substitution a -> String++ edit :: Substitution a -> Telegram e a+ edit x = snd <$> ask >>= \(session, Token token) -> lift . ExceptT . try+ . fmap (fromJust . join . fmap result . decode @(Ok a) . responseBody)+ . flip (Wreq.post session) (substitution_value x) $+ "https://api.telegram.org/" <> unpack token <> "/" <> edit_endpoint x
+ Network/Telegram/API/Bot/Capacity/Postable.hs view
@@ -0,0 +1,28 @@+module Network.Telegram.API.Bot.Capacity.Postable (Postable (..), Initial) where++import "aeson" Data.Aeson (FromJSON, Value, decode)+import "base" Control.Exception (try)+import "base" Control.Monad (join)+import "base" Data.Maybe (fromJust)+import "http-client" Network.HTTP.Client (Response (responseBody))+import "text" Data.Text (unpack)+import "transformers" Control.Monad.Trans.Class (lift)+import "transformers" Control.Monad.Trans.Except (ExceptT (ExceptT))+import "transformers" Control.Monad.Trans.Reader (ask)++import qualified "wreq" Network.Wreq.Session as Wreq (post)++import Network.Telegram.API.Bot.Core (Telegram, Token (Token), Ok, result)++type family Initial a = r | r -> a++class FromJSON a => Postable a where+ {-# MINIMAL initial_value, post_endpoint #-}+ initial_value :: Initial a -> Value+ post_endpoint :: Initial a -> String++ post :: Initial a -> Telegram e a+ post x = snd <$> ask >>= \(session, Token token) -> lift . ExceptT . try+ . fmap (fromJust . join . fmap result . decode @(Ok a) . responseBody)+ . flip (Wreq.post session) (initial_value x) $+ "https://api.telegram.org/" <> unpack token <> "/" <> post_endpoint x
+ Network/Telegram/API/Bot/Capacity/Purgeable.hs view
@@ -0,0 +1,28 @@+module Network.Telegram.API.Bot.Capacity.Purgeable (Purgeable (..), Marking) where++import "aeson" Data.Aeson (Value, decode)+import "base" Control.Exception (try)+import "base" Control.Monad (join, void)+import "base" Data.Maybe (fromJust)+import "http-client" Network.HTTP.Client (Response (responseBody))+import "text" Data.Text (unpack)+import "transformers" Control.Monad.Trans.Class (lift)+import "transformers" Control.Monad.Trans.Except (ExceptT (ExceptT))+import "transformers" Control.Monad.Trans.Reader (ask)++import qualified "wreq" Network.Wreq.Session as Wreq (post)++import Network.Telegram.API.Bot.Core (Telegram, Token (Token), Ok, result)++type family Marking a = r | r -> a++class Purgeable a where+ {-# MINIMAL marking_value, purge_endpoint #-}+ marking_value :: Marking a -> Value+ purge_endpoint :: Marking a -> String++ purge :: Marking a -> Telegram e ()+ purge x = snd <$> ask >>= \(session, Token token) -> void . lift . ExceptT . try+ . fmap (fromJust . join . fmap result . decode @(Ok ()) . responseBody)+ . flip (Wreq.post session) (marking_value x) $+ "https://api.telegram.org/" <> unpack token <> "/" <> purge_endpoint x
+ Network/Telegram/API/Bot/Core.hs view
@@ -0,0 +1,28 @@+module Network.Telegram.API.Bot.Core (Telegram, telegram, ask', Token (..), Ok, result) where++import "aeson" Data.Aeson (FromJSON (parseJSON), withObject, (.:))+import "base" Control.Exception (SomeException)+import "text" Data.Text (Text)+import "transformers" Control.Monad.Trans.Reader (ReaderT (runReaderT), ask)+import "transformers" Control.Monad.Trans.Except (ExceptT, runExceptT)+import "wreq" Network.Wreq.Session (Session)++newtype Token = Token Text deriving Eq++type Telegram e a = ReaderT (e, (Session, Token)) (ExceptT SomeException IO) a++telegram :: Session -> Token -> e -> Telegram e a -> IO (Either SomeException a)+telegram session token env = runExceptT . flip runReaderT (env, (session, token))++ask' :: Telegram e e+ask' = fst <$> ask++data Ok a = Ok Bool a deriving Show++result :: Ok a -> Maybe a+result (Ok True x) = Just x+result (Ok False _ ) = Nothing++instance FromJSON a => FromJSON (Ok a) where+ parseJSON = withObject "Ok" $ \v ->+ Ok <$> v .: "ok" <*> v .: "result"
+ Network/Telegram/API/Bot/Object.hs view
@@ -0,0 +1,9 @@+module Network.Telegram.API.Bot.Object (module Exports) where++import Network.Telegram.API.Bot.Object.Chat as Exports+import Network.Telegram.API.Bot.Object.From as Exports+import Network.Telegram.API.Bot.Object.Button as Exports+import Network.Telegram.API.Bot.Object.Callback as Exports+import Network.Telegram.API.Bot.Object.Keyboard as Exports+import Network.Telegram.API.Bot.Object.Message as Exports+import Network.Telegram.API.Bot.Object.Update as Exports
+ Network/Telegram/API/Bot/Object/Button.hs view
@@ -0,0 +1,30 @@+module Network.Telegram.API.Bot.Object.Button (Button (..), Pressed (..)) where++import "aeson" Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON)+ , Object, Value (Object), object, withObject, (.:), (.:?), (.=))+import "aeson" Data.Aeson.Types (Parser)+import "base" Control.Applicative (Alternative ((<|>)))+import "text" Data.Text (Text)++data Button = Button Text Pressed deriving Show++instance FromJSON Button where+ parseJSON = withObject "Button" $ \v ->+ Button <$> v .: "text" <*> parseJSON (Object v)++instance ToJSON Button where+ toJSON (Button text (Open url)) = object+ ["text" .= text, "url" .= url]+ toJSON (Button text (Callback cbd)) = object+ ["text" .= text, "callback_data" .= cbd]++data Pressed = Open Text | Callback Text deriving Show++instance FromJSON Pressed where+ parseJSON = withObject "Pressed" $ \v ->+ (is_open v <|> is_callback v) >>= maybe+ (fail "Action on pressing isn't set") return where++ is_open, is_callback :: Object -> Parser (Maybe Pressed)+ is_open v = (fmap . fmap) Open $ v .:? "url"+ is_callback v = (fmap . fmap) Callback $ v .:? "callback_data"
+ Network/Telegram/API/Bot/Object/Callback.hs view
@@ -0,0 +1,13 @@+module Network.Telegram.API.Bot.Object.Callback (Callback (..)) where++import "aeson" Data.Aeson (FromJSON (parseJSON), withObject, (.:))+import "text" Data.Text (Text)++import Network.Telegram.API.Bot.Object.From (From)+import Network.Telegram.API.Bot.Object.Message (Message)++data Callback = Datatext From Message Text deriving Show++instance FromJSON Callback where+ parseJSON = withObject "Callback" $ \v ->+ Datatext <$> v .: "from" <*> v .: "message" <*> v .: "data"
+ Network/Telegram/API/Bot/Object/Chat.hs view
@@ -0,0 +1,31 @@+module Network.Telegram.API.Bot.Object.Chat (Chat (..)) where++import "aeson" Data.Aeson (FromJSON (parseJSON), withObject, (.:))+import "base" Data.Int (Int64)+import "text" Data.Text (Text)++import Network.Telegram.API.Bot.Property.Identifiable+ (Identifiable (identificator), Identificator)++data Chat+ = Private Int64+ | Group Int64 Text+ | Supergroup Int64 Text+ | Channel Int64 Text+ deriving Show++type instance Identificator Chat = Int64++instance Identifiable Chat where+ identificator (Private i) = i+ identificator (Group i _) = i+ identificator (Supergroup i _) = i+ identificator (Channel i _) = i++instance FromJSON Chat where+ parseJSON = withObject "Chat" $ \v -> v .: "type" >>= \case+ ("private" :: Text) -> Private <$> v .: "id"+ ("group" :: Text) -> Group <$> v .: "id" <*> v .: "title"+ ("supergroup" :: Text) -> Supergroup <$> v .: "id" <*> v .: "title"+ ("channel" :: Text) -> Channel <$> v .: "id" <*> v .: "title"+ _ -> fail "Type of chat is not defined"
+ Network/Telegram/API/Bot/Object/From.hs view
@@ -0,0 +1,52 @@+module Network.Telegram.API.Bot.Object.From+ (From (..), nickname, firstname, lastname) where++import "aeson" Data.Aeson (FromJSON (parseJSON), Object, withObject, (.:), (.:?))+import "aeson" Data.Aeson.Types (Parser)+import "base" Data.Bool (bool)+import "lens" Control.Lens (Lens')+import "text" Data.Text (Text)++import Network.Telegram.API.Bot.Property.Identifiable+ (Identifiable (identificator), Identificator)++data From+ = Bot Int (Maybe Text) Text (Maybe Text) (Maybe Text)+ | User Int (Maybe Text) Text (Maybe Text) (Maybe Text)+ deriving Show++type instance Identificator From = Int++instance Identifiable From where+ identificator (Bot i _ _ _ _) = i+ identificator (User i _ _ _ _) = i++instance Eq From where+ Bot i _ _ _ _ == Bot i' _ _ _ _ = i == i'+ User i _ _ _ _ == User i' _ _ _ _ = i == i'+ _ == _ = False++type Whom = Int -> Maybe Text -> Text -> Maybe Text -> Maybe Text -> From++instance FromJSON From where+ parseJSON = withObject "From" $ \v -> v .: "is_bot"+ >>= bool (from v User) (from v Bot) where++ from :: Object -> Whom -> Parser From+ from v f = f <$> v .: "id"+ <*> v .:? "username"+ <*> v .: "first_name"+ <*> v .:? "last_name"+ <*> v .:? "language_code"++nickname :: Lens' From (Maybe Text)+nickname f (Bot uid nn fn ln lng) = (\nn' -> Bot uid nn' fn ln lng) <$> f nn+nickname f (User uid nn fn ln lng) = (\nn' -> User uid nn' fn ln lng) <$> f nn++firstname :: Lens' From Text+firstname f (Bot uid nn fn ln lng) = (\fn' -> Bot uid nn fn' ln lng) <$> f fn+firstname f (User uid nn fn ln lng) = (\fn' -> User uid nn fn' ln lng) <$> f fn++lastname :: Lens' From (Maybe Text)+lastname f (Bot uid nn fn ln lng) = (\ln' -> Bot uid nn fn ln' lng) <$> f ln+lastname f (User uid nn fn ln lng) = (\ln' -> User uid nn fn ln' lng) <$> f ln
+ Network/Telegram/API/Bot/Object/Keyboard.hs view
@@ -0,0 +1,25 @@+module Network.Telegram.API.Bot.Object.Keyboard (Keyboard (..), Substitution) where++import "aeson" Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), object, withObject, (.:), (.=))+import "base" Data.Int (Int64)++import Network.Telegram.API.Bot.Capacity.Editable+ (Substitution, Editable (substitution_value, edit_endpoint))+import Network.Telegram.API.Bot.Object.Button (Button)++data Keyboard = Inline [[Button]] deriving Show++type instance Substitution Keyboard = (Int64, Int, Keyboard)++instance FromJSON Keyboard where+ parseJSON = withObject "Inline" $ \v ->+ Inline <$> v .: "inline_keyboard"++instance ToJSON Keyboard where+ toJSON (Inline buttons) = object+ ["inline_keyboard" .= buttons]++instance Editable Keyboard where+ substitution_value (chat_id, message_id, reply_markup) = object+ ["chat_id" .= chat_id, "message_id" .= message_id, "reply_markup" .= reply_markup]+ edit_endpoint _ = "editMessageReplyMarkup"
+ Network/Telegram/API/Bot/Object/Message.hs view
@@ -0,0 +1,68 @@+module Network.Telegram.API.Bot.Object.Message+ (Message (..), Initial, Marking) where++import "aeson" Data.Aeson (FromJSON (parseJSON), object, withArray, withObject, (.:), (.=))+import "aeson" Data.Aeson.Types (Object, Parser, Value)+import "base" Control.Applicative (Alternative ((<|>), empty))+import "base" Data.Int (Int64)+import "text" Data.Text (Text)++import qualified "text" Data.Text as T (drop, take)++import Network.Telegram.API.Bot.Object.Chat (Chat)+import Network.Telegram.API.Bot.Object.From (From)+import Network.Telegram.API.Bot.Object.Keyboard (Keyboard)+import Network.Telegram.API.Bot.Capacity.Postable+ (Initial, Postable (initial_value, post_endpoint))+import Network.Telegram.API.Bot.Capacity.Purgeable+ (Marking, Purgeable (marking_value, purge_endpoint))+import Network.Telegram.API.Bot.Property.Identifiable+ (Identifiable (identificator), Identificator)++data Message+ = Textual Int Chat From Text+ | Command Int Chat From Text+ deriving Show++type instance Initial Message = (Int64, Text, Maybe Keyboard)+type instance Marking Message = (Int64, Int)+type instance Identificator Message = Int++instance Identifiable Message where+ identificator (Textual i _ _ _) = i+ identificator (Command i _ _ _) = i++instance FromJSON Message where+ parseJSON = withObject "Message" $ \v -> command v <|> textual v where++ command :: Object -> Parser Message+ command v = Command <$> v .: "message_id" <*> v .: "chat" <*> v .: "from"+ <*> (v .: "entities" >>= command_entity >>= extract_command v)++ textual :: Object -> Parser Message+ textual v = Textual <$> v .: "message_id"+ <*> v .: "chat" <*> v .: "from" <*> v .: "text"++ command_entity :: Value -> Parser (Int, Int)+ command_entity = withArray "Command entity" $ \a ->+ foldr ((<|>) . entity) empty a where++ entity :: Value -> Parser (Int, Int)+ entity = withObject "Command entity" $ \v -> v .: "type" >>= \case+ ("bot_command" :: Text) -> (,) <$> v .: "offset" <*> v .: "length"+ _ -> fail "It's not a bot command"++ extract_command :: Object -> (Int, Int) -> Parser Text+ extract_command v (ofs, len) = (T.take len . T.drop (ofs + 1)) <$> v .: "text"++instance Postable Message where+ initial_value (chat_id, text, Nothing) =+ object ["chat_id" .= chat_id, "text" .= text]+ initial_value (chat_id, text, Just kb) =+ object ["chat_id" .= chat_id, "text" .= text, "reply_markup" .= kb]+ post_endpoint _ = "sendMessage"++instance Purgeable Message where+ marking_value (chat_id, message_id) =+ object ["chat_id" .= chat_id, "message_id" .= message_id]+ purge_endpoint _ = "deleteMessage"
+ Network/Telegram/API/Bot/Object/Update.hs view
@@ -0,0 +1,30 @@+module Network.Telegram.API.Bot.Object.Update (Update (..)) where++import "aeson" Data.Aeson (FromJSON (parseJSON), withObject, (.:))+import "aeson" Data.Aeson.Types (Object, Parser)+import "base" Control.Applicative (Alternative ((<|>)))++import Network.Telegram.API.Bot.Object.Callback (Callback)+import Network.Telegram.API.Bot.Object.Message (Message)+import Network.Telegram.API.Bot.Property.Identifiable+ (Identifiable (identificator), Identificator)++data Update+ = Incoming Int Message+ | Query Int Callback+ deriving Show++type instance Identificator Update = Int++instance Identifiable Update where+ identificator (Incoming i _) = i+ identificator (Query i _) = i++instance FromJSON Update where+ parseJSON = withObject "Update" $ \v -> query v <|> incoming v where++ query :: Object -> Parser Update+ query v = Query <$> v .: "update_id" <*> v .: "callback_query"++ incoming :: Object -> Parser Update+ incoming v = Incoming <$> v .: "update_id" <*> v .: "message"
+ Network/Telegram/API/Bot/Property.hs view
@@ -0,0 +1,3 @@+module Network.Telegram.API.Bot.Property (module Exports) where++import Network.Telegram.API.Bot.Property.Identifiable as Exports
+ Network/Telegram/API/Bot/Property/Identifiable.hs view
@@ -0,0 +1,7 @@+module Network.Telegram.API.Bot.Property.Identifiable (Identifiable (..), Identificator) where++type family Identificator a = r++class Identifiable a where+ {-# MINIMAL identificator #-}+ identificator :: a -> Identificator a
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ telega.cabal view
@@ -0,0 +1,50 @@+name: telega+version: 0.1.0+synopsis: Telegram Bot API binding+description: High-level bindings, typed entities, inline mode only+homepage: https://github.com/iokasimov/telega+license: MIT+license-file: LICENSE+extra-source-files: CHANGELOG.md+author: Murat Kasimov+maintainer: Murat Kasimov <iokasimov.m@gmail.com>+copyright: Copyright (c) 2019 Murat Kasimov+category: Data, Control+build-type: Simple+cabal-version: >= 1.10++source-repository head+ type: git+ location: https://github.com/iokasimov/telega.git++library+ exposed-modules:+ Network.Telegram.API.Bot+ Network.Telegram.API.Bot.Core+ Network.Telegram.API.Bot.Object+ Network.Telegram.API.Bot.Object.Chat+ Network.Telegram.API.Bot.Object.From+ Network.Telegram.API.Bot.Object.Button+ Network.Telegram.API.Bot.Object.Callback+ Network.Telegram.API.Bot.Object.Keyboard+ Network.Telegram.API.Bot.Object.Message+ Network.Telegram.API.Bot.Object.Update+ Network.Telegram.API.Bot.Capacity+ Network.Telegram.API.Bot.Capacity.Editable+ Network.Telegram.API.Bot.Capacity.Postable+ Network.Telegram.API.Bot.Capacity.Purgeable+ Network.Telegram.API.Bot.Property+ Network.Telegram.API.Bot.Property.Identifiable+ build-depends: base == 4.*, transformers, lens, aeson, text, http-client, wreq+ default-extensions:+ DataKinds+ LambdaCase+ OverloadedStrings+ PackageImports+ ScopedTypeVariables+ TypeApplications+ TypeFamilies+ TypeFamilyDependencies+ TypeOperators+ default-language: Haskell2010+ ghc-options: -Wall -fno-warn-tabs