telega 0.2.4 → 0.2.5

raw patch · 15 files changed

+270/−169 lines, 15 filesdep +data-default

Dependencies added: data-default

Files

• CHANGELOG.md +9/−0
• Network/API/Telegram/Bot/Object/Member.hs +47/−26
• Network/API/Telegram/Bot/Object/Sender.hs +8/−8
• Network/API/Telegram/Bot/Object/Update.hs +1/−1
• Network/API/Telegram/Bot/Object/Update/Callback.hs +7/−7
• Network/API/Telegram/Bot/Object/Update/Message.hs +105/−69
• Network/API/Telegram/Bot/Object/Update/Message/Content.hs +13/−3
• Network/API/Telegram/Bot/Object/Update/Message/Content/Info.hs +12/−29
• Network/API/Telegram/Bot/Object/Update/Message/Content/Info/Contact.hs +20/−0
• Network/API/Telegram/Bot/Object/Update/Message/Content/Info/Venue.hs +19/−0
• Network/API/Telegram/Bot/Object/Update/Message/Content/Poll.hs +3/−13
• Network/API/Telegram/Bot/Object/Update/Message/Origin.hs +1/−1
• Network/API/Telegram/Bot/Property/Persistable.hs +9/−8
• Network/API/Telegram/Bot/Utils.hs +9/−0
• telega.cabal +7/−4

@@ -117,3 +117,12 @@ * Define `Caption` and `URI` datatypes to distinct specialized `Text` values * Include `URI` field into `Send` `Persistable` instances for `File` objects * Define `Persistable` instance to kick, unban, restrict and promote `Member`++# 0.2.5+* Create `Utils` module with `field` function to create singleton hash table from key an value+* Define `Can` and `Cannot` to define `Default` instances for `Powers` and `Restrictions`+* Introduce `Returning` type family to automatically decode the API response+* Move `Poll` status info from `Poll` datatype to `Polling` constructor of `Content` datatype+* Define `Persistable` instance for sending `Photo`+* Separate `Venue` and `Contact` into module and datatype from `Info` datatype+* Rename `User` constructor of `Sender` datatype to `Human`

@@ -1,24 +1,25 @@ module Network.API.Telegram.Bot.Object.Member-	( module Exports, Member (..), Until (..)+	( module Exports, Member (..), Until (..), Can (..), Cannot (..) 	, Kick (..), Unban (..), Restrict (..), Promote (..)) where  import Network.API.Telegram.Bot.Object.Member.Powers as Exports import Network.API.Telegram.Bot.Object.Member.Restrictions as Exports -import "aeson" Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), Value (Object), withObject, (.:))+import "aeson" Data.Aeson (FromJSON (parseJSON), Value (Object), withObject, (.:)) import "base" Control.Applicative ((<*>)) import "base" Control.Monad (fail, (>>=))-import "base" Data.Bool (Bool)+import "base" Data.Bool (Bool (True, False)) import "base" Data.Function (($)) import "base" Data.Functor ((<$>)) import "base" Data.Int (Int, Int64) import "base" Data.Semigroup ((<>)) import "base" Text.Show (Show)+import "data-default" Data.Default (Default (def)) import "text" Data.Text (Text)-import "unordered-containers" Data.HashMap.Strict (singleton)  import Network.API.Telegram.Bot.Object.Sender (Sender)-import Network.API.Telegram.Bot.Property.Persistable (Persistable (Payload, payload, endpoint))+import Network.API.Telegram.Bot.Property.Persistable (Persistable (Payload, Returning, payload, endpoint))+import Network.API.Telegram.Bot.Utils (field)  data Member 	= Creator Sender@@ -39,6 +40,22 @@ 		("kicked" :: Text) -> Kicked <$> v .: "user" <*> v.: "until_date" 		_ -> fail "Status of chat member is not defined" +newtype Can a = Can a++instance Default (Can Restrictions) where+	def = Can $ Restrictions True True True True++instance Default (Can Powers) where+	def = Can $ Powers True True True True True True True True++newtype Cannot a = Cannot a++instance Default (Cannot Restrictions) where+	def = Cannot $ Restrictions False False False False++instance Default (Cannot Powers) where+	def = Cannot $ Powers False False False False False False False False+ -- | Ban forever or until some date (between 30 seconds and 366 days) data Until = Forever | Until Int @@ -47,10 +64,11 @@  instance Persistable (Kick Member) where 	type Payload (Kick Member) = Kick Member+	type Returning (Kick Member) = () 	payload (Kick chat_id user_id Forever) =-		singleton "chat_id" (toJSON chat_id) <> singleton "user_id" (toJSON user_id)-	payload (Kick chat_id user_id (Until until_date)) = singleton "chat_id" (toJSON chat_id)-		<> singleton "user_id" (toJSON user_id) <> singleton "until_date" (toJSON until_date)+		field "chat_id" chat_id <> field "user_id" user_id+	payload (Kick chat_id user_id (Until until_date)) = field "chat_id" chat_id+		<> field "user_id" user_id <> field "until_date" until_date 	endpoint _ = "kickChatMember"  data Unban a where@@ -58,9 +76,10 @@  instance Persistable (Unban Member) where 	type Payload (Unban Member) = Unban Member+	type Returning (Unban Member) = () 	payload (Unban chat_id user_id) =-		singleton "chat_id" (toJSON chat_id)-		<> singleton "user_id" (toJSON user_id)+		field "chat_id" chat_id+		<> field "user_id" user_id 	endpoint _ = "unbanChatMember"  data Restrict a where@@ -68,14 +87,15 @@  instance Persistable (Restrict Member) where 	type Payload (Restrict Member) = Restrict Member+	type Returning (Restrict Member) = () 	payload (Restrict chat_id user_id Forever (Restrictions send_msgs send_media_msgs send_other_msgs wp_previews)) =-		singleton "chat_id" (toJSON chat_id) <> singleton "user_id" (toJSON user_id)-		<> singleton "can_send_messages" (toJSON send_msgs) <> singleton "can_send_media_messages" (toJSON send_media_msgs)-		<> singleton "can_send_other_messages" (toJSON send_other_msgs) <> singleton "can_add_web_page_previews" (toJSON wp_previews)+		field "chat_id" chat_id <> field "user_id" user_id+		<> field "can_send_messages" send_msgs <> field "can_send_media_messages" send_media_msgs+		<> field "can_send_other_messages" send_other_msgs <> field "can_add_web_page_previews" wp_previews 	payload (Restrict chat_id user_id (Until until_date) (Restrictions send_msgs send_media_msgs send_other_msgs wp_previews)) =-		singleton "chat_id" (toJSON chat_id) <> singleton "user_id" (toJSON user_id) <> singleton "until_date" (toJSON until_date)-		<> singleton "can_send_messages" (toJSON send_msgs) <> singleton "can_send_media_messages" (toJSON send_media_msgs)-		<> singleton "can_send_other_messages" (toJSON send_other_msgs) <> singleton "can_add_web_page_previews" (toJSON wp_previews)+		field "chat_id" chat_id <> field "user_id" user_id <> field "until_date" until_date+		<> field "can_send_messages" send_msgs <> field "can_send_media_messages" send_media_msgs+		<> field "can_send_other_messages" send_other_msgs <> field "can_add_web_page_previews" wp_previews 	endpoint _ = "restrictChatMember"  data Promote a where@@ -83,16 +103,17 @@  instance Persistable (Promote Member) where 	type Payload (Promote Member) = Promote Member+	type Returning (Promote Member) = () 	payload (Promote chat_id user_id Forever (Powers change_info post_msgs edit_msgs delete_msgs invite_users restrict_members pin_msgs promote_members)) =-		singleton "chat_id" (toJSON chat_id) <> singleton "user_id" (toJSON user_id)-		<> singleton "can_change_info" (toJSON change_info) <> singleton "can_post_messages" (toJSON post_msgs)-		<> singleton "can_edit_messages" (toJSON edit_msgs) <> singleton "can_delete_messages" (toJSON delete_msgs)-		<> singleton "can_invite_users" (toJSON invite_users) <> singleton "can_restrict_members" (toJSON restrict_members)-		<> singleton "can_pin_messages" (toJSON pin_msgs) <> singleton "can_promote_members" (toJSON promote_members)+		field "chat_id" chat_id <> field "user_id" user_id+		<> field "can_change_info" change_info <> field "can_post_messages" post_msgs+		<> field "can_edit_messages" edit_msgs <> field "can_delete_messages" delete_msgs+		<> field "can_invite_users" invite_users <> field "can_restrict_members" restrict_members+		<> field "can_pin_messages" pin_msgs <> field "can_promote_members" promote_members 	payload (Promote chat_id user_id (Until until_date) (Powers change_info post_msgs edit_msgs delete_msgs invite_users restrict_members pin_msgs promote_members)) =-		singleton "chat_id" (toJSON chat_id) <> singleton "user_id" (toJSON user_id) <> singleton "until_date" (toJSON until_date)-		<> singleton "can_change_info" (toJSON change_info) <> singleton "can_post_messages" (toJSON post_msgs)-		<> singleton "can_edit_messages" (toJSON edit_msgs) <> singleton "can_delete_messages" (toJSON delete_msgs)-		<> singleton "can_invite_users" (toJSON invite_users) <> singleton "can_restrict_members" (toJSON restrict_members)-		<> singleton "can_pin_messages" (toJSON pin_msgs) <> singleton "can_promote_members" (toJSON promote_members)+		field "chat_id" chat_id <> field "user_id" user_id <> field "until_date" until_date+		<> field "can_change_info" change_info <> field "can_post_messages" post_msgs+		<> field "can_edit_messages" edit_msgs <> field "can_delete_messages" delete_msgs+		<> field "can_invite_users" invite_users <> field "can_restrict_members" restrict_members+		<> field "can_pin_messages" pin_msgs <> field "can_promote_members" promote_members 	endpoint _ = "promoteChatMember"

@@ -18,24 +18,24 @@  data Sender 	= Bot Int (Maybe Text) Text (Maybe Text) (Maybe Text)-	| User Int (Maybe Text) Text (Maybe Text) (Maybe Text)+	| Human Int (Maybe Text) Text (Maybe Text) (Maybe Text) 	deriving Show  instance Eq Sender where 	Bot i _ _ _ _ == Bot i' _ _ _ _ = i == i'-	User i _ _ _ _ == User i' _ _ _ _ = i == i'+	Human i _ _ _ _ == Human i' _ _ _ _ = i == i' 	_ == _ = False  instance Identifiable Sender where-	type instance Identificator Sender = Int+	type Identificator Sender = Int 	ident (Bot i _ _ _ _) = i-	ident (User i _ _ _ _) = i+	ident (Human i _ _ _ _) = i  type Whom = Int -> Maybe Text -> Text -> Maybe Text -> Maybe Text -> Sender  instance FromJSON Sender where 	parseJSON = withObject "Sender" $ \v -> v .: "is_bot"-		>>= bool (sender v User) (sender v Bot) where+		>>= bool (sender v Human) (sender v Bot) where  		sender :: Object -> Whom -> Parser Sender 		sender v f = f <$> v .: "id" <*> v .:? "username"@@ -44,12 +44,12 @@  nickname :: Lens' Sender (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+nickname f (Human uid nn fn ln lng) = (\nn' -> Human uid nn' fn ln lng) <$> f nn  firstname :: Lens' Sender 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+firstname f (Human uid nn fn ln lng) = (\fn' -> Human uid nn fn' ln lng) <$> f fn  lastname :: Lens' Sender (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+lastname f (Human uid nn fn ln lng) = (\ln' -> Human uid nn fn ln' lng) <$> f ln

@@ -24,7 +24,7 @@ 	deriving Show  instance Identifiable Update where-	type instance Identificator Update = Int+	type Identificator Update = Int 	ident (Query i _) = i 	ident (Membership i _) = i 	ident (Incoming i _) = i

@@ -3,20 +3,20 @@  import Network.API.Telegram.Bot.Object.Update.Callback.Notification as Exports -import "aeson" Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), withObject, (.:))+import "aeson" Data.Aeson (FromJSON (parseJSON), withObject, (.:)) import "base" Control.Applicative (Applicative ((<*>))) import "base" Data.Function (flip, ($)) import "base" Data.Functor ((<$>)) import "base" Data.Semigroup ((<>)) import "base" Text.Show (Show) import "text" Data.Text (Text)-import "unordered-containers" Data.HashMap.Strict (singleton)  import Network.API.Telegram.Bot.Object.Update.Message (Message) import Network.API.Telegram.Bot.Object.Update.Message.Origin (Origin) import Network.API.Telegram.Bot.Property.Accessible (Accessible (access)) import Network.API.Telegram.Bot.Property.Identifiable (Identifiable (Identificator, ident))-import Network.API.Telegram.Bot.Property.Persistable (Persistable (Payload, payload, endpoint))+import Network.API.Telegram.Bot.Property.Persistable (Persistable (Payload, Returning, payload, endpoint))+import Network.API.Telegram.Bot.Utils (field)  data Callback = Datatext Text Message Text deriving Show @@ -29,13 +29,13 @@ 		Datatext <$> v .: "id" <*> v .: "message" <*> v .: "data"  instance Identifiable Callback where-	type instance Identificator Callback = Text+	type Identificator Callback = Text 	ident (Datatext i _ _) = i  data Trigger a = Trigger Text Text  instance Persistable (Trigger Notification) where-	type instance Payload (Trigger Notification) = Trigger Notification-	payload (Trigger cbq_id text) = singleton "text" (toJSON text)-		<> singleton "callback_query_id" (toJSON cbq_id)+	type Payload (Trigger Notification) = Trigger Notification+	type Returning (Trigger Notification) = ()+	payload (Trigger cbq_id text) = field "text" text <> field "callback_query_id" cbq_id 	endpoint _ = "answerCallbackQuery"

@@ -5,7 +5,7 @@ import Network.API.Telegram.Bot.Object.Update.Message.Keyboard as Exports import Network.API.Telegram.Bot.Object.Update.Message.Origin as Exports -import "aeson" Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), Value (Object), withObject, (.:))+import "aeson" Data.Aeson (FromJSON (parseJSON), Value (Object), withObject, (.:)) import "aeson" Data.Aeson.Types (Object, Parser) import "base" Control.Applicative (Applicative ((<*>)), Alternative ((<|>))) import "base" Control.Monad (Monad ((>>=)), fail)@@ -16,14 +16,14 @@ import "base" Data.Semigroup ((<>)) import "base" Text.Show (Show) import "text" Data.Text (Text)-import "unordered-containers" Data.HashMap.Strict (singleton) import "with" Data.With (type (:&:)((:&:)))  import Network.API.Telegram.Bot.Object.Update.Message.Content (Content) import Network.API.Telegram.Bot.Object.Update.Message.Origin (Origin (Private, Group, Supergroup, Channel)) import Network.API.Telegram.Bot.Property.Accessible (Accessible (access)) import Network.API.Telegram.Bot.Property.Identifiable (Identifiable (Identificator, ident))-import Network.API.Telegram.Bot.Property.Persistable (Persistable (Payload, payload, endpoint))+import Network.API.Telegram.Bot.Property.Persistable (Persistable (Payload, Returning, payload, endpoint))+import Network.API.Telegram.Bot.Utils (field)  data Message 	= Direct Int Origin Content@@ -72,7 +72,7 @@ 			<*> parseJSON (Object v) <*> parseJSON (Object v)  instance Identifiable Message where-	type instance Identificator Message = Int+	type Identificator Message = Int 	ident (Direct i _ _) = i 	ident (Forwarded i _ _) = i 	ident (Replied i _ _ _) = i@@ -80,164 +80,200 @@ data Forward a = Forward Int Int64 Int64  instance Persistable (Forward Message) where-	type instance Payload (Forward Message) = Forward Message-	payload (Forward message_id from_chat_id to_chat_id) = singleton "message_id" (toJSON message_id)-		<> singleton "from_chat_id" (toJSON from_chat_id) <> singleton "chat_id" (toJSON to_chat_id)+	type Payload (Forward Message) = Forward Message+	type Returning (Forward Message) = Message+	payload (Forward message_id from_chat_id to_chat_id) = field "message_id" message_id+		<> field "from_chat_id" from_chat_id <> field "chat_id" to_chat_id 	endpoint _ = "forwardMessage"  data Send a = Send Int64 a  instance Persistable (Send Text) where-	type instance Payload (Send Text) = Send Text-	payload (Send chat_id text) = singleton "chat_id" (toJSON chat_id) <> singleton "text" (toJSON text)+	type Payload (Send Text) = Send Text+	type Returning (Send Text) = Message+	payload (Send chat_id text) = field "chat_id" chat_id <> field "text" text 	endpoint _ = "sendMessage"  instance Persistable (Send (Text :&: Keyboard)) where-	type instance Payload (Send (Text :&: Keyboard)) = Send (Text :&: Keyboard)-	payload (Send chat_id (text :&: reply_markup)) = singleton "chat_id" (toJSON chat_id)-		<> singleton "text" (toJSON text) <> singleton "reply_markup" (toJSON reply_markup)+	type Payload (Send (Text :&: Keyboard)) = Send (Text :&: Keyboard)+	type Returning (Send (Text :&: Keyboard)) = Message+	payload (Send chat_id (text :&: reply_markup)) = field "chat_id" chat_id+		<> field "text" text <> field "reply_markup" reply_markup 	endpoint _ = "sendMessage"  instance Persistable (Send Audio) where-	type instance Payload (Send Audio) = Send (URI :&: Audio)-	payload (Send chat_id (uri :&: Audio duration performer title mime_type file_size)) = singleton "file_id" (toJSON uri)-		<> singleton "chat_id" (toJSON chat_id) <> singleton "duration" (toJSON duration) <> singleton "performer" (toJSON performer)-		<> singleton "title" (toJSON title) <> singleton "mime_type" (toJSON mime_type) <> singleton "file_size" (toJSON file_size)+	type Payload (Send Audio) = Send (URI :&: Audio)+	type Returning (Send Audio) = Message+	payload (Send chat_id (uri :&: Audio duration performer title mime_type file_size)) = field "file_id" uri+		<> field "chat_id" chat_id <> field "duration" duration <> field "performer" performer+		<> field "title" title <> field "mime_type" mime_type <> field "file_size" file_size 	endpoint _ = "sendAudio"  instance Persistable (Send (Caption :&: Audio)) where-	type instance Payload (Send (Caption :&: Audio)) = Send (Caption :&: URI :&: Audio)-	payload (Send chat_id (caption :&: audio)) = payload (Send chat_id audio) <> singleton "caption" (toJSON caption)+	type Payload (Send (Caption :&: Audio)) = Send (Caption :&: URI :&: Audio)+	type Returning (Send (Caption :&: Audio)) = Message+	payload (Send chat_id (caption :&: audio)) = payload (Send chat_id audio) <> field "caption" caption 	endpoint _ = "sendAudio"  instance Persistable (Send Document) where-	type instance Payload (Send Document) = Send (URI :&: Document)-	payload (Send chat_id (uri :&: Document file_name mime_type file_size)) = singleton "file_id" (toJSON uri)-		<> singleton "chat_id" (toJSON chat_id) <> singleton "file_name" (toJSON file_name)-		<> singleton "mime_type" (toJSON mime_type) <> singleton "file_size" (toJSON file_size)+	type Payload (Send Document) = Send (URI :&: Document)+	type Returning (Send Document) = Message+	payload (Send chat_id (uri :&: Document file_name mime_type file_size)) = field "file_id" uri+		<> field "chat_id" chat_id <> field "file_name" file_name+		<> field "mime_type" mime_type <> field "file_size" file_size 	endpoint _ = "sendDocument"  instance Persistable (Send (Caption :&: Document)) where-	type instance Payload (Send (Caption :&: Document)) = Send (Caption :&: URI :&: Document)-	payload (Send chat_id (caption :&: document)) = payload (Send chat_id document) <> singleton "caption" (toJSON caption)+	type Payload (Send (Caption :&: Document)) = Send (Caption :&: URI :&: Document)+	type Returning (Send (Caption :&: Document)) = Message+	payload (Send chat_id (caption :&: document)) = payload (Send chat_id document) <> field "caption" caption 	endpoint _ = "sendDocument"  instance Persistable (Send Video) where-	type instance Payload (Send Video) = Send (URI :&: Video)-	payload (Send chat_id (uri :&: Video width height duration mime_type file_size)) = singleton "file_id" (toJSON uri)-		<> singleton "chat_id" (toJSON chat_id) <> singleton "duration" (toJSON duration) <> singleton "width" (toJSON width)-		<> singleton "height" (toJSON height) <> singleton "mime_type" (toJSON mime_type) <> singleton "file_size" (toJSON file_size)+	type Payload (Send Video) = Send (URI :&: Video)+	type Returning (Send Video) = Message+	payload (Send chat_id (uri :&: Video width height duration mime_type file_size)) = field "file_id" uri+		<> field "chat_id" chat_id <> field "duration" duration <> field "width" width+		<> field "height" height <> field "mime_type" mime_type <> field "file_size" file_size 	endpoint _ = "sendVideo"  instance Persistable (Send (Caption :&: Video)) where-	type instance Payload (Send (Caption :&: Video)) = Send (Caption :&: URI :&: Video)-	payload (Send chat_id (caption :&: video)) = payload (Send chat_id video) <> singleton "caption" (toJSON caption)+	type Payload (Send (Caption :&: Video)) = Send (Caption :&: URI :&: Video)+	type Returning (Send (Caption :&: Video)) = Message+	payload (Send chat_id (caption :&: video)) = payload (Send chat_id video) <> field "caption" caption 	endpoint _ = "sendVideo"  instance Persistable (Send Voice) where-	type instance Payload (Send Voice) = Send (URI :&: Voice)-	payload (Send chat_id (uri :&: Voice duration mime_type file_size)) = singleton "file_id" (toJSON uri)-		<> singleton "chat_id" (toJSON chat_id) <> singleton "duration" (toJSON duration)-		<> singleton "mime_type" (toJSON mime_type) <> singleton "file_size" (toJSON file_size)+	type Payload (Send Voice) = Send (URI :&: Voice)+	type Returning (Send Voice) = Message+	payload (Send chat_id (uri :&: Voice duration mime_type file_size)) = field "file_id" uri+		<> field "chat_id" chat_id <> field "duration" duration+		<> field "mime_type" mime_type <> field "file_size" file_size 	endpoint _ = "sendVoice"  instance Persistable (Send (Caption :&: Voice)) where-	type instance Payload (Send (Caption :&: Voice)) = Send (Caption :&: URI :&: Voice)-	payload (Send chat_id (caption :&: voice)) = payload (Send chat_id voice) <> singleton "caption" (toJSON caption)+	type Payload (Send (Caption :&: Voice)) = Send (Caption :&: URI :&: Voice)+	type Returning (Send (Caption :&: Voice)) = Message+	payload (Send chat_id (caption :&: voice)) = payload (Send chat_id voice) <> field "caption" caption 	endpoint _ = "sendVoice" +instance Persistable (Send Photo) where+	type Payload (Send Photo) = Send URI+	type Returning (Send Photo) = Message+	payload (Send chat_id uri) = field "chat_id" chat_id <> field "photo" uri+	endpoint _ = "sendPhoto"++instance Persistable (Send (Caption :&: Photo)) where+	type Payload (Send (Caption :&: Photo)) = Send (Caption :&: URI)+	type Returning (Send (Caption :&: Photo)) = Message+	payload (Send chat_id (caption :&: uri)) = field "chat_id" chat_id+		<> field "photo" uri <> field "caption" caption+	endpoint _ = "sendPhoto"+ instance Persistable (Send Location) where-	type instance Payload (Send Location) = Send Location-	payload (Send chat_id (Location latitude longitude)) = singleton "chat_id" (toJSON chat_id)-		<> singleton "latitude" (toJSON latitude) <> singleton "longitude" (toJSON longitude)+	type Payload (Send Location) = Send Location+	type Returning (Send Location) = Message+	payload (Send chat_id (Location latitude longitude)) = field "chat_id" chat_id+		<> field "latitude" latitude <> field "longitude" longitude 	endpoint _ = "sendLocation"  instance Persistable (Send (Live Location)) where-	type instance Payload (Send (Live Location)) = Send (Live Location)+	type Payload (Send (Live Location)) = Send (Live Location)+	type Returning (Send (Live Location)) = Message 	payload (Send chat_id (Live live_period (Location latitude longitude))) =-		singleton "chat_id" (toJSON chat_id) <> singleton "live_period" (toJSON live_period)-		<> singleton "latitude" (toJSON latitude) <> singleton "longitude" (toJSON longitude)+		field "chat_id" chat_id <> field "live_period" live_period+		<> field "latitude" latitude <> field "longitude" longitude 	endpoint _ = "sendLocation"  instance Persistable (Send Poll) where-	type instance Payload (Send Poll) = Send Poll-	payload (Send chat_id (Opened question options)) = singleton "chat_id" (toJSON chat_id)-		<> singleton "question" (toJSON question) <> singleton "options" (toJSON options)-	payload (Send chat_id (Closed question options)) = singleton "chat_id" (toJSON chat_id)-		<> singleton "question" (toJSON question) <> singleton "options" (toJSON options)+	type Payload (Send Poll) = Send Poll+	type Returning (Send Poll) = Message+	payload (Send chat_id (Poll question options)) = field "chat_id" chat_id+		<> field "question" question <> field "options" options 	endpoint _ = "sendPoll"  data Reply a = Reply Int a  instance Persistable (Send a) => Persistable (Reply a) where 	type Payload (Reply a) = Reply (Payload (Send a))-	payload (Reply reply_to_message_id x) = payload x <> singleton-		"reply_to_message_id" (toJSON reply_to_message_id)+	type Returning (Reply a) = Returning (Send a)+	payload (Reply reply_to_message_id x) = payload x <> field+		"reply_to_message_id" reply_to_message_id 	endpoint (Reply _ x) = endpoint x  data Edit b = Edit Int64 Int b  instance Persistable (Edit Text) where 	type Payload (Edit Text) = Edit Text-	payload (Edit chat_id message_id text) = singleton "chat_id" (toJSON chat_id)-		<> singleton "message_id" (toJSON message_id) <> singleton "text" (toJSON text)+	type Returning (Edit Text) = Message+	payload (Edit chat_id message_id text) = field "chat_id" chat_id+		<> field "message_id" message_id <> field "text" text 	endpoint _ = "editMessageText"  instance Persistable (Edit Keyboard) where 	type Payload (Edit Keyboard) = Edit Keyboard-	payload (Edit chat_id message_id reply_markup) = singleton "chat_id" (toJSON chat_id)-		<> singleton "message_id" (toJSON message_id) <> singleton "reply_markup" (toJSON reply_markup)+	type Returning (Edit Keyboard) = Message+	payload (Edit chat_id message_id reply_markup) = field "chat_id" chat_id+		<> field "message_id" message_id <> field "reply_markup" reply_markup 	endpoint _ = "editMessageText"  instance Persistable (Edit (Text :&: Keyboard)) where 	type Payload (Edit (Text :&: Keyboard)) = Edit (Text :&: Keyboard)+	type Returning (Edit (Text :&: Keyboard)) = Message 	payload (Edit chat_id message_id (text :&: reply_markup)) =-		singleton "chat_id" (toJSON chat_id) <> singleton "message_id" (toJSON message_id)-		<> singleton "text" (toJSON text) <> singleton "reply_markup" (toJSON reply_markup)+		field "chat_id" chat_id <> field "message_id" message_id+		<> field "text" text <> field "reply_markup" reply_markup 	endpoint _ = "editMessageText"  instance Persistable (Edit (Live Location)) where-	type instance Payload (Edit (Live Location)) = Edit Location+	type Payload (Edit (Live Location)) = Edit Location+	type Returning (Edit (Live Location)) = Message 	payload (Edit chat_id message_id (Location latitude longitude)) =-		singleton "chat_id" (toJSON chat_id) <> singleton "message_id" (toJSON message_id)-		<> singleton "latitude" (toJSON latitude) <> singleton "longitude" (toJSON longitude)+		field "chat_id" chat_id <> field "message_id" message_id+		<> field "latitude" latitude <> field "longitude" longitude 	endpoint _ = "editMessageLiveLocation"  data Delete a = Delete Int64 Int  instance Persistable (Delete Message) where 	type Payload (Delete Message) = Delete Message-	payload (Delete chat_id message_id) = singleton "chat_id" (toJSON chat_id)-		<> singleton "message_id" (toJSON message_id)+	type Returning (Delete Message) = ()+	payload (Delete chat_id message_id) = field "chat_id" chat_id+		<> field "message_id" message_id 	endpoint _ = "deleteMessage"  data Stop a = Stop Int64 Int  instance Persistable (Stop (Live Location)) where-	type instance Payload (Stop (Live Location)) = Stop (Live Location)-	payload (Stop chat_id message_id) = singleton "chat_id" (toJSON chat_id)-		<> singleton "message_id" (toJSON message_id)+	type Payload (Stop (Live Location)) = Stop (Live Location)+	type Returning (Stop (Live Location)) = Message+	payload (Stop chat_id message_id) = field "chat_id" chat_id+		<> field "message_id" message_id 	endpoint _ = "stopMessageLiveLocation"  instance Persistable (Stop Poll) where-	type instance Payload (Stop Poll) = Stop (Stop Poll)-	payload (Stop chat_id message_id) = singleton "chat_id" (toJSON chat_id)-		<> singleton "message_id" (toJSON message_id)+	type Payload (Stop Poll) = Stop (Stop Poll)+	type Returning (Stop Poll) = Poll+	payload (Stop chat_id message_id) = field "chat_id" chat_id+		<> field "message_id" message_id 	endpoint _ = "stopPoll"  data Silently (todo :: * -> *) a = Silently a  instance Persistable (Forward obj) => Persistable (Silently Forward obj) where 	type Payload (Silently Forward obj) = Silently Forward (Payload (Forward obj))-	payload (Silently x) = payload x <> singleton "disable_notification" (toJSON True)+	type Returning (Silently Forward obj) = Message+	payload (Silently x) = payload x <> field "disable_notification" True 	endpoint (Silently x) = endpoint x  instance Persistable (Send obj) => Persistable (Silently Send obj) where 	type Payload (Silently Send obj) = Silently Send (Payload (Send obj))-	payload (Silently x) = payload x <> singleton "disable_notification" (toJSON True)+	type Returning (Silently Send obj) = Message+	payload (Silently x) = payload x <> field "disable_notification" True 	endpoint (Silently x) = endpoint x  instance Persistable (Reply obj) => Persistable (Silently Reply obj) where 	type Payload (Silently Reply obj) = Silently Reply (Payload (Reply obj))-	payload (Silently x) = payload x <> singleton "disable_notification" (toJSON True)+	type Returning (Silently Reply obj) = Message+	payload (Silently x) = payload x <> field "disable_notification" True 	endpoint (Silently x) = endpoint x

@@ -1,4 +1,5 @@-module Network.API.Telegram.Bot.Object.Update.Message.Content (Content (..), module Exports) where+module Network.API.Telegram.Bot.Object.Update.Message.Content+	(module Exports, Content (..), Status (..)) where  import Network.API.Telegram.Bot.Object.Update.Message.Content.File as Exports import Network.API.Telegram.Bot.Object.Update.Message.Content.Info as Exports@@ -8,6 +9,7 @@ import "aeson" Data.Aeson.Types (Object, Parser, Value (Object)) import "base" Control.Applicative (Applicative ((<*>)), Alternative (empty, (<|>))) import "base" Control.Monad (Monad ((>>=)), fail)+import "base" Data.Bool (bool) import "base" Data.Function ((.), ($)) import "base" Data.Functor ((<$>)) import "base" Data.Foldable (Foldable (foldr))@@ -17,11 +19,14 @@ import "base" Prelude ((+)) import "text" Data.Text (Text, drop, take) +data Status = Opened | Closed+	deriving Show+ data Content 	= Textual Text 	| Command Text 	| Attachment (Maybe Caption) File-	| Polling Text Poll+	| Polling Text Status Poll 	| Information Info 	deriving Show @@ -50,10 +55,15 @@ 		information v = Information <$> parseJSON (Object v)  		polling :: Object -> Parser Content-		polling v = Polling <$> (v .: "poll" >>= poll_id) <*> v .: "poll" where+		polling v = Polling <$> (v .: "poll" >>= poll_id)+			<*> (v .: "poll" >>= poll_status) <*> v .: "poll" where  			poll_id :: Value -> Parser Text 			poll_id = withObject "Poll" $ \p -> p .: "id"++			poll_status :: Value -> Parser Status+			poll_status = withObject "Poll" $ \p ->+				bool Opened Closed <$> p .: "is_closed"  		textual :: Object -> Parser Content 		textual v = Textual <$> v .: "text"

@@ -1,40 +1,23 @@ module Network.API.Telegram.Bot.Object.Update.Message.Content.Info (Info (..), module Exports) where +import Network.API.Telegram.Bot.Object.Update.Message.Content.Info.Contact as Exports import Network.API.Telegram.Bot.Object.Update.Message.Content.Info.Location as Exports+import Network.API.Telegram.Bot.Object.Update.Message.Content.Info.Venue as Exports -import "aeson" Data.Aeson (FromJSON (parseJSON), withObject, (.:), (.:?))-import "aeson" Data.Aeson.Types (Object, Parser, Value)-import "base" Control.Applicative ((<*>), (<|>))-import "base" Control.Monad ((>>=))+import "aeson" Data.Aeson (FromJSON (parseJSON), withObject, (.:))+import "base" Control.Applicative ((<|>)) import "base" Data.Function (($)) import "base" Data.Functor ((<$>))-import "base" Data.Maybe (Maybe) import "base" Text.Show (Show)-import "text" Data.Text (Text) -data Info = Point Location-	| Contact Text (Maybe Text) Text (Maybe Text)-	| Venue Location Text Text (Maybe Text) (Maybe Text)+data Info+	= Point Location+	| User Contact+	| Meeting Venue 	deriving Show  instance FromJSON Info where-	parseJSON = withObject "Info" $ \v -> contact v <|> venue v <|> point v where--		contact :: Object -> Parser Info-		contact v = v .: "contact" >>= info where--			info :: Value -> Parser Info-			info = withObject "Contact" $ \i -> Contact-				<$> i .: "first_name" <*> i .:? "last_name"-				<*> i .: "phone_number" <*> i .:? "vcard"--		venue :: Object -> Parser Info-		venue v = v .: "venue" >>= info where--			info :: Value -> Parser Info-			info = withObject "Venue" $ \i -> Venue-				<$> i .: "location" <*> i .: "title" <*> i .: "address"-				<*> i .:? "foursquare_id" <*> i .:? "foursquare_type"--		point :: Object -> Parser Info-		point v = Point <$> v .: "location"+	parseJSON = withObject "Info" $ \v ->+		(User <$> v .: "contact") <|>+		(Meeting <$> v .: "venue") <|>+		(Point <$> v .: "location")

@@ -0,0 +1,20 @@+module Network.API.Telegram.Bot.Object.Update.Message.Content.Info.Contact (Contact (..)) where++import "aeson" Data.Aeson (FromJSON (parseJSON), withObject, (.:), (.:?))+import "base" Control.Applicative ((<*>))+import "base" Data.Function (($))+import "base" Data.Functor ((<$>))+import "base" Data.Maybe (Maybe)+import "base" Text.Show (Show)+import "text" Data.Text (Text)++import Network.API.Telegram.Bot.Object.Update.Message.Content.Info.Location (Location)++data Contact = Contact Text (Maybe Text) (Maybe Text) Text (Maybe Text)+	deriving Show++instance FromJSON Contact where+	parseJSON = withObject "Contact" $ \i -> Contact+		<$> i .: "first_name" <*> i .:? "last_name"+		<*> i .:? "user_id" <*> i .: "phone_number"+		<*> i .:? "vcard"

@@ -0,0 +1,19 @@+module Network.API.Telegram.Bot.Object.Update.Message.Content.Info.Venue (Venue (..)) where++import "aeson" Data.Aeson (FromJSON (parseJSON), withObject, (.:), (.:?))+import "base" Control.Applicative ((<*>))+import "base" Data.Function (($))+import "base" Data.Functor ((<$>))+import "base" Data.Maybe (Maybe)+import "base" Text.Show (Show)+import "text" Data.Text (Text)++import Network.API.Telegram.Bot.Object.Update.Message.Content.Info.Location (Location)++data Venue = Venue Text Text Location (Maybe Text) (Maybe Text)+	deriving Show++instance FromJSON Venue where+	parseJSON = withObject "Venue" $ \i -> Venue+		<$> i .: "title" <*> i .: "address" <*> i .: "location"+		<*> i .:? "foursquare_id" <*> i .:? "foursquare_type"

@@ -3,25 +3,15 @@ import Network.API.Telegram.Bot.Object.Update.Message.Content.Poll.Option as Exports  import "aeson" Data.Aeson (FromJSON (parseJSON), withObject, (.:))-import "aeson" Data.Aeson.Types (Object, Parser) import "base" Control.Applicative ((<*>))-import "base" Control.Monad ((>>=))-import "base" Data.Bool (bool) import "base" Data.Function (($)) import "base" Data.Functor ((<$>)) import "base" Text.Show (Show) import "text" Data.Text (Text) -data Poll-	= Opened Text [Option]-	| Closed Text [Option]+data Poll = Poll Text [Option] 	deriving Show -type State = Text -> [Option] -> Poll- instance FromJSON Poll where-	parseJSON = withObject "Pool" $ \v -> v .: "is_closed"-		>>= bool (state v Opened) (state v Closed) where--		state :: Object -> State -> Parser Poll-		state v f = f <$> v .: "question" <*> v .: "options"+	parseJSON = withObject "Pool" $ \v ->+		Poll <$> v .: "question" <*> v .: "options"

@@ -32,7 +32,7 @@ 			_ -> fail "Type of chat is not defined"  instance Identifiable Origin where-	type instance Identificator Origin = Int64+	type Identificator Origin = Int64 	ident (Private i _) = i 	ident (Group i _ _) = i 	ident (Supergroup i _ _) = i

@@ -21,16 +21,17 @@ class Persistable action where 	{-# MINIMAL payload, endpoint #-} 	type Payload action = payload | payload -> action+	type Returning action :: * 	payload :: Payload action -> Object 	endpoint :: Payload action -> String -	persist :: FromJSON r => Payload action -> Telegram e r-	persist x = request (endpoint x) (Object $ payload x) where--		request :: forall a e . FromJSON a => String -> Value -> Telegram e a-		request e p = snd <$> ask >>= \(session, Token token) -> lift . ExceptT . try-			. fmap (fromJust . join . fmap result . decode @(Ok a) . responseBody)-				. flip (post session) p $ "https://api.telegram.org/" <> unpack token <> "/" <> e+	persist :: FromJSON (Returning action) => Payload action -> Telegram e (Returning action)+	persist x = request (endpoint x) (Object $ payload x)  	persist_ :: Payload action -> Telegram e ()-	persist_ x = persist @_ @() x where+	persist_ x = request @() @_ (endpoint x) (Object $ payload x)++request :: forall a e . FromJSON a => String -> Value -> Telegram e a+request e p = snd <$> ask >>= \(session, Token token) -> lift . ExceptT . try+	. fmap (fromJust . join . fmap result . decode @(Ok a) . responseBody)+		. flip (post session) p $ "https://api.telegram.org/" <> unpack token <> "/" <> e

@@ -0,0 +1,9 @@+module Network.API.Telegram.Bot.Utils (field) where++import "aeson" Data.Aeson (ToJSON (toJSON), Object)+import "base" Data.Function ((.))+import "text" Data.Text (Text)+import "unordered-containers" Data.HashMap.Strict (singleton)++field :: ToJSON a => Text -> a -> Object+field key = singleton key . toJSON

@@ -1,5 +1,5 @@ name:                telega-version:             0.2.4+version:             0.2.5 synopsis:            Telegram Bot API binding description:         High-level bindings, typed entities, inline mode only homepage:            https://github.com/iokasimov/telega@@ -41,7 +41,9 @@     Network.API.Telegram.Bot.Object.Update.Message.Content.File.Video     Network.API.Telegram.Bot.Object.Update.Message.Content.File.Voice     Network.API.Telegram.Bot.Object.Update.Message.Content.Info+    Network.API.Telegram.Bot.Object.Update.Message.Content.Info.Contact     Network.API.Telegram.Bot.Object.Update.Message.Content.Info.Location+    Network.API.Telegram.Bot.Object.Update.Message.Content.Info.Venue     Network.API.Telegram.Bot.Object.Update.Message.Content.Poll     Network.API.Telegram.Bot.Object.Update.Message.Content.Poll.Option     Network.API.Telegram.Bot.Object.Update.Message.Keyboard@@ -53,9 +55,10 @@     Network.API.Telegram.Bot.Property.Accessible     Network.API.Telegram.Bot.Property.Identifiable     Network.API.Telegram.Bot.Property.Persistable-  build-depends: base == 4.*, transformers, with, lens, aeson, text, unordered-containers, http-client, wreq+    Network.API.Telegram.Bot.Utils+  build-depends: base == 4.*, data-default, transformers, with, lens, aeson, text, unordered-containers, http-client, wreq   default-extensions: DataKinds, LambdaCase, OverloadedStrings, NoImplicitPrelude, PackageImports, GADTs,-    AllowAmbiguousTypes, MultiParamTypeClasses, ScopedTypeVariables, UndecidableInstances, UndecidableSuperClasses,-    FlexibleInstances, TypeApplications, TypeFamilies, TypeFamilyDependencies, TypeOperators, PolyKinds+    FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, UndecidableSuperClasses,+    TypeApplications, TypeFamilies, TypeFamilyDependencies, TypeOperators, ScopedTypeVariables, PolyKinds   default-language: Haskell2010   ghc-options: -Wall -fno-warn-tabs -fprint-explicit-kinds