{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} 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) import Data.Char (isUpper, toUpper, toLower) import Data.List (intercalate) import GHC.Generics import Language.Haskell.TH deriveJSON' :: Name -> Q [Dec] deriveJSON' :: Name -> Q [Dec] deriveJSON' name :: 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 :: 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 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 :: 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 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 :: a -> Value genericSomeToJSON = Rep a Any -> 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 a x. Generic a => a -> Rep a x from genericSomeParseJSON :: (Generic a, GSomeJSON (Rep a)) => Value -> Parser a genericSomeParseJSON :: Value -> Parser a genericSomeParseJSON = (Rep a Any -> a) -> Parser (Rep a Any) -> Parser a 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 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 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 tname :: 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 xs :: String xs ys :: String ys = [String] -> String wordsToSnake (String -> String -> [String] stripCommonPrefixWords String xs String ys) camelWords :: String -> [String] camelWords :: String -> [String] camelWords "" = [] camelWords s :: String s = case String us of (_:_:_) -> String us String -> [String] -> [String] forall a. a -> [a] -> [a] : String -> [String] camelWords String restLs _ -> (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 (us :: String us, restLs :: String restLs) = (Char -> Bool) -> String -> (String, String) forall a. (a -> Bool) -> [a] -> ([a], [a]) span Char -> Bool isUpper String s (ls :: String ls, rest :: 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 :: [a] -> [a] -> [a] stripCommonPrefix (x :: a x:xs :: [a] xs) (y :: a y:ys :: [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 _ ys :: [a] ys = [a] ys wordsToCamel :: [String] -> String wordsToCamel :: [String] -> String wordsToCamel [] = "" wordsToCamel (w :: String w:ws :: [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 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 (c :: Char c:s :: String s) = Char -> Char toUpper Char c Char -> String -> String forall a. a -> [a] -> [a] : String s capitalise "" = "" stripCommonPrefixWords :: String -> String -> [String] stripCommonPrefixWords :: String -> String -> [String] stripCommonPrefixWords xs :: String xs ys :: 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 :: D1 d f p -> Value gsomeToJSON (M1 x :: f p x) = f p -> Value forall k (f :: k -> *) (p :: k). GSomeJSON f => f p -> Value gsomeToJSON f p x gsomeParseJSON :: Value -> Parser (D1 d f p) gsomeParseJSON js :: Value js = f p -> D1 d f p forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p M1 (f p -> D1 d f p) -> Parser (f p) -> Parser (D1 d f p) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> 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 :: C1 c (S1 s (K1 i a)) p -> Value gsomeToJSON (M1 (M1 (K1 x :: a x))) = a -> Value forall a. ToJSON a => a -> Value toJSON a x gsomeParseJSON :: Value -> Parser (C1 c (S1 s (K1 i a)) p) gsomeParseJSON js :: Value js = (M1 S s (K1 i a) p -> C1 c (S1 s (K1 i a)) p forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p M1 (M1 S s (K1 i a) p -> C1 c (S1 s (K1 i a)) p) -> (a -> M1 S s (K1 i a) p) -> a -> C1 c (S1 s (K1 i a)) p forall b c a. (b -> c) -> (a -> b) -> a -> c . K1 i a p -> M1 S 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 -> M1 S s (K1 i a) p) -> (a -> K1 i a p) -> a -> M1 S 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 -> C1 c (S1 s (K1 i a)) p) -> Parser a -> Parser (C1 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 :: (:+:) f g p -> Value gsomeToJSON (L1 x :: f p x) = f p -> Value forall k (f :: k -> *) (p :: k). GSomeJSON f => f p -> Value gsomeToJSON f p x gsomeToJSON (R1 y :: g p y) = g p -> Value forall k (f :: k -> *) (p :: k). GSomeJSON f => f p -> Value gsomeToJSON g p y gsomeParseJSON :: Value -> Parser ((:+:) f g p) gsomeParseJSON js :: 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 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 (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 k (f :: k -> *) (p :: k). GSomeJSON f => Value -> Parser (f p) gsomeParseJSON Value js