{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE CPP #-} module Telegram.Bot.API.Internal.Utils where import Control.Applicative ((<|>)) import Data.Aeson (FromJSON(..), ToJSON(..), Value(..), GToJSON, GFromJSON, genericToJSON, genericParseJSON, Zero) import Data.Aeson.TH (deriveJSON) import Data.Aeson.Types (Options(..), defaultOptions, Parser, Pair) import Data.Char (isUpper, toUpper, toLower) import Data.List (intercalate) import GHC.Generics import Language.Haskell.TH import Servant.Multipart.API (MultipartData(MultipartData), Input) import Telegram.Bot.API.Internal.TH () #if MIN_VERSION_aeson(2,0,0) import qualified Data.Aeson.KeyMap as Map #else import qualified Data.HashMap.Strict as Map #endif deriveJSON' :: Name -> Q [Dec] deriveJSON' :: Name -> Q [Dec] deriveJSON' Name name = Options -> Name -> Q [Dec] deriveJSON (String -> Options jsonOptions (Name -> String nameBase Name name)) Name name gtoJSON :: forall a d f. (Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) => a -> Value gtoJSON :: forall a (d :: Meta) (f :: * -> *). (Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) => a -> Value gtoJSON = forall a. (Generic a, GToJSON' Value Zero (Rep a)) => Options -> a -> Value genericToJSON (String -> Options jsonOptions (forall {k} (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *) (f :: k1 -> *) (a :: k1). Datatype d => t d f a -> String datatypeName (forall {k} {k} {k} (d :: k) (f :: k) (a :: k). Proxy3 d f a Proxy3 :: Proxy3 d f a))) gparseJSON :: forall a d f. (Generic a, GFromJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) => Value -> Parser a gparseJSON :: forall a (d :: Meta) (f :: * -> *). (Generic a, GFromJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) => Value -> Parser a gparseJSON = forall a. (Generic a, GFromJSON Zero (Rep a)) => Options -> Value -> Parser a genericParseJSON (String -> Options jsonOptions (forall {k} (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *) (f :: k1 -> *) (a :: k1). Datatype d => t d f a -> String datatypeName (forall {k} {k} {k} (d :: k) (f :: k) (a :: k). Proxy3 d f a Proxy3 :: Proxy3 d f a))) genericSomeToJSON :: (Generic a, GSomeJSON (Rep a)) => a -> Value genericSomeToJSON :: forall a. (Generic a, GSomeJSON (Rep a)) => a -> Value genericSomeToJSON = forall {k} (f :: k -> *) (p :: k). GSomeJSON f => f p -> Value gsomeToJSON forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a x. Generic a => a -> Rep a x from genericSomeParseJSON :: (Generic a, GSomeJSON (Rep a)) => Value -> Parser a genericSomeParseJSON :: forall a. (Generic a, GSomeJSON (Rep a)) => Value -> Parser a genericSomeParseJSON = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap forall a x. Generic a => Rep a x -> a to forall b c a. (b -> c) -> (a -> b) -> a -> c . forall {k} (f :: k -> *) (p :: k). GSomeJSON f => Value -> Parser (f p) gsomeParseJSON data Proxy3 d f a = Proxy3 jsonOptions :: String -> Options jsonOptions :: String -> Options jsonOptions String tname = Options defaultOptions { fieldLabelModifier :: String -> String fieldLabelModifier = String -> String -> String snakeFieldModifier String tname , constructorTagModifier :: String -> String constructorTagModifier = String -> String -> String snakeFieldModifier String tname , omitNothingFields :: Bool omitNothingFields = Bool True } snakeFieldModifier :: String -> String -> String snakeFieldModifier :: String -> String -> String snakeFieldModifier String xs String ys = [String] -> String wordsToSnake (String -> String -> [String] stripCommonPrefixWords String xs String ys) camelWords :: String -> [String] camelWords :: String -> [String] camelWords String "" = [] camelWords String s = case String us of (Char _:Char _:String _) -> String us forall a. a -> [a] -> [a] : String -> [String] camelWords String restLs String _ -> (String us forall a. [a] -> [a] -> [a] ++ String ls) forall a. a -> [a] -> [a] : String -> [String] camelWords String rest where (String us, String restLs) = forall a. (a -> Bool) -> [a] -> ([a], [a]) span Char -> Bool isUpper String s (String ls, String rest) = forall a. (a -> Bool) -> [a] -> ([a], [a]) break Char -> Bool isUpper String restLs stripCommonPrefix :: Eq a => [a] -> [a] -> [a] stripCommonPrefix :: forall a. Eq a => [a] -> [a] -> [a] stripCommonPrefix (a x:[a] xs) (a y:[a] ys) | a x forall a. Eq a => a -> a -> Bool == a y = forall a. Eq a => [a] -> [a] -> [a] stripCommonPrefix [a] xs [a] ys stripCommonPrefix [a] _ [a] ys = [a] ys wordsToCamel :: [String] -> String wordsToCamel :: [String] -> String wordsToCamel [] = String "" wordsToCamel (String w:[String] ws) = forall a b. (a -> b) -> [a] -> [b] map Char -> Char toLower String w forall a. [a] -> [a] -> [a] ++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap String -> String capitalise [String] ws wordsToSnake :: [String] -> String wordsToSnake :: [String] -> String wordsToSnake = forall a. [a] -> [[a]] -> [a] intercalate String "_" forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (a -> b) -> [a] -> [b] map (forall a b. (a -> b) -> [a] -> [b] map Char -> Char toLower) capitalise :: String -> String capitalise :: String -> String capitalise (Char c:String s) = Char -> Char toUpper Char c forall a. a -> [a] -> [a] : String s capitalise String "" = String "" stripCommonPrefixWords :: String -> String -> [String] stripCommonPrefixWords :: String -> String -> [String] stripCommonPrefixWords String xs String ys = forall a. Eq a => [a] -> [a] -> [a] stripCommonPrefix (String -> [String] camelWords String xs) (String -> [String] camelWords (String -> String capitalise String ys)) class GSomeJSON f where gsomeToJSON :: f p -> Value gsomeParseJSON :: Value -> Parser (f p) instance GSomeJSON f => GSomeJSON (D1 d f) where gsomeToJSON :: forall (p :: k). D1 d f p -> Value gsomeToJSON (M1 f p x) = forall {k} (f :: k -> *) (p :: k). GSomeJSON f => f p -> Value gsomeToJSON f p x gsomeParseJSON :: forall (p :: k). Value -> Parser (D1 d f p) gsomeParseJSON Value js = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p M1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall {k} (f :: k -> *) (p :: k). GSomeJSON f => Value -> Parser (f p) gsomeParseJSON Value js instance (ToJSON a, FromJSON a) => GSomeJSON (C1 c (S1 s (K1 i a))) where gsomeToJSON :: forall (p :: k). C1 c (S1 s (K1 i a)) p -> Value gsomeToJSON (M1 (M1 (K1 a x))) = forall a. ToJSON a => a -> Value toJSON a x gsomeParseJSON :: forall (p :: k). Value -> Parser (C1 c (S1 s (K1 i a)) p) gsomeParseJSON Value js = (forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p M1 forall b c a. (b -> c) -> (a -> b) -> a -> c . forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p M1 forall b c a. (b -> c) -> (a -> b) -> a -> c . forall k i c (p :: k). c -> K1 i c p K1) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. FromJSON a => Value -> Parser a parseJSON Value js instance (GSomeJSON f, GSomeJSON g) => GSomeJSON (f :+: g) where gsomeToJSON :: forall (p :: k). (:+:) f g p -> Value gsomeToJSON (L1 f p x) = forall {k} (f :: k -> *) (p :: k). GSomeJSON f => f p -> Value gsomeToJSON f p x gsomeToJSON (R1 g p y) = forall {k} (f :: k -> *) (p :: k). GSomeJSON f => f p -> Value gsomeToJSON g p y gsomeParseJSON :: forall (p :: k). Value -> Parser ((:+:) f g p) gsomeParseJSON Value js = forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p L1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall {k} (f :: k -> *) (p :: k). GSomeJSON f => Value -> Parser (f p) gsomeParseJSON Value js forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p R1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall {k} (f :: k -> *) (p :: k). GSomeJSON f => Value -> Parser (f p) gsomeParseJSON Value js addJsonFields :: Value -> [Pair] -> Value addJsonFields :: Value -> [Pair] -> Value addJsonFields (Object Object obj) [Pair] pairs = Object -> Value Object forall a b. (a -> b) -> a -> b $ forall v. KeyMap v -> KeyMap v -> KeyMap v Map.union Object obj (forall v. [(Key, v)] -> KeyMap v Map.fromList [Pair] pairs) addJsonFields Value x [Pair] _ = Value x addMultipartFields :: [Input] -> MultipartData tag -> MultipartData tag addMultipartFields :: forall tag. [Input] -> MultipartData tag -> MultipartData tag addMultipartFields [Input] newFields (MultipartData [Input] currenFields [FileData tag] files) = forall tag. [Input] -> [FileData tag] -> MultipartData tag MultipartData ([Input] newFields forall a. Semigroup a => a -> a -> a <> [Input] currenFields) [FileData tag] files