diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -69,3 +69,14 @@ * 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 + +# 0.2.0 +* Rename `Network.Telegram.API` to `Network.API.Telegram` +* Replace `PL` newtype with `Tagged` newtype from `tagged` package +* Replace `Message'` with `Way` and include it to `Capacity` with `Send` constructor +* Remove `user_id` field from `Contact` datatype +* Define `Persistable` instances for `Location` datatype +* Define `Inform` datatype and include it to `Capacity` with `Send` constructor +* Put `Payload` type family into `Persistable` type class + +# 0.2.1 diff --git a/Network/API/Telegram/Bot.hs b/Network/API/Telegram/Bot.hs new file mode 100644 --- /dev/null +++ b/Network/API/Telegram/Bot.hs @@ -0,0 +1,5 @@ +module Network.API.Telegram.Bot (module Exports) where + +import Network.API.Telegram.Bot.Property as Exports +import Network.API.Telegram.Bot.Object as Exports +import Network.API.Telegram.Bot.Core as Exports diff --git a/Network/API/Telegram/Bot/Core.hs b/Network/API/Telegram/Bot/Core.hs new file mode 100644 --- /dev/null +++ b/Network/API/Telegram/Bot/Core.hs @@ -0,0 +1,38 @@ +module Network.API.Telegram.Bot.Core (Telegram, telegram, ask', Token (..), Ok, result) where + +import "aeson" Data.Aeson (FromJSON (parseJSON), withObject, (.:)) +import "base" Control.Applicative (Applicative ((<*>))) +import "base" Control.Exception (SomeException) +import "base" Data.Bool (Bool (True, False)) +import "base" Data.Eq (Eq) +import "base" Data.Either (Either) +import "base" Data.Function (flip, (.), ($)) +import "base" Data.Functor ((<$>)) +import "base" Data.Maybe (Maybe (Just, Nothing)) +import "base" Data.Tuple (fst) +import "base" System.IO (IO) +import "base" Text.Show (Show) +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" diff --git a/Network/API/Telegram/Bot/Object.hs b/Network/API/Telegram/Bot/Object.hs new file mode 100644 --- /dev/null +++ b/Network/API/Telegram/Bot/Object.hs @@ -0,0 +1,22 @@ +module Network.API.Telegram.Bot.Object (module Exports, Object) where + +import Network.API.Telegram.Bot.Object.Update as Exports +import Network.API.Telegram.Bot.Object.Sender as Exports +import Network.API.Telegram.Bot.Object.Member as Exports + +import "base" Data.Kind (Constraint) + +type family Object (a :: *) :: Constraint +type instance Object Sender = () +type instance Object Update = () +type instance Object Notification = () +type instance Object Moving = () +type instance Object Message = () +type instance Object Member = () +type instance Object Keyboard = () +type instance Object Content = () +type instance Object Origin = () +type instance Object Callback = () +type instance Object Button = () +type instance Object Info = () +type instance Object Location = () diff --git a/Network/API/Telegram/Bot/Object/Member.hs b/Network/API/Telegram/Bot/Object/Member.hs new file mode 100644 --- /dev/null +++ b/Network/API/Telegram/Bot/Object/Member.hs @@ -0,0 +1,35 @@ +module Network.API.Telegram.Bot.Object.Member (Member (..), module Exports) 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), 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) +import "text" Data.Text (Text) +import "time" Data.Time.Clock.POSIX (POSIXTime) + +import Network.API.Telegram.Bot.Object.Sender (Sender) + +data Member + = Creator Sender + | Administrator Sender Bool Powers + | Member Sender + | Restricted Sender Restrictions POSIXTime + | Left Sender + | Kicked Sender POSIXTime + deriving Show + +instance FromJSON Member where + parseJSON = withObject "Member" $ \v -> v .: "status" >>= \case + ("creator" :: Text) -> Creator <$> v .: "user" + ("administrator" :: Text) -> Administrator <$> v .: "user" <*> v .: "can_be_edited" <*> parseJSON (Object v) + ("member" :: Text) -> Member <$> v .: "user" + ("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/API/Telegram/Bot/Object/Member/Powers.hs b/Network/API/Telegram/Bot/Object/Member/Powers.hs new file mode 100644 --- /dev/null +++ b/Network/API/Telegram/Bot/Object/Member/Powers.hs @@ -0,0 +1,21 @@ +module Network.API.Telegram.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/API/Telegram/Bot/Object/Member/Restrictions.hs b/Network/API/Telegram/Bot/Object/Member/Restrictions.hs new file mode 100644 --- /dev/null +++ b/Network/API/Telegram/Bot/Object/Member/Restrictions.hs @@ -0,0 +1,17 @@ +module Network.API.Telegram.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/API/Telegram/Bot/Object/Sender.hs b/Network/API/Telegram/Bot/Object/Sender.hs new file mode 100644 --- /dev/null +++ b/Network/API/Telegram/Bot/Object/Sender.hs @@ -0,0 +1,50 @@ +module Network.API.Telegram.Bot.Object.Sender (Sender (..), nickname, firstname, lastname) where + +import "aeson" Data.Aeson (FromJSON (parseJSON), Object, withObject, (.:), (.:?)) +import "aeson" Data.Aeson.Types (Parser) +import "base" Control.Applicative (Applicative ((<*>))) +import "base" Control.Monad (Monad ((>>=))) +import "base" Data.Bool (Bool (False), bool) +import "base" Data.Eq (Eq ((==))) +import "base" Data.Int (Int) +import "base" Data.Function (($)) +import "base" Data.Functor ((<$>)) +import "base" Data.Maybe (Maybe) +import "base" Text.Show (Show) +import "lens" Control.Lens (Lens') +import "text" Data.Text (Text) + +data Sender + = Bot Int (Maybe Text) Text (Maybe Text) (Maybe Text) + | User 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' + _ == _ = False + +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 + + sender :: Object -> Whom -> Parser Sender + sender v f = f <$> v .: "id" + <*> v .:? "username" + <*> v .: "first_name" + <*> v .:? "last_name" + <*> v .:? "language_code" + +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 + +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 + +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 diff --git a/Network/API/Telegram/Bot/Object/Update.hs b/Network/API/Telegram/Bot/Object/Update.hs new file mode 100644 --- /dev/null +++ b/Network/API/Telegram/Bot/Object/Update.hs @@ -0,0 +1,36 @@ +module Network.API.Telegram.Bot.Object.Update (Update (..), module Exports) where + +import Network.API.Telegram.Bot.Object.Update.Callback as Exports +import Network.API.Telegram.Bot.Object.Update.Message as Exports +import Network.API.Telegram.Bot.Object.Update.Moving as Exports + +import "aeson" Data.Aeson (FromJSON (parseJSON), withObject, (.:)) +import "aeson" Data.Aeson.Types (Object, Parser) +import "base" Control.Applicative (Applicative ((<*>)), Alternative ((<|>))) +import "base" Data.Function (($)) +import "base" Data.Functor ((<$>)) +import "base" Data.Int (Int) +import "base" Text.Show (Show) + +import Network.API.Telegram.Bot.Object.Update.Callback (Callback) +import Network.API.Telegram.Bot.Object.Update.Message (Message) +import Network.API.Telegram.Bot.Object.Update.Moving (Moving) + +data Update + = Query Int Callback + | Membership Int Moving + | Incoming Int Message + deriving Show + +instance FromJSON Update where + parseJSON = withObject "Update" $ \v -> + query v <|> membership v <|> incoming v where + + query :: Object -> Parser Update + query v = Query <$> v .: "update_id" <*> v .: "callback_query" + + membership :: Object -> Parser Update + membership v = Membership <$> v .: "update_id" <*> v .: "message" + + incoming :: Object -> Parser Update + incoming v = Incoming <$> v .: "update_id" <*> v .: "message" diff --git a/Network/API/Telegram/Bot/Object/Update/Callback.hs b/Network/API/Telegram/Bot/Object/Update/Callback.hs new file mode 100644 --- /dev/null +++ b/Network/API/Telegram/Bot/Object/Update/Callback.hs @@ -0,0 +1,18 @@ +module Network.API.Telegram.Bot.Object.Update.Callback (Callback (..), module Exports) where + +import Network.API.Telegram.Bot.Object.Update.Callback.Notification as Exports + +import "aeson" Data.Aeson (FromJSON (parseJSON), withObject, (.:)) +import "base" Control.Applicative (Applicative ((<*>))) +import "base" Data.Function (($)) +import "base" Data.Functor ((<$>)) +import "base" Text.Show (Show) +import "text" Data.Text (Text) + +import Network.API.Telegram.Bot.Object.Update.Message (Message) + +data Callback = Datatext Text Message Text deriving Show + +instance FromJSON Callback where + parseJSON = withObject "Callback" $ \v -> + Datatext <$> v .: "id" <*> v .: "message" <*> v .: "data" diff --git a/Network/API/Telegram/Bot/Object/Update/Callback/Notification.hs b/Network/API/Telegram/Bot/Object/Update/Callback/Notification.hs new file mode 100644 --- /dev/null +++ b/Network/API/Telegram/Bot/Object/Update/Callback/Notification.hs @@ -0,0 +1,3 @@ +module Network.API.Telegram.Bot.Object.Update.Callback.Notification (Notification) where + +data Notification diff --git a/Network/API/Telegram/Bot/Object/Update/Message.hs b/Network/API/Telegram/Bot/Object/Update/Message.hs new file mode 100644 --- /dev/null +++ b/Network/API/Telegram/Bot/Object/Update/Message.hs @@ -0,0 +1,54 @@ +module Network.API.Telegram.Bot.Object.Update.Message (Message (..), module Exports) where + +import Network.API.Telegram.Bot.Object.Update.Message.Content as Exports +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), Value (Object), withObject, (.:)) +import "aeson" Data.Aeson.Types (Object, Parser) +import "base" Control.Applicative (Applicative ((<*>)), Alternative ((<|>))) +import "base" Control.Monad (Monad ((>>=)), fail) +import "base" Data.Function (($)) +import "base" Data.Functor ((<$>)) +import "base" Data.Int (Int) +import "base" Text.Show (Show) +import "text" Data.Text (Text) + +import Network.API.Telegram.Bot.Object.Update.Message.Content (Content) +import Network.API.Telegram.Bot.Object.Update.Message.Origin (Origin (Private, Group, Supergroup, Channel)) + +data Message + = Direct Int Origin Content + | Forward Int Origin Content + | Reply Int Origin Content Message + deriving Show + +instance FromJSON Message where + parseJSON = withObject "Message" $ \v -> + forward_channel v <|> forward_chat v <|> reply v <|> direct v where + + forward_channel :: Object -> Parser Message + forward_channel v = Forward <$> v .: "forward_from_message_id" + <*> (v .: "forward_from_chat" >>= channel) <*> parseJSON (Object v) where + + channel :: Value -> Parser Origin + channel = withObject "Channel" $ \c -> Channel <$> c .: "id" <*> c .: "title" + + forward_chat :: Object -> Parser Message + forward_chat v = Forward <$> v .: "message_id" + <*> (v .: "chat" >>= chat) <*> parseJSON (Object v) where + + chat :: Value -> Parser Origin + chat = withObject "Origin" $ \c -> c .: "type" >>= \case + ("private" :: Text) -> Private <$> c .: "id" <*> v .: "forward_from" + ("group" :: Text) -> Group <$> c .: "id" <*> c .: "title" <*> v .: "forward_from" + ("supergroup" :: Text) -> Supergroup <$> c .: "id" <*> c .: "title" <*> v .: "forward_from" + _ -> fail "Type of chat is not defined" + + reply :: Object -> Parser Message + reply v = Reply <$> v .: "message_id" <*> parseJSON (Object v) + <*> parseJSON (Object v) <*> v .: "reply_to_message" + + direct :: Object -> Parser Message + direct v = Direct <$> v .: "message_id" + <*> parseJSON (Object v) <*> parseJSON (Object v) diff --git a/Network/API/Telegram/Bot/Object/Update/Message/Content.hs b/Network/API/Telegram/Bot/Object/Update/Message/Content.hs new file mode 100644 --- /dev/null +++ b/Network/API/Telegram/Bot/Object/Update/Message/Content.hs @@ -0,0 +1,53 @@ +module Network.API.Telegram.Bot.Object.Update.Message.Content (Content (..), module Exports) 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 +import Network.API.Telegram.Bot.Object.Update.Message.Content.Location as Exports +import Network.API.Telegram.Bot.Object.Update.Message.Content.Size as Exports + +import "aeson" Data.Aeson (FromJSON (parseJSON), withArray, withObject, (.:), (.:?)) +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.Function ((.), ($)) +import "base" Data.Functor ((<$>)) +import "base" Data.Foldable (Foldable (foldr)) +import "base" Data.Int (Int) +import "base" Data.Maybe (Maybe) +import "base" Text.Show (Show) +import "base" Prelude ((+)) +import "text" Data.Text (Text, drop, take) + +data Content + = Textual Text + | Command Text + | Attachment (Maybe Text) File + | Information Info + deriving Show + +instance FromJSON Content where + parseJSON = withObject "Content" $ \v -> command v <|> attachment v <|> other v <|> textual v where + + command :: Object -> Parser Content + command v = Command <$> (v .: "entities" >>= command_entity >>= extract_command v) + + command_entity :: Value -> Parser (Int, Int) + command_entity = withArray "Command content" $ \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) = (take len . drop (ofs + 1)) <$> v .: "text" + + attachment :: Object -> Parser Content + attachment v = Attachment <$> v .:? "caption" <*> parseJSON (Object v) + + other :: Object -> Parser Content + other v = Information <$> parseJSON (Object v) + + textual :: Object -> Parser Content + textual v = Textual <$> v .: "text" diff --git a/Network/API/Telegram/Bot/Object/Update/Message/Content/File.hs b/Network/API/Telegram/Bot/Object/Update/Message/Content/File.hs new file mode 100644 --- /dev/null +++ b/Network/API/Telegram/Bot/Object/Update/Message/Content/File.hs @@ -0,0 +1,68 @@ +module Network.API.Telegram.Bot.Object.Update.Message.Content.File (File (..)) where + +import "aeson" Data.Aeson (FromJSON (parseJSON), withObject, (.:), (.:?)) +import "aeson" Data.Aeson.Types (Object, Parser, Value) +import "base" Control.Applicative (Applicative ((<*>)), Alternative ((<|>))) +import "base" Control.Monad (Monad ((>>=))) +import "base" Data.Function (($)) +import "base" Data.Functor ((<$>)) +import "base" Data.Int (Int) +import "base" Data.Maybe (Maybe) +import "base" Text.Show (Show) +import "text" Data.Text (Text) + +import Network.API.Telegram.Bot.Object.Update.Message.Content.Size (Size) + +data File + = Animation Text Int Int Int (Maybe Size) (Maybe Text) (Maybe Text) (Maybe Int) + | Audio Text Int (Maybe Text) (Maybe Text) (Maybe Text) (Maybe Int) (Maybe Size) + | Document Text (Maybe Size) (Maybe Text) (Maybe Text) (Maybe Int) + | Video Text Int Int Int (Maybe Size) (Maybe Text) (Maybe Int) + | Voice Text Int (Maybe Text) (Maybe Int) + | Photo [Size] + deriving Show + +instance FromJSON File where + parseJSON = withObject "Message" $ \v -> photo v <|> document v + <|> audio v <|> video v <|> animation v <|> voice v where + + animation :: Object -> Parser File + animation v = v .: "animation" >>= file where + + file :: Value -> Parser File + file = withObject "Animation" $ \f -> Animation <$> f .: "file_id" + <*> f .: "width" <*> f .: "height" <*> f .: "duration" <*> f .:? "thumb" + <*> f .:? "file_name" <*> f .:? "mime_type" <*> f .:? "file_size" + + audio :: Object -> Parser File + audio v = v .: "audio" >>= file where + + file :: Value -> Parser File + file = withObject "Audio" $ \f -> Audio <$> f .: "file_id" + <*> f .: "duration" <*> f .:? "performer" <*> f .:? "title" + <*> f .:? "mime_type" <*> f .:? "file_size" <*> f .:? "thumb" + + document :: Object -> Parser File + document v = v .: "document" >>= file where + + file :: Value -> Parser File + file = withObject "Document" $ \f -> Document <$> f .: "file_id" + <*> f .:? "thumb" <*> f .:? "file_name" <*> f .:? "mime_type" <*> f .:? "file_size" + + photo :: Object -> Parser File + photo v = Photo <$> v .: "photo" + + video :: Object -> Parser File + video v = v .: "video" >>= file where + + file :: Value -> Parser File + file = withObject "Video" $ \f -> Video <$> f .: "file_id" + <*> f .: "width" <*> f .: "height" <*> f .: "duration" + <*> f .:? "thumb" <*> f .:? "mime_type" <*> f .:? "file_size" + + voice :: Object -> Parser File + voice v = v .: "voice" >>= file where + + file :: Value -> Parser File + file = withObject "Voice" $ \f -> Voice <$> f .: "file_id" + <*> f .: "duration" <*> f .:? "mime_type" <*> f .:? "file_size" diff --git a/Network/API/Telegram/Bot/Object/Update/Message/Content/Info.hs b/Network/API/Telegram/Bot/Object/Update/Message/Content/Info.hs new file mode 100644 --- /dev/null +++ b/Network/API/Telegram/Bot/Object/Update/Message/Content/Info.hs @@ -0,0 +1,41 @@ +module Network.API.Telegram.Bot.Object.Update.Message.Content.Info (Info (..)) where + +import "aeson" Data.Aeson (FromJSON (parseJSON), withObject, (.:), (.:?)) +import "aeson" Data.Aeson.Types (Object, Parser, Value) +import "base" Control.Applicative ((<*>), (<|>)) +import "base" Control.Monad ((>>=)) +import "base" Data.Function (($)) +import "base" Data.Functor ((<$>)) +import "base" Data.Int (Int) +import "base" Data.Maybe (Maybe) +import "base" Text.Show (Show) +import "text" Data.Text (Text) + +import Network.API.Telegram.Bot.Object.Update.Message.Content.Location (Location) + +data Info = Point Location + | Contact Text (Maybe Text) Text (Maybe Text) + | Venue Location Text Text (Maybe Text) (Maybe Text) + 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" diff --git a/Network/API/Telegram/Bot/Object/Update/Message/Content/Location.hs b/Network/API/Telegram/Bot/Object/Update/Message/Content/Location.hs new file mode 100644 --- /dev/null +++ b/Network/API/Telegram/Bot/Object/Update/Message/Content/Location.hs @@ -0,0 +1,19 @@ +module Network.API.Telegram.Bot.Object.Update.Message.Content.Location (Location (..)) where + +import "aeson" Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), object, withObject, (.:), (.=)) +import "base" Control.Applicative ((<*>)) +import "base" Data.Function (($)) +import "base" Data.Functor ((<$>)) +import "base" GHC.Float (Float) +import "base" Text.Show (Show) + +data Location = Location Float Float + deriving Show + +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/API/Telegram/Bot/Object/Update/Message/Content/Size.hs b/Network/API/Telegram/Bot/Object/Update/Message/Content/Size.hs new file mode 100644 --- /dev/null +++ b/Network/API/Telegram/Bot/Object/Update/Message/Content/Size.hs @@ -0,0 +1,17 @@ +module Network.API.Telegram.Bot.Object.Update.Message.Content.Size (Size (..)) where + +import "aeson" Data.Aeson (FromJSON (parseJSON), withObject, (.:)) +import "base" Control.Applicative ((<*>)) +import "base" Data.Int (Int) +import "base" Data.Function (($)) +import "base" Data.Functor ((<$>)) +import "base" Data.Maybe (Maybe) +import "base" Text.Show (Show) +import "text" Data.Text (Text) + +data Size = Size Text Int Int (Maybe Int) + deriving Show + +instance FromJSON Size where + parseJSON = withObject "Size" $ \v -> Size <$> v .: "file_id" + <*> v .: "width" <*> v .: "height" <*> v .: "file_size" diff --git a/Network/API/Telegram/Bot/Object/Update/Message/Keyboard.hs b/Network/API/Telegram/Bot/Object/Update/Message/Keyboard.hs new file mode 100644 --- /dev/null +++ b/Network/API/Telegram/Bot/Object/Update/Message/Keyboard.hs @@ -0,0 +1,20 @@ +module Network.API.Telegram.Bot.Object.Update.Message.Keyboard (Keyboard (..), module Exports) where + +import Network.API.Telegram.Bot.Object.Update.Message.Keyboard.Button as Exports + +import "aeson" Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), object, withObject, (.:), (.=)) +import "base" Data.Function (($)) +import "base" Data.Functor ((<$>)) +import "base" Text.Show (Show) + +import Network.API.Telegram.Bot.Object.Update.Message.Keyboard.Button (Button) + +data Keyboard = Inline [[Button]] deriving Show + +instance FromJSON Keyboard where + parseJSON = withObject "Inline" $ \v -> + Inline <$> v .: "inline_keyboard" + +instance ToJSON Keyboard where + toJSON (Inline buttons) = object + ["inline_keyboard" .= buttons] diff --git a/Network/API/Telegram/Bot/Object/Update/Message/Keyboard/Button.hs b/Network/API/Telegram/Bot/Object/Update/Message/Keyboard/Button.hs new file mode 100644 --- /dev/null +++ b/Network/API/Telegram/Bot/Object/Update/Message/Keyboard/Button.hs @@ -0,0 +1,35 @@ +module Network.API.Telegram.Bot.Object.Update.Message.Keyboard.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 (Applicative (pure, (<*>)), Alternative ((<|>))) +import "base" Control.Monad (Monad ((>>=)), fail) +import "base" Data.Function ((.), ($)) +import "base" Data.Functor (Functor (fmap), (<$>)) +import "base" Data.Maybe (Maybe, maybe) +import "base" Text.Show (Show) +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") pure 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" diff --git a/Network/API/Telegram/Bot/Object/Update/Message/Origin.hs b/Network/API/Telegram/Bot/Object/Update/Message/Origin.hs new file mode 100644 --- /dev/null +++ b/Network/API/Telegram/Bot/Object/Update/Message/Origin.hs @@ -0,0 +1,31 @@ +module Network.API.Telegram.Bot.Object.Update.Message.Origin (Origin (..)) where + +import "aeson" Data.Aeson (FromJSON (parseJSON), withObject, (.:)) +import "aeson" Data.Aeson.Types (Object, Parser, Value) +import "base" Control.Applicative (Applicative ((<*>))) +import "base" Control.Monad (Monad ((>>=)), fail) +import "base" Data.Function (($)) +import "base" Data.Functor ((<$>)) +import "base" Data.Int (Int64) +import "base" Text.Show (Show) +import "text" Data.Text (Text) + +import Network.API.Telegram.Bot.Object.Sender (Sender) + +data Origin + = Private Int64 Sender + | Group Int64 Text Sender + | Supergroup Int64 Text Sender + | Channel Int64 Text + deriving Show + +instance FromJSON Origin where + parseJSON = withObject "Message" $ \v -> v .: "chat" >>= chat v where + + chat :: Object -> Value -> Parser Origin + chat v = withObject "Origin" $ \c -> c .: "type" >>= \case + ("private" :: Text) -> Private <$> c .: "id" <*> v .: "from" + ("group" :: Text) -> Group <$> c .: "id" <*> c .: "title" <*> v .: "from" + ("supergroup" :: Text) -> Supergroup <$> c .: "id" <*> c .: "title" <*> v .: "from" + ("channel" :: Text) -> Channel <$> c .: "id" <*> c .: "title" + _ -> fail "Type of chat is not defined" diff --git a/Network/API/Telegram/Bot/Object/Update/Moving.hs b/Network/API/Telegram/Bot/Object/Update/Moving.hs new file mode 100644 --- /dev/null +++ b/Network/API/Telegram/Bot/Object/Update/Moving.hs @@ -0,0 +1,30 @@ +module Network.API.Telegram.Bot.Object.Update.Moving (Moving (..)) where + +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.Function (($)) +import "base" Data.Functor ((<$>)) +import "base" Data.Int (Int64) +import "base" Text.Show (Show) +import "text" Data.Text (Text) + +import Network.API.Telegram.Bot.Object.Sender (Sender) + +data Moving + = Gone Sender (Int64, Text) + | Joined [Sender] (Int64, Text) + deriving Show + +instance FromJSON Moving where + parseJSON = withObject "Moving" $ \v -> gone v <|> joined v where + + gone :: Object -> Parser Moving + gone v = Gone <$> v .: "left_chat_member" <*> (v .: "chat" >>= chat) + + joined :: Object -> Parser Moving + joined v = Joined <$> v .: "new_chat_members" <*> (v .: "chat" >>= chat) + + chat :: Object -> Parser (Int64, Text) + chat c = (,) <$> c .: "id" <*> c .: "title" diff --git a/Network/API/Telegram/Bot/Property.hs b/Network/API/Telegram/Bot/Property.hs new file mode 100644 --- /dev/null +++ b/Network/API/Telegram/Bot/Property.hs @@ -0,0 +1,5 @@ +module Network.API.Telegram.Bot.Property (module Exports) where + +import Network.API.Telegram.Bot.Property.Persistable as Exports +import Network.API.Telegram.Bot.Property.Identifiable as Exports +import Network.API.Telegram.Bot.Property.Accessible as Exports diff --git a/Network/API/Telegram/Bot/Property/Accessible.hs b/Network/API/Telegram/Bot/Property/Accessible.hs new file mode 100644 --- /dev/null +++ b/Network/API/Telegram/Bot/Property/Accessible.hs @@ -0,0 +1,28 @@ +module Network.API.Telegram.Bot.Property.Accessible (Accessible (..)) where + +import "base" Data.Function (flip) +import "base" Data.Functor ((<$>)) +import "lens" Control.Lens (Lens') + +import Network.API.Telegram.Bot.Object (Object) +import Network.API.Telegram.Bot.Object.Update.Callback (Callback (Datatext)) +import Network.API.Telegram.Bot.Object.Update.Message (Message (Direct, Forward, Reply)) +import Network.API.Telegram.Bot.Object.Update.Message.Content (Content) +import Network.API.Telegram.Bot.Object.Update.Message.Origin (Origin) + +class Object source => Accessible target source where + access :: Lens' source target + +instance Accessible Content Message where + access f (Direct msg_id origin content) = (\content' -> Direct msg_id origin content') <$> f content + access f (Forward msg_id origin content) = (\content' -> Forward msg_id origin content') <$> f content + access f (Reply msg_id origin content msg) = (\content' -> Reply msg_id origin content' msg) <$> f content + +instance Accessible Origin Callback where + access f (Datatext cq_id msg dttxt) = flip + (Datatext cq_id) dttxt <$> access f msg + +instance Accessible Origin Message where + access f (Direct msg_id origin content) = (\origin' -> Direct msg_id origin' content) <$> f origin + access f (Forward msg_id origin content) = (\origin' -> Forward msg_id origin' content) <$> f origin + access f (Reply msg_id origin content msg) = (\origin' -> Reply msg_id origin' content msg) <$> f origin diff --git a/Network/API/Telegram/Bot/Property/Identifiable.hs b/Network/API/Telegram/Bot/Property/Identifiable.hs new file mode 100644 --- /dev/null +++ b/Network/API/Telegram/Bot/Property/Identifiable.hs @@ -0,0 +1,46 @@ +module Network.API.Telegram.Bot.Property.Identifiable (Identifiable (..), Identificator) where + +import "base" Data.Int (Int, Int64) +import "text" Data.Text (Text) + +import Network.API.Telegram.Bot.Object (Object) +import Network.API.Telegram.Bot.Object.Update (Update (Query, Membership, Incoming)) +import Network.API.Telegram.Bot.Object.Update.Callback (Callback (Datatext)) +import Network.API.Telegram.Bot.Object.Update.Message (Message (Direct, Forward, Reply)) +import Network.API.Telegram.Bot.Object.Update.Message.Origin (Origin (Private, Group, Supergroup, Channel)) +import Network.API.Telegram.Bot.Object.Sender (Sender (Bot, User)) + +type family Identificator o = i + +class Object o => Identifiable o where + {-# MINIMAL identificator #-} + identificator :: o -> Identificator o + +type instance Identificator Callback = Text +type instance Identificator Message = Int +type instance Identificator Origin = Int64 +type instance Identificator Sender = Int +type instance Identificator Update = Int + +instance Identifiable Callback where + identificator (Datatext i _ _) = i + +instance Identifiable Message where + identificator (Direct i _ _) = i + identificator (Forward i _ _) = i + identificator (Reply i _ _ _) = i + +instance Identifiable Origin where + identificator (Private i _) = i + identificator (Group i _ _) = i + identificator (Supergroup i _ _) = i + identificator (Channel i _) = i + +instance Identifiable Sender where + identificator (Bot i _ _ _ _) = i + identificator (User i _ _ _ _) = i + +instance Identifiable Update where + identificator (Query i _) = i + identificator (Membership i _) = i + identificator (Incoming i _) = i diff --git a/Network/API/Telegram/Bot/Property/Persistable.hs b/Network/API/Telegram/Bot/Property/Persistable.hs new file mode 100644 --- /dev/null +++ b/Network/API/Telegram/Bot/Property/Persistable.hs @@ -0,0 +1,163 @@ +module Network.API.Telegram.Bot.Property.Persistable + (Persistable (..), Capacity (..), Inform (..), Way (..)) where + +import "aeson" Data.Aeson (FromJSON, Value, decode, object, (.=)) +import "base" Control.Exception (try) +import "base" Control.Monad (Monad ((>>=)), join) +import "base" Data.Bool (Bool (False, True)) +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.Semigroup (Semigroup ((<>))) +import "base" Data.String (String) +import "base" Data.Tuple (snd) +import "http-client" Network.HTTP.Client (Response (responseBody)) +import "tagged" Data.Tagged (Tagged, untag) +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.API.Telegram.Bot.Core (Telegram, Token (Token), Ok, result) +import Network.API.Telegram.Bot.Object (Object, Keyboard, Notification, Member, Sender) +import Network.API.Telegram.Bot.Object.Update.Message (Message) +import Network.API.Telegram.Bot.Object.Update.Message.Content.Location (Location (Location)) + +data Inform = Silently | Notify + +data Way = Directly | Forwarding | Replying + +data Capacity object = Send Inform Way object | Post object | Fetch object | Edit object | Purge object + +class Object object => Persistable capacity object where + {-# MINIMAL payload, endpoint #-} + type Payload (capacity :: * -> Capacity *) object = payload | payload -> capacity object + payload :: Payload capacity object -> Value + endpoint :: Payload capacity object -> String + request :: FromJSON r => Payload capacity object -> 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 + +instance Persistable 'Edit Keyboard where + type instance Payload 'Edit Keyboard + = Tagged ('Edit Keyboard) (Int64, Int, Keyboard) + payload (untag -> (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 + type instance Payload 'Post Keyboard + = Tagged ('Post Keyboard) (Int64, Text, Keyboard) + payload (untag -> (chat_id, text, kb)) = object + ["chat_id" .= chat_id, "text" .= text, "reply_markup" .= kb] + endpoint _ = "sendMessage" + +instance Persistable ('Send 'Notify 'Directly) Location where + type instance Payload ('Send 'Notify 'Directly) Location + = Tagged ('Send 'Notify 'Directly Location) (Int64, Location, Int) + payload (untag -> (chat_id, Location latitude longitude, live_period)) = + object ["chat_id" .= chat_id, "latitude" .= latitude, "longitude" .= longitude, + "live_period" .= live_period, "disable_notification" .= False] + endpoint _ = "sendLocation" + +instance Persistable ('Send 'Silently 'Directly) Location where + type instance Payload ('Send 'Silently 'Directly) Location + = Tagged ('Send 'Silently 'Directly Location) (Int64, Location, Int) + payload (untag -> (chat_id, Location latitude longitude, live_period)) = + object ["chat_id" .= chat_id, "latitude" .= latitude, "longitude" .= longitude, + "live_period" .= live_period, "disable_notification" .= True] + endpoint _ = "sendLocation" + +instance Persistable ('Send 'Notify 'Replying) Location where + type instance Payload ('Send 'Notify 'Replying) Location + = Tagged ('Send 'Notify 'Replying Location) (Int64, Location, Int, Int) + payload (untag -> (chat_id, Location latitude longitude, live_period, reply_to_message_id)) = object + ["chat_id" .= chat_id, "latitude" .= latitude, "longitude" .= longitude, "live_period" .= live_period, + "reply_to_message_id" .= reply_to_message_id, "disable_notification" .= False] + endpoint _ = "sendLocation" + +instance Persistable ('Send 'Silently 'Replying) Location where + type instance Payload ('Send 'Silently 'Replying) Location + = Tagged ('Send 'Silently 'Replying Location) (Int64, Location, Int, Int) + payload (untag -> (chat_id, Location latitude longitude, live_period, reply_to_message_id)) = object + ["chat_id" .= chat_id, "latitude" .= latitude, "longitude" .= longitude, "live_period" .= live_period, + "reply_to_message_id" .= reply_to_message_id, "disable_notification" .= True] + endpoint _ = "sendLocation" + +instance Persistable 'Fetch Member where + type instance Payload 'Fetch Member = Tagged ('Fetch Member) (Int64, Int) + payload (untag -> (chat_id, user_id)) = object ["chat_id" .= chat_id, "user_id" .= user_id] + endpoint _ = "getChatMember" + +instance Persistable ('Send 'Notify 'Directly) Message where + type instance Payload ('Send 'Notify 'Directly) Message + = Tagged ('Send 'Notify 'Directly Message) (Int64, Text) + payload (untag -> (chat_id, text)) = object + ["chat_id" .= chat_id, "text" .= text, "disable_notification" .= False] + endpoint _ = "sendMessage" + +instance Persistable ('Send 'Silently 'Directly) Message where + type instance Payload ('Send 'Silently 'Directly) Message + = Tagged ('Send 'Silently 'Directly Message) (Int64, Text) + payload (untag -> (chat_id, text)) = object + ["chat_id" .= chat_id, "text" .= text, "disable_notification" .= True] + endpoint _ = "sendMessage" + +instance Persistable ('Send 'Notify 'Forwarding) Message where + type instance Payload ('Send 'Notify 'Forwarding) Message + = Tagged ('Send 'Notify 'Forwarding Message) (Int64, Int64, Int) + payload (untag -> (chat_id, from_chat_id, message_id)) = object + ["chat_id" .= chat_id, "from_chat_id" .= from_chat_id, + "message_id" .= message_id, "disable_notification" .= False] + endpoint _ = "forwardMessage" + +instance Persistable ('Send 'Silently 'Forwarding) Message where + type instance Payload ('Send 'Silently 'Forwarding) Message + = Tagged ('Send 'Silently 'Forwarding Message) (Int64, Int64, Int) + payload (untag -> (chat_id, from_chat_id, message_id)) = object + ["chat_id" .= chat_id, "from_chat_id" .= from_chat_id, + "message_id" .= message_id, "disable_notification" .= True] + endpoint _ = "forwardMessage" + +instance Persistable ('Send 'Notify 'Replying) Message where + type instance Payload ('Send 'Notify 'Replying) Message + = Tagged ('Send 'Notify 'Replying Message) (Int64, Int, Text) + payload (untag -> (chat_id, reply_to_message_id, text)) = object + ["chat_id" .= chat_id, "reply_to_message_id" .= reply_to_message_id, + "text" .= text, "disable_notification" .= False] + endpoint _ = "sendMessage" + +instance Persistable ('Send 'Silently 'Replying) Message where + type instance Payload ('Send 'Silently 'Replying) Message + = Tagged ('Send 'Silently 'Replying Message) (Int64, Int, Text) + payload (untag -> (chat_id, reply_to_message_id, text)) = object + ["chat_id" .= chat_id, "reply_to_message_id" .= reply_to_message_id, + "text" .= text, "disable_notification" .= True] + endpoint _ = "sendMessage" + +instance Persistable 'Edit Message where + type instance Payload 'Edit Message = Tagged ('Edit Message) (Int64, Int, Text) + payload (untag -> (chat_id, message_id, text)) = object + ["chat_id" .= chat_id, "message_id" .= message_id, "text" .= text] + endpoint _ = "editMessageText" + +instance Persistable 'Purge Message where + type instance Payload 'Purge Message = Tagged ('Purge Message) (Int64, Int) + payload (untag -> (chat_id, message_id)) = object ["chat_id" .= chat_id, "message_id" .= message_id] + endpoint _ = "deleteMessage" +-- +instance Persistable 'Post Notification where + type instance Payload 'Post Notification = Tagged ('Post Notification) (Text, Text) + payload (untag -> (cbq_id, text)) = object ["callback_query_id" .= cbq_id, "text" .= text] + endpoint _ = "answerCallbackQuery" +-- +instance Persistable 'Fetch Sender where + type instance Payload 'Fetch Sender = Tagged ('Fetch Sender) () + payload _ = object [] + endpoint _ = "getMe" diff --git a/Network/Telegram/API/Bot.hs b/Network/Telegram/API/Bot.hs deleted file mode 100644 --- a/Network/Telegram/API/Bot.hs +++ /dev/null @@ -1,5 +0,0 @@ -module Network.Telegram.API.Bot (module Exports) where - -import Network.Telegram.API.Bot.Property as Exports -import Network.Telegram.API.Bot.Object as Exports -import Network.Telegram.API.Bot.Core as Exports diff --git a/Network/Telegram/API/Bot/Core.hs b/Network/Telegram/API/Bot/Core.hs deleted file mode 100644 --- a/Network/Telegram/API/Bot/Core.hs +++ /dev/null @@ -1,38 +0,0 @@ -module Network.Telegram.API.Bot.Core (Telegram, telegram, ask', Token (..), Ok, result) where - -import "aeson" Data.Aeson (FromJSON (parseJSON), withObject, (.:)) -import "base" Control.Applicative (Applicative ((<*>))) -import "base" Control.Exception (SomeException) -import "base" Data.Bool (Bool (True, False)) -import "base" Data.Eq (Eq) -import "base" Data.Either (Either) -import "base" Data.Function (flip, (.), ($)) -import "base" Data.Functor ((<$>)) -import "base" Data.Maybe (Maybe (Just, Nothing)) -import "base" Data.Tuple (fst) -import "base" System.IO (IO) -import "base" Text.Show (Show) -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" diff --git a/Network/Telegram/API/Bot/Object.hs b/Network/Telegram/API/Bot/Object.hs deleted file mode 100644 --- a/Network/Telegram/API/Bot/Object.hs +++ /dev/null @@ -1,21 +0,0 @@ -module Network.Telegram.API.Bot.Object (module Exports, Object) where - -import Network.Telegram.API.Bot.Object.Update as Exports -import Network.Telegram.API.Bot.Object.Sender as Exports -import Network.Telegram.API.Bot.Object.Member as Exports - -import "base" Data.Kind (Constraint) - -type family Object (a :: *) :: Constraint -type instance Object Sender = () -type instance Object Update = () -type instance Object Notification = () -type instance Object Moving = () -type instance Object Message = () -type instance Object Member = () -type instance Object Keyboard = () -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 deleted file mode 100644 --- a/Network/Telegram/API/Bot/Object/Member.hs +++ /dev/null @@ -1,35 +0,0 @@ -module Network.Telegram.API.Bot.Object.Member (Member (..), module Exports) where - -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) -import "text" Data.Text (Text) -import "time" Data.Time.Clock.POSIX (POSIXTime) - -import Network.Telegram.API.Bot.Object.Sender (Sender) - -data Member - = Creator Sender - | Administrator Sender Bool Powers - | Member Sender - | Restricted Sender Restrictions POSIXTime - | Left Sender - | Kicked Sender POSIXTime - deriving Show - -instance FromJSON Member where - parseJSON = withObject "Member" $ \v -> v .: "status" >>= \case - ("creator" :: Text) -> Creator <$> v .: "user" - ("administrator" :: Text) -> Administrator <$> v .: "user" <*> v .: "can_be_edited" <*> parseJSON (Object v) - ("member" :: Text) -> Member <$> v .: "user" - ("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 deleted file mode 100644 --- a/Network/Telegram/API/Bot/Object/Member/Powers.hs +++ /dev/null @@ -1,21 +0,0 @@ -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 deleted file mode 100644 --- a/Network/Telegram/API/Bot/Object/Member/Restrictions.hs +++ /dev/null @@ -1,17 +0,0 @@ -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/Sender.hs b/Network/Telegram/API/Bot/Object/Sender.hs deleted file mode 100644 --- a/Network/Telegram/API/Bot/Object/Sender.hs +++ /dev/null @@ -1,50 +0,0 @@ -module Network.Telegram.API.Bot.Object.Sender (Sender (..), nickname, firstname, lastname) where - -import "aeson" Data.Aeson (FromJSON (parseJSON), Object, withObject, (.:), (.:?)) -import "aeson" Data.Aeson.Types (Parser) -import "base" Control.Applicative (Applicative ((<*>))) -import "base" Control.Monad (Monad ((>>=))) -import "base" Data.Bool (Bool (False), bool) -import "base" Data.Eq (Eq ((==))) -import "base" Data.Int (Int) -import "base" Data.Function (($)) -import "base" Data.Functor ((<$>)) -import "base" Data.Maybe (Maybe) -import "base" Text.Show (Show) -import "lens" Control.Lens (Lens') -import "text" Data.Text (Text) - -data Sender - = Bot Int (Maybe Text) Text (Maybe Text) (Maybe Text) - | User 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' - _ == _ = False - -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 - - sender :: Object -> Whom -> Parser Sender - sender v f = f <$> v .: "id" - <*> v .:? "username" - <*> v .: "first_name" - <*> v .:? "last_name" - <*> v .:? "language_code" - -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 - -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 - -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 diff --git a/Network/Telegram/API/Bot/Object/Update.hs b/Network/Telegram/API/Bot/Object/Update.hs deleted file mode 100644 --- a/Network/Telegram/API/Bot/Object/Update.hs +++ /dev/null @@ -1,36 +0,0 @@ -module Network.Telegram.API.Bot.Object.Update (Update (..), module Exports) where - -import Network.Telegram.API.Bot.Object.Update.Callback as Exports -import Network.Telegram.API.Bot.Object.Update.Message as Exports -import Network.Telegram.API.Bot.Object.Update.Moving as Exports - -import "aeson" Data.Aeson (FromJSON (parseJSON), withObject, (.:)) -import "aeson" Data.Aeson.Types (Object, Parser) -import "base" Control.Applicative (Applicative ((<*>)), Alternative ((<|>))) -import "base" Data.Function (($)) -import "base" Data.Functor ((<$>)) -import "base" Data.Int (Int) -import "base" Text.Show (Show) - -import Network.Telegram.API.Bot.Object.Update.Callback (Callback) -import Network.Telegram.API.Bot.Object.Update.Message (Message) -import Network.Telegram.API.Bot.Object.Update.Moving (Moving) - -data Update - = Query Int Callback - | Membership Int Moving - | Incoming Int Message - deriving Show - -instance FromJSON Update where - parseJSON = withObject "Update" $ \v -> - query v <|> membership v <|> incoming v where - - query :: Object -> Parser Update - query v = Query <$> v .: "update_id" <*> v .: "callback_query" - - membership :: Object -> Parser Update - membership v = Membership <$> v .: "update_id" <*> v .: "message" - - incoming :: Object -> Parser Update - incoming v = Incoming <$> v .: "update_id" <*> v .: "message" diff --git a/Network/Telegram/API/Bot/Object/Update/Callback.hs b/Network/Telegram/API/Bot/Object/Update/Callback.hs deleted file mode 100644 --- a/Network/Telegram/API/Bot/Object/Update/Callback.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Network.Telegram.API.Bot.Object.Update.Callback (Callback (..), module Exports) where - -import Network.Telegram.API.Bot.Object.Update.Callback.Notification as Exports - -import "aeson" Data.Aeson (FromJSON (parseJSON), withObject, (.:)) -import "base" Control.Applicative (Applicative ((<*>))) -import "base" Data.Function (($)) -import "base" Data.Functor ((<$>)) -import "base" Text.Show (Show) -import "text" Data.Text (Text) - -import Network.Telegram.API.Bot.Object.Update.Message (Message) - -data Callback = Datatext Text Message Text deriving Show - -instance FromJSON Callback where - parseJSON = withObject "Callback" $ \v -> - Datatext <$> v .: "id" <*> v .: "message" <*> v .: "data" diff --git a/Network/Telegram/API/Bot/Object/Update/Callback/Notification.hs b/Network/Telegram/API/Bot/Object/Update/Callback/Notification.hs deleted file mode 100644 --- a/Network/Telegram/API/Bot/Object/Update/Callback/Notification.hs +++ /dev/null @@ -1,3 +0,0 @@ -module Network.Telegram.API.Bot.Object.Update.Callback.Notification (Notification) where - -data Notification diff --git a/Network/Telegram/API/Bot/Object/Update/Message.hs b/Network/Telegram/API/Bot/Object/Update/Message.hs deleted file mode 100644 --- a/Network/Telegram/API/Bot/Object/Update/Message.hs +++ /dev/null @@ -1,54 +0,0 @@ -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 -import Network.Telegram.API.Bot.Object.Update.Message.Origin as Exports - -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) -import "base" Data.Function (($)) -import "base" Data.Functor ((<$>)) -import "base" Data.Int (Int) -import "base" Text.Show (Show) -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 Message - = Direct Int Origin Content - | Forward Int Origin Content - | Reply Int Origin Content Message - deriving Show - -instance FromJSON Message where - parseJSON = withObject "Message" $ \v -> - forward_channel v <|> forward_chat v <|> reply v <|> direct v where - - forward_channel :: Object -> Parser Message - forward_channel v = Forward <$> v .: "forward_from_message_id" - <*> (v .: "forward_from_chat" >>= channel) <*> parseJSON (Object v) where - - channel :: Value -> Parser Origin - channel = withObject "Channel" $ \c -> Channel <$> c .: "id" <*> c .: "title" - - forward_chat :: Object -> Parser Message - forward_chat v = Forward <$> v .: "message_id" - <*> (v .: "chat" >>= chat) <*> parseJSON (Object v) where - - chat :: Value -> Parser Origin - chat = withObject "Origin" $ \c -> c .: "type" >>= \case - ("private" :: Text) -> Private <$> c .: "id" <*> v .: "forward_from" - ("group" :: Text) -> Group <$> c .: "id" <*> c .: "title" <*> v .: "forward_from" - ("supergroup" :: Text) -> Supergroup <$> c .: "id" <*> c .: "title" <*> v .: "forward_from" - _ -> fail "Type of chat is not defined" - - reply :: Object -> Parser Message - reply v = Reply <$> v .: "message_id" <*> parseJSON (Object v) - <*> parseJSON (Object v) <*> v .: "reply_to_message" - - direct :: Object -> Parser Message - direct v = Direct <$> v .: "message_id" - <*> parseJSON (Object v) <*> parseJSON (Object v) diff --git a/Network/Telegram/API/Bot/Object/Update/Message/Content.hs b/Network/Telegram/API/Bot/Object/Update/Message/Content.hs deleted file mode 100644 --- a/Network/Telegram/API/Bot/Object/Update/Message/Content.hs +++ /dev/null @@ -1,52 +0,0 @@ -module Network.Telegram.API.Bot.Object.Update.Message.Content (Content (..), module Exports) where - -import Network.Telegram.API.Bot.Object.Update.Message.Content.File as Exports -import Network.Telegram.API.Bot.Object.Update.Message.Content.Info as Exports -import Network.Telegram.API.Bot.Object.Update.Message.Content.Size as Exports - -import "aeson" Data.Aeson (FromJSON (parseJSON), withArray, withObject, (.:), (.:?)) -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.Function ((.), ($)) -import "base" Data.Functor ((<$>)) -import "base" Data.Foldable (Foldable (foldr)) -import "base" Data.Int (Int) -import "base" Data.Maybe (Maybe) -import "base" Text.Show (Show) -import "base" Prelude ((+)) -import "text" Data.Text (Text, drop, take) - -data Content - = Textual Text - | Command Text - | Attachment (Maybe Text) File - | Information Info - deriving Show - -instance FromJSON Content where - parseJSON = withObject "Content" $ \v -> command v <|> attachment v <|> other v <|> textual v where - - command :: Object -> Parser Content - command v = Command <$> (v .: "entities" >>= command_entity >>= extract_command v) - - command_entity :: Value -> Parser (Int, Int) - command_entity = withArray "Command content" $ \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) = (take len . drop (ofs + 1)) <$> v .: "text" - - attachment :: Object -> Parser Content - attachment v = Attachment <$> v .:? "caption" <*> parseJSON (Object v) - - other :: Object -> Parser Content - other v = Information <$> parseJSON (Object v) - - textual :: Object -> Parser Content - textual v = Textual <$> v .: "text" diff --git a/Network/Telegram/API/Bot/Object/Update/Message/Content/File.hs b/Network/Telegram/API/Bot/Object/Update/Message/Content/File.hs deleted file mode 100644 --- a/Network/Telegram/API/Bot/Object/Update/Message/Content/File.hs +++ /dev/null @@ -1,68 +0,0 @@ -module Network.Telegram.API.Bot.Object.Update.Message.Content.File (File (..)) where - -import "aeson" Data.Aeson (FromJSON (parseJSON), withObject, (.:), (.:?)) -import "aeson" Data.Aeson.Types (Object, Parser, Value) -import "base" Control.Applicative (Applicative ((<*>)), Alternative ((<|>))) -import "base" Control.Monad (Monad ((>>=))) -import "base" Data.Function (($)) -import "base" Data.Functor ((<$>)) -import "base" Data.Int (Int) -import "base" Data.Maybe (Maybe) -import "base" Text.Show (Show) -import "text" Data.Text (Text) - -import Network.Telegram.API.Bot.Object.Update.Message.Content.Size (Size) - -data File - = Animation Text Int Int Int (Maybe Size) (Maybe Text) (Maybe Text) (Maybe Int) - | Audio Text Int (Maybe Text) (Maybe Text) (Maybe Text) (Maybe Int) (Maybe Size) - | Document Text (Maybe Size) (Maybe Text) (Maybe Text) (Maybe Int) - | Video Text Int Int Int (Maybe Size) (Maybe Text) (Maybe Int) - | Voice Text Int (Maybe Text) (Maybe Int) - | Photo [Size] - deriving Show - -instance FromJSON File where - parseJSON = withObject "Message" $ \v -> photo v <|> document v - <|> audio v <|> video v <|> animation v <|> voice v where - - animation :: Object -> Parser File - animation v = v .: "animation" >>= file where - - file :: Value -> Parser File - file = withObject "Animation" $ \f -> Animation <$> f .: "file_id" - <*> f .: "width" <*> f .: "height" <*> f .: "duration" <*> f .:? "thumb" - <*> f .:? "file_name" <*> f .:? "mime_type" <*> f .:? "file_size" - - audio :: Object -> Parser File - audio v = v .: "audio" >>= file where - - file :: Value -> Parser File - file = withObject "Audio" $ \f -> Audio <$> f .: "file_id" - <*> f .: "duration" <*> f .:? "performer" <*> f .:? "title" - <*> f .:? "mime_type" <*> f .:? "file_size" <*> f .:? "thumb" - - document :: Object -> Parser File - document v = v .: "document" >>= file where - - file :: Value -> Parser File - file = withObject "Document" $ \f -> Document <$> f .: "file_id" - <*> f .:? "thumb" <*> f .:? "file_name" <*> f .:? "mime_type" <*> f .:? "file_size" - - photo :: Object -> Parser File - photo v = Photo <$> v .: "photo" - - video :: Object -> Parser File - video v = v .: "video" >>= file where - - file :: Value -> Parser File - file = withObject "Video" $ \f -> Video <$> f .: "file_id" - <*> f .: "width" <*> f .: "height" <*> f .: "duration" - <*> f .:? "thumb" <*> f .:? "mime_type" <*> f .:? "file_size" - - voice :: Object -> Parser File - voice v = v .: "voice" >>= file where - - file :: Value -> Parser File - file = withObject "Voice" $ \f -> Voice <$> f .: "file_id" - <*> f .: "duration" <*> f .:? "mime_type" <*> f .:? "file_size" diff --git a/Network/Telegram/API/Bot/Object/Update/Message/Content/Info.hs b/Network/Telegram/API/Bot/Object/Update/Message/Content/Info.hs deleted file mode 100644 --- a/Network/Telegram/API/Bot/Object/Update/Message/Content/Info.hs +++ /dev/null @@ -1,41 +0,0 @@ -module Network.Telegram.API.Bot.Object.Update.Message.Content.Info (Info (..)) where - -import "aeson" Data.Aeson (FromJSON (parseJSON), withObject, (.:), (.:?)) -import "aeson" Data.Aeson.Types (Object, Parser, Value) -import "base" Control.Applicative ((<*>), (<|>)) -import "base" Control.Monad ((>>=)) -import "base" Data.Function (($)) -import "base" Data.Functor ((<$>)) -import "base" Data.Int (Int) -import "base" Data.Maybe (Maybe) -import "base" Text.Show (Show) -import "text" Data.Text (Text) - -import Network.Telegram.API.Bot.Object.Update.Message.Content.Location (Location) - -data Info = Point Location - | Contact (Maybe Int) Text (Maybe Text) Text (Maybe Text) - | Venue Location Text Text (Maybe Text) (Maybe Text) - 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 .:? "user_id" - <*> 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" diff --git a/Network/Telegram/API/Bot/Object/Update/Message/Content/Location.hs b/Network/Telegram/API/Bot/Object/Update/Message/Content/Location.hs deleted file mode 100644 --- a/Network/Telegram/API/Bot/Object/Update/Message/Content/Location.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Network.Telegram.API.Bot.Object.Update.Message.Content.Location (Location (..)) where - -import "aeson" Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), object, withObject, (.:), (.=)) -import "base" Control.Applicative ((<*>)) -import "base" Data.Function (($)) -import "base" Data.Functor ((<$>)) -import "base" GHC.Float (Float) -import "base" Text.Show (Show) - -data Location = Location Float Float - deriving Show - -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/Object/Update/Message/Content/Size.hs b/Network/Telegram/API/Bot/Object/Update/Message/Content/Size.hs deleted file mode 100644 --- a/Network/Telegram/API/Bot/Object/Update/Message/Content/Size.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Network.Telegram.API.Bot.Object.Update.Message.Content.Size (Size (..)) where - -import "aeson" Data.Aeson (FromJSON (parseJSON), withObject, (.:)) -import "base" Control.Applicative ((<*>)) -import "base" Data.Int (Int) -import "base" Data.Function (($)) -import "base" Data.Functor ((<$>)) -import "base" Data.Maybe (Maybe) -import "base" Text.Show (Show) -import "text" Data.Text (Text) - -data Size = Size Text Int Int (Maybe Int) - deriving Show - -instance FromJSON Size where - parseJSON = withObject "Size" $ \v -> Size <$> v .: "file_id" - <*> v .: "width" <*> v .: "height" <*> v .: "file_size" diff --git a/Network/Telegram/API/Bot/Object/Update/Message/Keyboard.hs b/Network/Telegram/API/Bot/Object/Update/Message/Keyboard.hs deleted file mode 100644 --- a/Network/Telegram/API/Bot/Object/Update/Message/Keyboard.hs +++ /dev/null @@ -1,20 +0,0 @@ -module Network.Telegram.API.Bot.Object.Update.Message.Keyboard (Keyboard (..), module Exports) where - -import Network.Telegram.API.Bot.Object.Update.Message.Keyboard.Button as Exports - -import "aeson" Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), object, withObject, (.:), (.=)) -import "base" Data.Function (($)) -import "base" Data.Functor ((<$>)) -import "base" Text.Show (Show) - -import Network.Telegram.API.Bot.Object.Update.Message.Keyboard.Button (Button) - -data Keyboard = Inline [[Button]] deriving Show - -instance FromJSON Keyboard where - parseJSON = withObject "Inline" $ \v -> - Inline <$> v .: "inline_keyboard" - -instance ToJSON Keyboard where - toJSON (Inline buttons) = object - ["inline_keyboard" .= buttons] diff --git a/Network/Telegram/API/Bot/Object/Update/Message/Keyboard/Button.hs b/Network/Telegram/API/Bot/Object/Update/Message/Keyboard/Button.hs deleted file mode 100644 --- a/Network/Telegram/API/Bot/Object/Update/Message/Keyboard/Button.hs +++ /dev/null @@ -1,35 +0,0 @@ -module Network.Telegram.API.Bot.Object.Update.Message.Keyboard.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 (Applicative (pure, (<*>)), Alternative ((<|>))) -import "base" Control.Monad (Monad ((>>=)), fail) -import "base" Data.Function ((.), ($)) -import "base" Data.Functor (Functor (fmap), (<$>)) -import "base" Data.Maybe (Maybe, maybe) -import "base" Text.Show (Show) -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") pure 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" diff --git a/Network/Telegram/API/Bot/Object/Update/Message/Origin.hs b/Network/Telegram/API/Bot/Object/Update/Message/Origin.hs deleted file mode 100644 --- a/Network/Telegram/API/Bot/Object/Update/Message/Origin.hs +++ /dev/null @@ -1,31 +0,0 @@ -module Network.Telegram.API.Bot.Object.Update.Message.Origin (Origin (..)) where - -import "aeson" Data.Aeson (FromJSON (parseJSON), withObject, (.:)) -import "aeson" Data.Aeson.Types (Object, Parser, Value) -import "base" Control.Applicative (Applicative ((<*>))) -import "base" Control.Monad (Monad ((>>=)), fail) -import "base" Data.Function (($)) -import "base" Data.Functor ((<$>)) -import "base" Data.Int (Int64) -import "base" Text.Show (Show) -import "text" Data.Text (Text) - -import Network.Telegram.API.Bot.Object.Sender (Sender) - -data Origin - = Private Int64 Sender - | Group Int64 Text Sender - | Supergroup Int64 Text Sender - | Channel Int64 Text - deriving Show - -instance FromJSON Origin where - parseJSON = withObject "Message" $ \v -> v .: "chat" >>= chat v where - - chat :: Object -> Value -> Parser Origin - chat v = withObject "Origin" $ \c -> c .: "type" >>= \case - ("private" :: Text) -> Private <$> c .: "id" <*> v .: "from" - ("group" :: Text) -> Group <$> c .: "id" <*> c .: "title" <*> v .: "from" - ("supergroup" :: Text) -> Supergroup <$> c .: "id" <*> c .: "title" <*> v .: "from" - ("channel" :: Text) -> Channel <$> c .: "id" <*> c .: "title" - _ -> fail "Type of chat is not defined" diff --git a/Network/Telegram/API/Bot/Object/Update/Moving.hs b/Network/Telegram/API/Bot/Object/Update/Moving.hs deleted file mode 100644 --- a/Network/Telegram/API/Bot/Object/Update/Moving.hs +++ /dev/null @@ -1,30 +0,0 @@ -module Network.Telegram.API.Bot.Object.Update.Moving (Moving (..)) where - -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.Function (($)) -import "base" Data.Functor ((<$>)) -import "base" Data.Int (Int64) -import "base" Text.Show (Show) -import "text" Data.Text (Text) - -import Network.Telegram.API.Bot.Object.Sender (Sender) - -data Moving - = Gone Sender (Int64, Text) - | Joined [Sender] (Int64, Text) - deriving Show - -instance FromJSON Moving where - parseJSON = withObject "Moving" $ \v -> gone v <|> joined v where - - gone :: Object -> Parser Moving - gone v = Gone <$> v .: "left_chat_member" <*> (v .: "chat" >>= chat) - - joined :: Object -> Parser Moving - joined v = Joined <$> v .: "new_chat_members" <*> (v .: "chat" >>= chat) - - chat :: Object -> Parser (Int64, Text) - chat c = (,) <$> c .: "id" <*> c .: "title" diff --git a/Network/Telegram/API/Bot/Property.hs b/Network/Telegram/API/Bot/Property.hs deleted file mode 100644 --- a/Network/Telegram/API/Bot/Property.hs +++ /dev/null @@ -1,5 +0,0 @@ -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 diff --git a/Network/Telegram/API/Bot/Property/Accessible.hs b/Network/Telegram/API/Bot/Property/Accessible.hs deleted file mode 100644 --- a/Network/Telegram/API/Bot/Property/Accessible.hs +++ /dev/null @@ -1,28 +0,0 @@ -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.Update.Callback (Callback (Datatext)) -import Network.Telegram.API.Bot.Object.Update.Message (Message (Direct, Forward, Reply)) -import Network.Telegram.API.Bot.Object.Update.Message.Content (Content) -import Network.Telegram.API.Bot.Object.Update.Message.Origin (Origin) - -class Object source => Accessible target source where - access :: Lens' source target - -instance Accessible Content Message where - access f (Direct msg_id origin content) = (\content' -> Direct msg_id origin content') <$> f content - access f (Forward msg_id origin content) = (\content' -> Forward msg_id origin content') <$> f content - access f (Reply msg_id origin content msg) = (\content' -> Reply msg_id origin content' msg) <$> f content - -instance Accessible Origin Callback where - access f (Datatext cq_id msg dttxt) = flip - (Datatext cq_id) dttxt <$> access f msg - -instance Accessible Origin Message where - access f (Direct msg_id origin content) = (\origin' -> Direct msg_id origin' content) <$> f origin - access f (Forward msg_id origin content) = (\origin' -> Forward msg_id origin' content) <$> f origin - access f (Reply msg_id origin content msg) = (\origin' -> Reply msg_id origin' content msg) <$> f origin diff --git a/Network/Telegram/API/Bot/Property/Identifiable.hs b/Network/Telegram/API/Bot/Property/Identifiable.hs deleted file mode 100644 --- a/Network/Telegram/API/Bot/Property/Identifiable.hs +++ /dev/null @@ -1,46 +0,0 @@ -module Network.Telegram.API.Bot.Property.Identifiable (Identifiable (..), Identificator) where - -import "base" Data.Int (Int, Int64) -import "text" Data.Text (Text) - -import Network.Telegram.API.Bot.Object (Object) -import Network.Telegram.API.Bot.Object.Update (Update (Query, Membership, Incoming)) -import Network.Telegram.API.Bot.Object.Update.Callback (Callback (Datatext)) -import Network.Telegram.API.Bot.Object.Update.Message (Message (Direct, Forward, Reply)) -import Network.Telegram.API.Bot.Object.Update.Message.Origin (Origin (Private, Group, Supergroup, Channel)) -import Network.Telegram.API.Bot.Object.Sender (Sender (Bot, User)) - -type family Identificator o = i - -class Object o => Identifiable o where - {-# MINIMAL identificator #-} - identificator :: o -> Identificator o - -type instance Identificator Callback = Text -type instance Identificator Message = Int -type instance Identificator Origin = Int64 -type instance Identificator Sender = Int -type instance Identificator Update = Int - -instance Identifiable Callback where - identificator (Datatext i _ _) = i - -instance Identifiable Message where - identificator (Direct i _ _) = i - identificator (Forward i _ _) = i - identificator (Reply i _ _ _) = i - -instance Identifiable Origin where - identificator (Private i _) = i - identificator (Group i _ _) = i - identificator (Supergroup i _ _) = i - identificator (Channel i _) = i - -instance Identifiable Sender where - identificator (Bot i _ _ _ _) = i - identificator (User i _ _ _ _) = i - -instance Identifiable Update where - identificator (Query i _) = i - identificator (Membership i _) = i - identificator (Incoming i _) = i diff --git a/Network/Telegram/API/Bot/Property/Persistable.hs b/Network/Telegram/API/Bot/Property/Persistable.hs deleted file mode 100644 --- a/Network/Telegram/API/Bot/Property/Persistable.hs +++ /dev/null @@ -1,160 +0,0 @@ -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) -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, 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, Keyboard, Notification, Member, Sender) -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 = 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 '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 () - -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 #-} - 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 - -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 - payload (PL (chat_id, text, kb)) = object - ["chat_id" .= chat_id, "text" .= text, "reply_markup" .= kb] - endpoint _ = "sendMessage" - -instance Persistable 'Fetch' Member where - payload (PL (chat_id, user_id)) = object ["chat_id" .= chat_id, "user_id" .= user_id] - endpoint _ = "getChatMember" - -instance Persistable ('Direct' 'Post') Message where - payload (PL (chat_id, text)) = object ["chat_id" .= chat_id, "text" .= text] - endpoint _ = "sendMessage" - -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 ('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 - payload (PL (chat_id, message_id)) = object ["chat_id" .= chat_id, "message_id" .= message_id] - endpoint _ = "deleteMessage" - -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 - 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 --- a/telega.cabal +++ b/telega.cabal @@ -1,5 +1,5 @@ name: telega -version: 0.1.9 +version: 0.2.0 synopsis: Telegram Bot API binding description: High-level bindings, typed entities, inline mode only homepage: https://github.com/iokasimov/telega @@ -19,32 +19,32 @@ library exposed-modules: - Network.Telegram.API.Bot - 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 - Network.Telegram.API.Bot.Object.Update.Callback.Notification - Network.Telegram.API.Bot.Object.Update.Message - Network.Telegram.API.Bot.Object.Update.Message.Content - Network.Telegram.API.Bot.Object.Update.Message.Content.File - Network.Telegram.API.Bot.Object.Update.Message.Content.Info - Network.Telegram.API.Bot.Object.Update.Message.Content.Location - Network.Telegram.API.Bot.Object.Update.Message.Content.Size - Network.Telegram.API.Bot.Object.Update.Message.Keyboard - Network.Telegram.API.Bot.Object.Update.Message.Keyboard.Button - Network.Telegram.API.Bot.Object.Update.Message.Origin - Network.Telegram.API.Bot.Object.Update.Moving - Network.Telegram.API.Bot.Property - Network.Telegram.API.Bot.Property.Accessible - Network.Telegram.API.Bot.Property.Identifiable - Network.Telegram.API.Bot.Property.Persistable - build-depends: base == 4.*, transformers, lens, aeson, text, time, http-client, wreq - default-extensions: DataKinds, LambdaCase, OverloadedStrings, NoImplicitPrelude, PackageImports, + Network.API.Telegram.Bot + Network.API.Telegram.Bot.Core + Network.API.Telegram.Bot.Object + Network.API.Telegram.Bot.Object.Member + Network.API.Telegram.Bot.Object.Member.Powers + Network.API.Telegram.Bot.Object.Member.Restrictions + Network.API.Telegram.Bot.Object.Sender + Network.API.Telegram.Bot.Object.Update + Network.API.Telegram.Bot.Object.Update.Callback + Network.API.Telegram.Bot.Object.Update.Callback.Notification + Network.API.Telegram.Bot.Object.Update.Message + Network.API.Telegram.Bot.Object.Update.Message.Content + Network.API.Telegram.Bot.Object.Update.Message.Content.File + Network.API.Telegram.Bot.Object.Update.Message.Content.Info + Network.API.Telegram.Bot.Object.Update.Message.Content.Location + Network.API.Telegram.Bot.Object.Update.Message.Content.Size + Network.API.Telegram.Bot.Object.Update.Message.Keyboard + Network.API.Telegram.Bot.Object.Update.Message.Keyboard.Button + Network.API.Telegram.Bot.Object.Update.Message.Origin + Network.API.Telegram.Bot.Object.Update.Moving + Network.API.Telegram.Bot.Property + Network.API.Telegram.Bot.Property.Accessible + Network.API.Telegram.Bot.Property.Identifiable + Network.API.Telegram.Bot.Property.Persistable + build-depends: base == 4.*, transformers, tagged, lens, aeson, text, time, http-client, wreq + default-extensions: DataKinds, LambdaCase, OverloadedStrings, NoImplicitPrelude, PackageImports, ViewPatterns, AllowAmbiguousTypes, MultiParamTypeClasses, ScopedTypeVariables, UndecidableInstances, UndecidableSuperClasses, FlexibleInstances, TypeApplications, TypeFamilies, TypeFamilyDependencies, TypeOperators, PolyKinds default-language: Haskell2010