{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# 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 = Options -> a -> Value forall a. (Generic a, GToJSON' Value Zero (Rep a)) => Options -> a -> Value genericToJSON (String -> Options jsonOptions (Proxy3 d f a -> String forall {k} (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *) (f :: k1 -> *) (a :: k1). Datatype d => t d f a -> String forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *) (a :: k1). t d f a -> String datatypeName (Proxy3 d f a 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 = Options -> Value -> Parser a forall a. (Generic a, GFromJSON Zero (Rep a)) => Options -> Value -> Parser a genericParseJSON (String -> Options jsonOptions (Proxy3 d f a -> String forall {k} (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *) (f :: k1 -> *) (a :: k1). Datatype d => t d f a -> String forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *) (a :: k1). t d f a -> String datatypeName (Proxy3 d f a 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 = Rep a Any -> Value forall p. Rep a p -> Value forall {k} (f :: k -> *) (p :: k). GSomeJSON f => f p -> Value gsomeToJSON (Rep a Any -> Value) -> (a -> Rep a Any) -> a -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> Rep a Any forall x. a -> Rep a x 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 = (Rep a Any -> a) -> Parser (Rep a Any) -> Parser a forall a b. (a -> b) -> Parser a -> Parser b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Rep a Any -> a forall a x. Generic a => Rep a x -> a forall x. Rep a x -> a to (Parser (Rep a Any) -> Parser a) -> (Value -> Parser (Rep a Any)) -> Value -> Parser a forall b c a. (b -> c) -> (a -> b) -> a -> c . Value -> Parser (Rep a Any) forall p. Value -> Parser (Rep a p) 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 = snakeFieldModifier tname , constructorTagModifier = snakeFieldModifier tname , omitNothingFields = 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 String -> [String] -> [String] forall a. a -> [a] -> [a] : String -> [String] camelWords String restLs String _ -> (String us String -> String -> String forall a. [a] -> [a] -> [a] ++ String ls) String -> [String] -> [String] forall a. a -> [a] -> [a] : String -> [String] camelWords String rest where (String us, String restLs) = (Char -> Bool) -> String -> (String, String) forall a. (a -> Bool) -> [a] -> ([a], [a]) span Char -> Bool isUpper String s (String ls, String rest) = (Char -> Bool) -> String -> (String, String) 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 a -> a -> Bool forall a. Eq a => a -> a -> Bool == a y = [a] -> [a] -> [a] 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) = (Char -> Char) -> String -> String forall a b. (a -> b) -> [a] -> [b] map Char -> Char toLower String w String -> String -> String forall a. [a] -> [a] -> [a] ++ (String -> String) -> [String] -> String forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap String -> String capitalise [String] ws wordsToSnake :: [String] -> String wordsToSnake :: [String] -> String wordsToSnake = String -> [String] -> String forall a. [a] -> [[a]] -> [a] intercalate String "_" ([String] -> String) -> ([String] -> [String]) -> [String] -> String forall b c a. (b -> c) -> (a -> b) -> a -> c . (String -> String) -> [String] -> [String] forall a b. (a -> b) -> [a] -> [b] map ((Char -> Char) -> String -> String 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 Char -> String -> String forall a. a -> [a] -> [a] : String s capitalise String "" = String "" stripCommonPrefixWords :: String -> String -> [String] stripCommonPrefixWords :: String -> String -> [String] stripCommonPrefixWords String xs String ys = [String] -> [String] -> [String] 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) = f p -> Value forall (p :: k). f p -> Value 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 = f p -> M1 D d f p forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p M1 (f p -> M1 D d f p) -> Parser (f p) -> Parser (M1 D d f p) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Value -> Parser (f p) forall (p :: k). Value -> Parser (f p) 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))) = a -> Value 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 = S1 s (K1 i a) p -> M1 C c (S1 s (K1 i a)) p forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p M1 (S1 s (K1 i a) p -> M1 C c (S1 s (K1 i a)) p) -> (a -> S1 s (K1 i a) p) -> a -> M1 C c (S1 s (K1 i a)) p forall b c a. (b -> c) -> (a -> b) -> a -> c . K1 i a p -> S1 s (K1 i a) p forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p M1 (K1 i a p -> S1 s (K1 i a) p) -> (a -> K1 i a p) -> a -> S1 s (K1 i a) p forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> K1 i a p forall k i c (p :: k). c -> K1 i c p K1 (a -> M1 C c (S1 s (K1 i a)) p) -> Parser a -> Parser (M1 C c (S1 s (K1 i a)) p) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Value -> Parser a 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) = f p -> Value forall (p :: k). f p -> Value forall {k} (f :: k -> *) (p :: k). GSomeJSON f => f p -> Value gsomeToJSON f p x gsomeToJSON (R1 g p y) = g p -> Value forall (p :: k). g p -> Value 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 = f p -> (:+:) f g p forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p L1 (f p -> (:+:) f g p) -> Parser (f p) -> Parser ((:+:) f g p) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Value -> Parser (f p) forall (p :: k). Value -> Parser (f p) forall {k} (f :: k -> *) (p :: k). GSomeJSON f => Value -> Parser (f p) gsomeParseJSON Value js Parser ((:+:) f g p) -> Parser ((:+:) f g p) -> Parser ((:+:) f g p) forall a. Parser a -> Parser a -> Parser a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> g p -> (:+:) f g p forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p R1 (g p -> (:+:) f g p) -> Parser (g p) -> Parser ((:+:) f g p) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Value -> Parser (g p) forall (p :: k). Value -> Parser (g p) 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 (Object -> Value) -> Object -> Value forall a b. (a -> b) -> a -> b $ Object -> Object -> Object forall v. KeyMap v -> KeyMap v -> KeyMap v Map.union Object obj (Object -> Object) -> Object -> Object forall a b. (a -> b) -> a -> b $ [Pair] -> Object forall v. [(Key, v)] -> KeyMap v Map.fromList ((Pair -> Bool) -> [Pair] -> [Pair] forall a. (a -> Bool) -> [a] -> [a] filter (Bool -> Bool not (Bool -> Bool) -> (Pair -> Bool) -> Pair -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . Pair -> Bool isNull) [Pair] pairs) addJsonFields Value x [Pair] _ = Value x isNull :: Pair -> Bool isNull :: Pair -> Bool isNull (Key _, Value Null) = Bool True isNull Pair _ = Bool False addMultipartFields :: [Input] -> MultipartData tag -> MultipartData tag addMultipartFields :: forall tag. [Input] -> MultipartData tag -> MultipartData tag addMultipartFields [Input] newFields (MultipartData [Input] currenFields [FileData tag] files) = [Input] -> [FileData tag] -> MultipartData tag forall tag. [Input] -> [FileData tag] -> MultipartData tag MultipartData ([Input] newFields [Input] -> [Input] -> [Input] forall a. Semigroup a => a -> a -> a <> [Input] currenFields) [FileData tag] files