packages feed

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 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