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