packages feed

telega 0.1.4 → 0.1.5

raw patch · 19 files changed

+165/−183 lines, 19 files

Files

CHANGELOG.md view
@@ -26,3 +26,12 @@ * Define `Endpoint` typeclass to replace `Capacity` * Remove `Capacity` classes and theirs instances * Define `Object` type family++# 0.1.5+* Remove `Internal` module, move its content to `Endpoint`+* Remove `Drop` phantom datatype, replace it with `Post`+* Use promoted constructors of `Capacity` instead of separated datatypes+* Use `MultiParamTypeClasses` instead of `FlexibleIntances` for `Endpoint`+* Use `UndecidableInstances` and `UndecidableSuperClasses` to use `Object` type family+* Replace `Access` module with `Accessible` `Property`+* Replace `Endpoint` module with `Persistable` `Property`
Network/Telegram/API/Bot.hs view
@@ -2,6 +2,4 @@  import Network.Telegram.API.Bot.Property as Exports import Network.Telegram.API.Bot.Object as Exports-import Network.Telegram.API.Bot.Endpoint as Exports-import Network.Telegram.API.Bot.Access as Exports import Network.Telegram.API.Bot.Core as Exports
− Network/Telegram/API/Bot/Access.hs 
@@ -1,6 +0,0 @@-module Network.Telegram.API.Bot.Access (Access (..)) where--import "lens" Control.Lens (Lens')--class Access target source where-	access :: Lens' source target
− Network/Telegram/API/Bot/Endpoint.hs 
@@ -1,22 +0,0 @@-module Network.Telegram.API.Bot.Endpoint-	(Endpoint (..), Payload, Drop, Edit, Post, Purge) where--import "aeson" Data.Aeson (FromJSON, Value)-import "base" Data.String (String)--import Network.Telegram.API.Bot.Core (Telegram)-import Network.Telegram.API.Bot.Internal (telegram_request)--type family Payload a = r | r -> a--data Drop a-data Edit a-data Post a-data Purge a--class Endpoint a where-	{-# MINIMAL payload, endpoint #-}-	payload :: Payload a -> Value-	endpoint :: Payload a -> String-	request :: FromJSON r => Payload a -> Telegram e r-	request x = telegram_request (endpoint x) (payload x)
− Network/Telegram/API/Bot/Internal.hs 
@@ -1,25 +0,0 @@-module Network.Telegram.API.Bot.Internal (telegram_request) where--import "aeson" Data.Aeson (FromJSON, Value, decode)-import "base" Control.Exception (try)-import "base" Control.Monad (Monad ((>>=)), join)-import "base" Data.Function (flip, (.), ($))-import "base" Data.Functor (Functor (fmap), (<$>))-import "base" Data.Maybe (fromJust)-import "base" Data.Semigroup (Semigroup ((<>)))-import "base" Data.String (String)-import "base" Data.Tuple (snd)-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)--telegram_request :: forall a e . FromJSON a => String -> Value -> Telegram e a-telegram_request endpoint payload = snd <$> ask >>= \(session, Token token) -> lift . ExceptT . try-	. fmap (fromJust . join . fmap result . decode @(Ok a) . responseBody)-		. flip (Wreq.post session) payload $ "https://api.telegram.org/" <> unpack token <> "/" <> endpoint
Network/Telegram/API/Bot/Object/Callback.hs view
@@ -2,14 +2,11 @@  import "aeson" Data.Aeson (FromJSON (parseJSON), withObject, (.:)) import "base" Control.Applicative (Applicative ((<*>)))-import "base" Data.Function (flip, ($))+import "base" Data.Function (($)) import "base" Data.Functor ((<$>)) import "base" Text.Show (Show) import "text" Data.Text (Text) -import Network.Telegram.API.Bot.Access (Access (access))-import Network.Telegram.API.Bot.Object.Chat (Chat)-import Network.Telegram.API.Bot.Object.From (From) import Network.Telegram.API.Bot.Object.Message (Message)  data Callback = Datatext Text Message Text deriving Show@@ -17,11 +14,3 @@ instance FromJSON Callback where 	parseJSON = withObject "Callback" $ \v -> 		Datatext <$> v .: "id" <*> v .: "message" <*> v .: "data"--instance Access Chat Callback where-	access f (Datatext cq_id msg dttxt) = flip-		(Datatext cq_id) dttxt <$> access f msg--instance Access From Callback where-	access f (Datatext cq_id msg dttxt) = flip-		(Datatext cq_id) dttxt <$> access f msg
Network/Telegram/API/Bot/Object/Chat.hs view
@@ -9,23 +9,12 @@ import "base" Text.Show (Show) 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
Network/Telegram/API/Bot/Object/From.hs view
@@ -15,19 +15,10 @@ 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'
Network/Telegram/API/Bot/Object/Keyboard.hs view
@@ -1,12 +1,10 @@-module Network.Telegram.API.Bot.Object.Keyboard (Keyboard (..), Payload) where+module Network.Telegram.API.Bot.Object.Keyboard (Keyboard (..)) where  import "aeson" Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), object, withObject, (.:), (.=)) import "base" Data.Function (($)) import "base" Data.Functor ((<$>))-import "base" Data.Int (Int, Int64) import "base" Text.Show (Show) -import Network.Telegram.API.Bot.Endpoint (Endpoint (payload, endpoint), Payload, Edit) import Network.Telegram.API.Bot.Object.Button (Button)  data Keyboard = Inline [[Button]] deriving Show@@ -18,10 +16,3 @@ instance ToJSON Keyboard where 	toJSON (Inline buttons) = object 		["inline_keyboard" .= buttons]--type instance Payload (Edit Keyboard) = (Int64, Int, Keyboard)--instance Endpoint (Edit Keyboard) where-	payload (chat_id, message_id, reply_markup) = object-		["chat_id" .= chat_id, "message_id" .= message_id, "reply_markup" .= reply_markup]-	endpoint _ = "editMessageReplyMarkup"
Network/Telegram/API/Bot/Object/Member.hs view
@@ -16,7 +16,7 @@ 	| Administrator From 	| Member From 	| Restricted From POSIXTime-	-- | Left From+	| Left From 	| Kicked From POSIXTime 	deriving Show @@ -26,6 +26,6 @@ 		("administrator" :: Text) -> Administrator <$> v .: "user" 		("member" :: Text) -> Member <$> v .: "user" 		("restricted" :: Text) -> Restricted <$> v .: "user" <*> v .: "until_date"-		-- ("left" :: Text) -> Left <$> v .: "user"+		("left" :: Text) -> Left <$> v .: "user" 		("kicked" :: Text) -> Kicked <$> v .: "user" <*> v.: "until_date" 		_ -> fail "Status of chat member is not defined"
Network/Telegram/API/Bot/Object/Message.hs view
@@ -1,40 +1,25 @@-module Network.Telegram.API.Bot.Object.Message-	(Message (..), Payload) where+module Network.Telegram.API.Bot.Object.Message (Message (..)) where -import "aeson" Data.Aeson (FromJSON (parseJSON), object, withArray, withObject, (.:), (.=))+import "aeson" Data.Aeson (FromJSON (parseJSON), withArray, withObject, (.:)) import "aeson" Data.Aeson.Types (Object, Parser, Value) import "base" Control.Applicative (Applicative ((<*>)), Alternative (empty, (<|>))) import "base" Control.Monad (Monad ((>>=)), fail) import "base" Data.Function ((.), ($)) import "base" Data.Functor ((<$>)) import "base" Data.Foldable (Foldable (foldr))-import "base" Data.Int (Int, Int64)-import "base" Data.Maybe (Maybe (Just, Nothing))+import "base" Data.Int (Int) import "base" Text.Show (Show) import "base" Prelude ((+))-import "text" Data.Text (Text)--import qualified "text" Data.Text as T (drop, take)+import "text" Data.Text (Text, drop, take) -import Network.Telegram.API.Bot.Access (Access (access))-import Network.Telegram.API.Bot.Endpoint (Endpoint (payload, endpoint), Payload, Post, Purge) 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.Property.Identifiable-	(Identifiable (identificator), Identificator)  data Message 	= Textual Int Chat From Text 	| Command Int Chat From Text 	deriving Show -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 @@ -56,24 +41,4 @@ 				_ -> 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 Access Chat Message where-	access f (Textual msg_id chat from txt) = (\chat' -> Textual msg_id chat' from txt) <$> f chat-	access f (Command msg_id chat from cmd) = (\chat' -> Command msg_id chat' from cmd) <$> f chat--instance Access From Message where-	access f (Textual msg_id chat from txt) = (\from' -> Textual msg_id chat from' txt) <$> f from-	access f (Command msg_id chat from cmd) = (\from' -> Command msg_id chat from' cmd) <$> f from--type instance Payload (Post Message) = (Int64, Text, Maybe Keyboard)-type instance Payload (Purge Message) = (Int64, Int)--instance Endpoint (Post Message) where-	payload (chat_id, text, Nothing) = object ["chat_id" .= chat_id, "text" .= text]-	payload (chat_id, text, Just kb) = object ["chat_id" .= chat_id, "text" .= text, "reply_markup" .= kb]-	endpoint _ = "sendMessage"--instance Endpoint (Purge Message) where-	payload (chat_id, message_id) = object ["chat_id" .= chat_id, "message_id" .= message_id]-	endpoint _ = "deleteMessage"+		extract_command v (ofs, len) = (take len . drop (ofs + 1)) <$> v .: "text"
Network/Telegram/API/Bot/Object/Moving.hs view
@@ -7,7 +7,6 @@ import "base" Data.Functor ((<$>)) import "base" Text.Show (Show) -import Network.Telegram.API.Bot.Access (Access (access)) import Network.Telegram.API.Bot.Object.Chat (Chat) import Network.Telegram.API.Bot.Object.From (From) @@ -21,7 +20,3 @@  		joined :: Object -> Parser Moving 		joined v = Joined <$> v .: "chat" <*> v .: "new_chat_members"--instance Access Chat Moving where-	access f (Gone chat from) = (\chat' -> Gone chat' from) <$> f chat-	access f (Joined chat froms) = (\chat' -> Joined chat' froms) <$> f chat
Network/Telegram/API/Bot/Object/Notification.hs view
@@ -1,15 +1,3 @@-module Network.Telegram.API.Bot.Object.Notification (Notification, Payload) where--import "aeson" Data.Aeson (object, (.=))-import "text" Data.Text (Text)--import Network.Telegram.API.Bot.Endpoint (Endpoint (payload, endpoint), Payload, Drop)+module Network.Telegram.API.Bot.Object.Notification (Notification) where  data Notification--type instance Payload (Drop Notification) = (Text, Text)--instance Endpoint (Drop Notification) where-	payload (cbq_id, text) = object-		["callback_query_id" .= cbq_id, "text" .= text]-	endpoint _ = "answerCallbackQuery"
Network/Telegram/API/Bot/Object/Update.hs view
@@ -8,13 +8,9 @@ import "base" Data.Int (Int) import "base" Text.Show (Show) -import Network.Telegram.API.Bot.Access (Access (access)) import Network.Telegram.API.Bot.Object.Callback (Callback)-import Network.Telegram.API.Bot.Object.Chat (Chat) import Network.Telegram.API.Bot.Object.Moving (Moving) import Network.Telegram.API.Bot.Object.Message (Message)-import Network.Telegram.API.Bot.Property.Identifiable-	(Identifiable (identificator), Identificator)  data Update 	= Query Int Callback@@ -22,13 +18,6 @@ 	| Incoming Int Message 	deriving Show -type instance Identificator Update = Int--instance Identifiable Update where-	identificator (Query i _) = i-	identificator (Membership i _) = i-	identificator (Incoming i _) = i- instance FromJSON Update where 	parseJSON = withObject "Update" $ \v -> 		query v <|> membership v <|> incoming v where@@ -41,8 +30,3 @@  		incoming :: Object -> Parser Update 		incoming v = Incoming <$> v .: "update_id" <*> v .: "message"--instance Access Chat Update where-	access f (Incoming upd_id msg) = Incoming upd_id <$> access f msg-	access f (Query upd_id cb) = Query upd_id <$> access f cb-	access f (Membership upd_id mmb) = Membership upd_id <$> access f mmb
Network/Telegram/API/Bot/Property.hs view
@@ -1,3 +1,5 @@ module Network.Telegram.API.Bot.Property (module Exports) where +import Network.Telegram.API.Bot.Property.Persistable as Exports import Network.Telegram.API.Bot.Property.Identifiable as Exports+import Network.Telegram.API.Bot.Property.Accessible as Exports
+ Network/Telegram/API/Bot/Property/Accessible.hs view
@@ -0,0 +1,41 @@+module Network.Telegram.API.Bot.Property.Accessible (Accessible (..)) where++import "base" Data.Function (flip)+import "base" Data.Functor ((<$>))+import "lens" Control.Lens (Lens')++import Network.Telegram.API.Bot.Object (Object)+import Network.Telegram.API.Bot.Object.Callback (Callback (Datatext))+import Network.Telegram.API.Bot.Object.Chat (Chat)+import Network.Telegram.API.Bot.Object.From (From)+import Network.Telegram.API.Bot.Object.Message (Message (Textual, Command))+import Network.Telegram.API.Bot.Object.Moving (Moving (Gone, Joined))+import Network.Telegram.API.Bot.Object.Update (Update (Query, Membership, Incoming))++class Object source => Accessible target source where+	access :: Lens' source target++instance Accessible Chat Callback where+	access f (Datatext cq_id msg dttxt) = flip+		(Datatext cq_id) dttxt <$> access f msg++instance Accessible Chat Message where+	access f (Textual msg_id chat from txt) = (\chat' -> Textual msg_id chat' from txt) <$> f chat+	access f (Command msg_id chat from cmd) = (\chat' -> Command msg_id chat' from cmd) <$> f chat++instance Accessible Chat Moving where+	access f (Gone chat from) = (\chat' -> Gone chat' from) <$> f chat+	access f (Joined chat froms) = (\chat' -> Joined chat' froms) <$> f chat++instance Accessible Chat Update where+	access f (Incoming upd_id msg) = Incoming upd_id <$> access f msg+	access f (Query upd_id cb) = Query upd_id <$> access f cb+	access f (Membership upd_id mmb) = Membership upd_id <$> access f mmb++instance Accessible From Callback where+	access f (Datatext cq_id msg dttxt) = flip+		(Datatext cq_id) dttxt <$> access f msg++instance Accessible From Message where+	access f (Textual msg_id chat from txt) = (\from' -> Textual msg_id chat from' txt) <$> f from+	access f (Command msg_id chat from cmd) = (\from' -> Command msg_id chat from' cmd) <$> f from
Network/Telegram/API/Bot/Property/Identifiable.hs view
@@ -1,7 +1,39 @@ module Network.Telegram.API.Bot.Property.Identifiable (Identifiable (..), Identificator) where -type family Identificator a = r+import "base" Data.Int (Int, Int64) -class Identifiable a where+import Network.Telegram.API.Bot.Object (Object)+import Network.Telegram.API.Bot.Object.Chat (Chat (Private, Group, Supergroup, Channel))+import Network.Telegram.API.Bot.Object.From (From (Bot, User))+import Network.Telegram.API.Bot.Object.Message (Message (Textual, Command))+import Network.Telegram.API.Bot.Object.Update (Update (Query, Membership, Incoming))++type family Identificator o = i++class Object o => Identifiable o where 	{-# MINIMAL identificator #-}-	identificator :: a -> Identificator a+	identificator :: o -> Identificator o++type instance Identificator Chat = Int64+type instance Identificator From = Int+type instance Identificator Message = Int+type instance Identificator Update = Int++instance Identifiable Chat where+	identificator (Private i) = i+	identificator (Group i _) = i+	identificator (Supergroup i _) = i+	identificator (Channel i _) = i++instance Identifiable From where+	identificator (Bot i _ _ _ _) = i+	identificator (User i _ _ _ _) = i++instance Identifiable Message where+	identificator (Textual i _ _ _) = i+	identificator (Command i _ _ _) = i++instance Identifiable Update where+	identificator (Query i _) = i+	identificator (Membership i _) = i+	identificator (Incoming i _) = i
+ Network/Telegram/API/Bot/Property/Persistable.hs view
@@ -0,0 +1,63 @@+module Network.Telegram.API.Bot.Property.Persistable (Persistable (..), Payload, Capacity (..)) where++import "aeson" Data.Aeson (FromJSON, Value, decode, object, (.=))+import "base" Control.Exception (try)+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 (Maybe (Just, Nothing), fromJust)+import "base" Data.Semigroup (Semigroup ((<>)))+import "base" Data.String (String)+import "base" Data.Tuple (snd)+import "http-client" Network.HTTP.Client (Response (responseBody))+import "text" Data.Text (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 "wreq" Network.Wreq.Session (post)++import Network.Telegram.API.Bot.Core (Telegram, Token (Token), Ok, result)+import Network.Telegram.API.Bot.Object (Object)+import Network.Telegram.API.Bot.Object.Keyboard (Keyboard)+import Network.Telegram.API.Bot.Object.Message (Message)+import Network.Telegram.API.Bot.Object.Notification (Notification)++data Capacity = Post | Edit | Purge++type family Payload (c :: Capacity) o = r | r -> c o++class Object o => Persistable c o where+	{-# MINIMAL payload, endpoint #-}+	payload :: Payload c o -> Value+	endpoint :: Payload c o -> String+	request :: FromJSON r => Payload c o -> Telegram e r+	request x = request' (endpoint x) (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++type instance Payload 'Edit Keyboard = (Int64, Int, Keyboard)+type instance Payload 'Post Message = (Int64, Text, Maybe Keyboard)+type instance Payload 'Purge Message = (Int64, Int)+type instance Payload 'Post Notification = (Text, Text)++instance Persistable 'Edit Keyboard where+	payload (chat_id, message_id, reply_markup) = object+		["chat_id" .= chat_id, "message_id" .= message_id, "reply_markup" .= reply_markup]+	endpoint _ = "editMessageReplyMarkup"++instance Persistable 'Post Message where+	payload (chat_id, text, Nothing) = object ["chat_id" .= chat_id, "text" .= text]+	payload (chat_id, text, Just kb) = object ["chat_id" .= chat_id, "text" .= text, "reply_markup" .= kb]+	endpoint _ = "sendMessage"++instance Persistable 'Purge Message where+	payload (chat_id, message_id) = object ["chat_id" .= chat_id, "message_id" .= message_id]+	endpoint _ = "deleteMessage"++instance Persistable 'Post Notification where+	payload (cbq_id, text) = object ["callback_query_id" .= cbq_id, "text" .= text]+	endpoint _ = "answerCallbackQuery"
telega.cabal view
@@ -1,5 +1,5 @@ name:                telega-version:             0.1.4+version:             0.1.5 synopsis:            Telegram Bot API binding description:         High-level bindings, typed entities, inline mode only homepage:            https://github.com/iokasimov/telega@@ -21,8 +21,6 @@   exposed-modules:     Network.Telegram.API.Bot     Network.Telegram.API.Bot.Core-    Network.Telegram.API.Bot.Access-    Network.Telegram.API.Bot.Endpoint     Network.Telegram.API.Bot.Object     Network.Telegram.API.Bot.Object.Chat     Network.Telegram.API.Bot.Object.From@@ -35,12 +33,12 @@     Network.Telegram.API.Bot.Object.Notification     Network.Telegram.API.Bot.Object.Update     Network.Telegram.API.Bot.Property+    Network.Telegram.API.Bot.Property.Accessible     Network.Telegram.API.Bot.Property.Identifiable-  other-modules:-    Network.Telegram.API.Bot.Internal+    Network.Telegram.API.Bot.Property.Persistable   build-depends: base == 4.*, transformers, lens, aeson, text, time, http-client, wreq-  default-extensions: DataKinds, LambdaCase, OverloadedStrings, NoImplicitPrelude,-    FlexibleInstances, MultiParamTypeClasses, PackageImports, ScopedTypeVariables,+  default-extensions: DataKinds, LambdaCase, OverloadedStrings, NoImplicitPrelude, PackageImports,+    AllowAmbiguousTypes, MultiParamTypeClasses, ScopedTypeVariables, UndecidableInstances, UndecidableSuperClasses,     TypeApplications, TypeFamilies, TypeFamilyDependencies, TypeOperators   default-language: Haskell2010   ghc-options: -Wall -fno-warn-tabs