summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authoriokasimovmt <>2019-04-15 09:18:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2019-04-15 09:18:00 (GMT)
commit9bff2e16327243d624956146eacbd05c8ba31e92 (patch)
tree1f9414d995225f3f2032c2cff67b12e49408d613
parent3fda5ed5073559fd41a22529f6cef5c0321a6437 (diff)
version 0.1.90.1.9
-rw-r--r--CHANGELOG.md7
-rw-r--r--Network/Telegram/API/Bot/Object.hs1
-rw-r--r--Network/Telegram/API/Bot/Object/Member.hs16
-rw-r--r--Network/Telegram/API/Bot/Object/Member/Powers.hs21
-rw-r--r--Network/Telegram/API/Bot/Object/Member/Restrictions.hs17
-rw-r--r--Network/Telegram/API/Bot/Object/Update/Message.hs4
-rw-r--r--Network/Telegram/API/Bot/Object/Update/Message/Content/Location.hs6
-rw-r--r--Network/Telegram/API/Bot/Property/Persistable.hs113
-rw-r--r--telega.cabal8
9 files changed, 158 insertions, 35 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index 610ff2d..c711362 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -62,3 +62,10 @@
* Define `Messaging` datatype to separate direct, reply and forward `Message`
* Make first argument of `Payload` type family poly kinded (enable `PolyKinds`)
* Define `Persistable` instance for `Directly`, `Forwarding` and `Replying` `Message`
+
+# 0.1.9
+* Move `Messaging` datatype to `Persistable` module and make it over `Capacity` parameter
+* Define `Persistable` instances for `Info` datatype (for direct and reply messages)
+* Add ticks to all constructors of `Capacity` to surround them from two sides in promoted versions
+* Define `Persistable` instance for `Member` (for kicking and unbanning only)
+* Define `Powers` and `Restrictions` datatypes within created `Member` submodule
diff --git a/Network/Telegram/API/Bot/Object.hs b/Network/Telegram/API/Bot/Object.hs
index 70de619..5de113f 100644
--- a/Network/Telegram/API/Bot/Object.hs
+++ b/Network/Telegram/API/Bot/Object.hs
@@ -18,3 +18,4 @@ type instance Object Content = ()
type instance Object Origin = ()
type instance Object Callback = ()
type instance Object Button = ()
+type instance Object Info = ()
diff --git a/Network/Telegram/API/Bot/Object/Member.hs b/Network/Telegram/API/Bot/Object/Member.hs
index 4002d99..d3352fb 100644
--- a/Network/Telegram/API/Bot/Object/Member.hs
+++ b/Network/Telegram/API/Bot/Object/Member.hs
@@ -1,8 +1,12 @@
-module Network.Telegram.API.Bot.Object.Member (Member (..)) where
+module Network.Telegram.API.Bot.Object.Member (Member (..), module Exports) where
-import "aeson" Data.Aeson (FromJSON (parseJSON), withObject, (.:))
+import Network.Telegram.API.Bot.Object.Member.Powers as Exports
+import Network.Telegram.API.Bot.Object.Member.Restrictions as Exports
+
+import "aeson" Data.Aeson (FromJSON (parseJSON), Value (Object), withObject, (.:))
import "base" Control.Applicative (Applicative ((<*>)))
import "base" Control.Monad (Monad ((>>=)), fail)
+import "base" Data.Bool (Bool)
import "base" Data.Function (($))
import "base" Data.Functor ((<$>))
import "base" Text.Show (Show)
@@ -13,9 +17,9 @@ import Network.Telegram.API.Bot.Object.Sender (Sender)
data Member
= Creator Sender
- | Administrator Sender
+ | Administrator Sender Bool Powers
| Member Sender
- | Restricted Sender POSIXTime
+ | Restricted Sender Restrictions POSIXTime
| Left Sender
| Kicked Sender POSIXTime
deriving Show
@@ -23,9 +27,9 @@ data Member
instance FromJSON Member where
parseJSON = withObject "Member" $ \v -> v .: "status" >>= \case
("creator" :: Text) -> Creator <$> v .: "user"
- ("administrator" :: Text) -> Administrator <$> v .: "user"
+ ("administrator" :: Text) -> Administrator <$> v .: "user" <*> v .: "can_be_edited" <*> parseJSON (Object v)
("member" :: Text) -> Member <$> v .: "user"
- ("restricted" :: Text) -> Restricted <$> v .: "user" <*> v .: "until_date"
+ ("restricted" :: Text) -> Restricted <$> v .: "user" <*> parseJSON (Object v) <*> v .: "until_date"
("left" :: Text) -> Left <$> v .: "user"
("kicked" :: Text) -> Kicked <$> v .: "user" <*> v.: "until_date"
_ -> fail "Status of chat member is not defined"
diff --git a/Network/Telegram/API/Bot/Object/Member/Powers.hs b/Network/Telegram/API/Bot/Object/Member/Powers.hs
new file mode 100644
index 0000000..5270c90
--- /dev/null
+++ b/Network/Telegram/API/Bot/Object/Member/Powers.hs
@@ -0,0 +1,21 @@
+module Network.Telegram.API.Bot.Object.Member.Powers (Powers (..)) where
+
+import "aeson" Data.Aeson (FromJSON (parseJSON), withObject, (.:))
+import "base" Data.Bool (Bool)
+import "base" Control.Applicative ((<*>))
+import "base" Data.Function (($))
+import "base" Data.Functor ((<$>))
+import "base" Text.Show (Show)
+
+data Powers = Powers Bool Bool Bool Bool Bool Bool Bool Bool deriving Show
+
+instance FromJSON Powers where
+ parseJSON = withObject "Powers" $ \v -> Powers
+ <$> v .: "can_change_info"
+ <*> v .: "can_post_messages"
+ <*> v .: "can_edit_messages"
+ <*> v .: "can_delete_messages"
+ <*> v .: "can_invite_users"
+ <*> v .: "can_restrict_members"
+ <*> v .: "can_pin_messages"
+ <*> v .: "can_promote_members"
diff --git a/Network/Telegram/API/Bot/Object/Member/Restrictions.hs b/Network/Telegram/API/Bot/Object/Member/Restrictions.hs
new file mode 100644
index 0000000..2c83b60
--- /dev/null
+++ b/Network/Telegram/API/Bot/Object/Member/Restrictions.hs
@@ -0,0 +1,17 @@
+module Network.Telegram.API.Bot.Object.Member.Restrictions (Restrictions (..)) where
+
+import "aeson" Data.Aeson (FromJSON (parseJSON), withObject, (.:))
+import "base" Data.Bool (Bool)
+import "base" Control.Applicative ((<*>))
+import "base" Data.Function (($))
+import "base" Data.Functor ((<$>))
+import "base" Text.Show (Show)
+
+data Restrictions = Restrictions Bool Bool Bool Bool deriving Show
+
+instance FromJSON Restrictions where
+ parseJSON = withObject "Restrictions" $ \v -> Restrictions
+ <$> v .: "can_send_messages"
+ <*> v .: "can_send_media_messages"
+ <*> v .: "can_send_other_messages"
+ <*> v .: "can_add_web_page_previews"
diff --git a/Network/Telegram/API/Bot/Object/Update/Message.hs b/Network/Telegram/API/Bot/Object/Update/Message.hs
index 26a2c04..9cd425f 100644
--- a/Network/Telegram/API/Bot/Object/Update/Message.hs
+++ b/Network/Telegram/API/Bot/Object/Update/Message.hs
@@ -1,4 +1,4 @@
-module Network.Telegram.API.Bot.Object.Update.Message (Message (..), Messaging (..), module Exports) where
+module Network.Telegram.API.Bot.Object.Update.Message (Message (..), module Exports) where
import Network.Telegram.API.Bot.Object.Update.Message.Content as Exports
import Network.Telegram.API.Bot.Object.Update.Message.Keyboard as Exports
@@ -17,8 +17,6 @@ import "text" Data.Text (Text)
import Network.Telegram.API.Bot.Object.Update.Message.Content (Content)
import Network.Telegram.API.Bot.Object.Update.Message.Origin (Origin (Private, Group, Supergroup, Channel))
-data Messaging = Directly | Forwarding | Replying
-
data Message
= Direct Int Origin Content
| Forward Int Origin Content
diff --git a/Network/Telegram/API/Bot/Object/Update/Message/Content/Location.hs b/Network/Telegram/API/Bot/Object/Update/Message/Content/Location.hs
index b9b62a2..219cfc1 100644
--- a/Network/Telegram/API/Bot/Object/Update/Message/Content/Location.hs
+++ b/Network/Telegram/API/Bot/Object/Update/Message/Content/Location.hs
@@ -1,6 +1,6 @@
module Network.Telegram.API.Bot.Object.Update.Message.Content.Location (Location (..)) where
-import "aeson" Data.Aeson (FromJSON (parseJSON), withObject, (.:))
+import "aeson" Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), object, withObject, (.:), (.=))
import "base" Control.Applicative ((<*>))
import "base" Data.Function (($))
import "base" Data.Functor ((<$>))
@@ -13,3 +13,7 @@ data Location = Location Float Float
instance FromJSON Location where
parseJSON = withObject "Location" $ \v -> Location
<$> v .: "longitude" <*> v .: "latitude"
+
+instance ToJSON Location where
+ toJSON (Location latitude longitude) = object
+ ["latitude" .= latitude, "longitude" .= longitude]
diff --git a/Network/Telegram/API/Bot/Property/Persistable.hs b/Network/Telegram/API/Bot/Property/Persistable.hs
index 1de8ccb..f4f1e08 100644
--- a/Network/Telegram/API/Bot/Property/Persistable.hs
+++ b/Network/Telegram/API/Bot/Property/Persistable.hs
@@ -1,4 +1,5 @@
-module Network.Telegram.API.Bot.Property.Persistable (Persistable (..), Payload, PL (..), Capacity (..)) where
+module Network.Telegram.API.Bot.Property.Persistable
+ (Persistable (..), Payload, PL (..), Capacity (..), Message' (..)) where
import "aeson" Data.Aeson (FromJSON, Value, decode, object, (.=))
import "base" Control.Exception (try)
@@ -6,7 +7,7 @@ import "base" Control.Monad (Monad ((>>=)), join)
import "base" Data.Function (flip, (.), ($))
import "base" Data.Functor (Functor (fmap), (<$>))
import "base" Data.Int (Int, Int64)
-import "base" Data.Maybe (fromJust)
+import "base" Data.Maybe (Maybe, fromJust)
import "base" Data.Semigroup (Semigroup ((<>)))
import "base" Data.String (String)
import "base" Data.Tuple (snd)
@@ -19,24 +20,43 @@ import "wreq" Network.Wreq.Session (post)
import Network.Telegram.API.Bot.Core (Telegram, Token (Token), Ok, result)
import Network.Telegram.API.Bot.Object (Object, Keyboard, Notification, Member, Sender)
-import Network.Telegram.API.Bot.Object.Update.Message (Message, Messaging (Directly, Forwarding, Replying))
+import Network.Telegram.API.Bot.Object.Update.Message (Message)
+import Network.Telegram.API.Bot.Object.Update.Message.Content.Info (Info)
+import Network.Telegram.API.Bot.Object.Update.Message.Content.Location (Location)
-data Capacity = Fetch | Post | Edit | Purge
+data Capacity = Post' | Fetch' | Edit' | Purge'
newtype PL c o a = PL a
type family Payload (c :: k) o = r | r -> o c
-type instance Payload 'Post Keyboard = PL 'Post Keyboard (Int64, Text, Keyboard)
-type instance Payload 'Edit Keyboard = PL 'Edit Keyboard (Int64, Int, Keyboard)
-type instance Payload 'Fetch Member = PL 'Fetch Member (Int64, Int)
-type instance Payload 'Purge Message = PL 'Purge Message (Int64, Int)
-type instance Payload 'Post Notification = PL 'Post Notification (Text, Text)
-type instance Payload 'Fetch Sender = PL 'Fetch Sender ()
+type instance Payload 'Post' Keyboard = PL 'Post' Keyboard (Int64, Text, Keyboard)
+type instance Payload 'Edit' Keyboard = PL 'Edit' Keyboard (Int64, Int, Keyboard)
+type instance Payload 'Fetch' Member = PL 'Fetch' Member (Int64, Int)
+type instance Payload 'Edit' Message = PL 'Edit' Message (Int64, Int, Text)
+type instance Payload 'Purge' Message = PL 'Purge' Message (Int64, Int)
+type instance Payload 'Post' Notification = PL 'Post' Notification (Text, Text)
+type instance Payload 'Fetch' Sender = PL 'Fetch' Sender ()
-type instance Payload 'Directly Message = PL 'Directly Message (Int64, Text)
-type instance Payload 'Forwarding Message = PL 'Forwarding Message (Int64, Int64, Int)
-type instance Payload 'Replying Message = PL 'Replying Message (Int64, Int, Text)
+data Message' = Direct' Capacity | Forward' Capacity | Reply' Capacity
+
+type instance Payload ('Direct' 'Post') Message = PL ('Direct' 'Post') Message (Int64, Text)
+type instance Payload ('Forward' 'Post') Message = PL ('Forward' 'Post') Message (Int64, Int64, Int)
+type instance Payload ('Reply' 'Post') Message = PL ('Reply' 'Post') Message (Int64, Int, Text)
+
+data Info' = Point' Message' | Contact' Message' | Venue' Message'
+
+type instance Payload ('Point' ('Direct' 'Post')) Info = PL ('Point' ('Direct' 'Post')) Info (Int64, Location, Int)
+type instance Payload ('Contact' ('Direct' 'Post')) Info = PL ('Contact' ('Direct' 'Post')) Info (Int64, Text, Text, Maybe Text, Maybe Text)
+type instance Payload ('Venue' ('Direct' 'Post')) Info = PL ('Venue' ('Direct' 'Post')) Info (Int64, Location, Text, Text, Maybe Text, Maybe Text)
+type instance Payload ('Point' ('Reply' 'Post')) Info = PL ('Point' ('Reply' 'Post')) Info (Int64, Int, Location, Int)
+type instance Payload ('Contact' ('Reply' 'Post')) Info = PL ('Contact' ('Reply' 'Post')) Info (Int64, Int, Text, Text, Maybe Text, Maybe Text)
+type instance Payload ('Venue' ('Reply' 'Post')) Info = PL ('Venue' ('Reply' 'Post')) Info (Int64, Int, Location, Text, Text, Maybe Text, Maybe Text)
+
+data Member' = Kick' | Unban'
+
+type instance Payload 'Kick' Member = PL 'Kick' Member (Int64, Int, Int)
+type instance Payload 'Unban' Member = PL 'Unban' Member (Int64, Int)
class Object o => Persistable c o where
{-# MINIMAL payload, endpoint #-}
@@ -50,42 +70,91 @@ class Object o => Persistable c o where
. fmap (fromJust . join . fmap result . decode @(Ok a) . responseBody)
. flip (post session) p $ "https://api.telegram.org/" <> unpack token <> "/" <> e
-instance Persistable 'Edit Keyboard where
+instance Persistable 'Edit' Keyboard where
payload (PL (chat_id, message_id, reply_markup)) = object
["chat_id" .= chat_id, "message_id" .= message_id, "reply_markup" .= reply_markup]
endpoint _ = "editMessageReplyMarkup"
-instance Persistable 'Post Keyboard where
+instance Persistable 'Post' Keyboard where
payload (PL (chat_id, text, kb)) = object
["chat_id" .= chat_id, "text" .= text, "reply_markup" .= kb]
endpoint _ = "sendMessage"
-instance Persistable 'Fetch Member where
+instance Persistable 'Fetch' Member where
payload (PL (chat_id, user_id)) = object ["chat_id" .= chat_id, "user_id" .= user_id]
endpoint _ = "getChatMember"
-instance Persistable 'Directly Message where
+instance Persistable ('Direct' 'Post') Message where
payload (PL (chat_id, text)) = object ["chat_id" .= chat_id, "text" .= text]
endpoint _ = "sendMessage"
-instance Persistable 'Forwarding Message where
+instance Persistable ('Forward' 'Post') Message where
payload (PL (chat_id, from_chat_id, message_id)) = object
["chat_id" .= chat_id, "from_chat_id" .= from_chat_id, "message_id" .= message_id]
endpoint _ = "forwardMessage"
-instance Persistable 'Replying Message where
+instance Persistable ('Reply' 'Post') Message where
payload (PL (chat_id, reply_to_message_id, text)) = object
["chat_id" .= chat_id, "reply_to_message_id" .= reply_to_message_id, "text" .= text]
endpoint _ = "sendMessage"
-instance Persistable 'Purge Message where
+instance Persistable 'Purge' Message where
payload (PL (chat_id, message_id)) = object ["chat_id" .= chat_id, "message_id" .= message_id]
endpoint _ = "deleteMessage"
-instance Persistable 'Post Notification where
+instance Persistable 'Post' Notification where
payload (PL (cbq_id, text)) = object ["callback_query_id" .= cbq_id, "text" .= text]
endpoint _ = "answerCallbackQuery"
-instance Persistable 'Fetch Sender where
+instance Persistable 'Fetch' Sender where
payload (PL ()) = object []
endpoint _ = "getMe"
+
+instance Persistable 'Edit' Message where
+ payload (PL (chat_id, message_id, text)) = object
+ ["chat_id" .= chat_id, "message_id" .= message_id, "text" .= text]
+ endpoint _ = "editMessageText"
+
+instance Persistable ('Point' ('Direct' 'Post')) Info where
+ payload (PL (chat_id, location, live_period)) = object
+ ["chat_id" .= chat_id, "location" .= location, "live_period" .= live_period]
+ endpoint _ = "sendLocation"
+
+instance Persistable ('Contact' ('Direct' 'Post')) Info where
+ payload (PL (chat_id, phone_number, first_name, last_name, vcard)) =
+ object ["chat_id" .= chat_id, "phone_number" .= phone_number,
+ "first_name" .= first_name, "last_name" .= last_name, "vcard" .= vcard]
+ endpoint _ = "sendContact"
+
+instance Persistable ('Venue' ('Direct' 'Post')) Info where
+ payload (PL (chat_id, location, title, address, foursquare_id, foursquare_type)) = object
+ ["chat_id" .= chat_id, "location" .= location, "title" .= title, "address" .= address,
+ "foursquare_id" .= foursquare_id, "foursquare_type" .= foursquare_type]
+ endpoint _ = "sendVenue"
+
+instance Persistable ('Point' ('Reply' 'Post')) Info where
+ payload (PL (chat_id, reply_to_message_id, location, live_period)) = object
+ ["chat_id" .= chat_id, "reply_to_message_id" .= reply_to_message_id,
+ "location" .= location, "live_period" .= live_period]
+ endpoint _ = "sendLocation"
+
+instance Persistable ('Contact' ('Reply' 'Post')) Info where
+ payload (PL (chat_id, reply_to_message_id, phone_number, first_name, last_name, vcard)) = object
+ ["chat_id" .= chat_id, "reply_to_message_id" .= reply_to_message_id, "phone_number" .= phone_number,
+ "first_name" .= first_name, "last_name" .= last_name, "vcard" .= vcard]
+ endpoint _ = "sendContact"
+
+instance Persistable ('Venue' ('Reply' 'Post')) Info where
+ payload (PL (chat_id, reply_to_message_id, location, title, address, foursquare_id, foursquare_type)) = object
+ ["chat_id" .= chat_id, "reply_to_message_id" .= reply_to_message_id, "location" .= location, "title" .= title,
+ "address" .= address, "foursquare_id" .= foursquare_id, "foursquare_type" .= foursquare_type]
+ endpoint _ = "sendVenue"
+
+instance Persistable 'Kick' Member where
+ payload (PL (chat_id, user_id, until_date)) = object
+ ["chat_id" .= chat_id, "user_id" .= user_id, "until_date" .= until_date]
+ endpoint _ = "kickChatMember"
+
+instance Persistable 'Unban' Member where
+ payload (PL (chat_id, user_id)) = object ["chat_id" .= chat_id, "user_id" .= user_id]
+ endpoint _ = "unbanChatMember"
diff --git a/telega.cabal b/telega.cabal
index ea5f817..552bbba 100644
--- a/telega.cabal
+++ b/telega.cabal
@@ -1,5 +1,5 @@
name: telega
-version: 0.1.8
+version: 0.1.9
synopsis: Telegram Bot API binding
description: High-level bindings, typed entities, inline mode only
homepage: https://github.com/iokasimov/telega
@@ -23,6 +23,8 @@ library
Network.Telegram.API.Bot.Core
Network.Telegram.API.Bot.Object
Network.Telegram.API.Bot.Object.Member
+ Network.Telegram.API.Bot.Object.Member.Powers
+ Network.Telegram.API.Bot.Object.Member.Restrictions
Network.Telegram.API.Bot.Object.Sender
Network.Telegram.API.Bot.Object.Update
Network.Telegram.API.Bot.Object.Update.Callback
@@ -44,6 +46,6 @@ library
build-depends: base == 4.*, transformers, lens, aeson, text, time, http-client, wreq
default-extensions: DataKinds, LambdaCase, OverloadedStrings, NoImplicitPrelude, PackageImports,
AllowAmbiguousTypes, MultiParamTypeClasses, ScopedTypeVariables, UndecidableInstances, UndecidableSuperClasses,
- TypeApplications, TypeFamilies, TypeFamilyDependencies, TypeOperators, PolyKinds
+ FlexibleInstances, TypeApplications, TypeFamilies, TypeFamilyDependencies, TypeOperators, PolyKinds
default-language: Haskell2010
- ghc-options: -Wall -fno-warn-tabs
+ ghc-options: -Wall -fno-warn-tabs -fprint-explicit-kinds