{-# LANGUAGE TemplateHaskellQuotes #-}
module Web.Pixiv.TH
( derivePixivJSON,
derivePixivJSON',
deriveEnumJSON,
deriveEnumJSON',
deriveEnumToHttpApiData,
deriveEnumToHttpApiData',
ToHttpApiData (..),
FromJSON (..),
ToJSON (..),
)
where
import Data.Aeson (FromJSON (..), ToJSON (..), camelTo2)
import Data.Aeson.TH
import Data.List (stripPrefix)
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import Language.Haskell.TH
import Servant.API (ToHttpApiData (..))
derivePixivJSON :: String -> Name -> DecsQ
derivePixivJSON :: String -> Name -> DecsQ
derivePixivJSON String
prefix =
Options -> Name -> DecsQ
deriveJSON
Options
defaultOptions
{ fieldLabelModifier :: String -> String
fieldLabelModifier = String -> String -> String
modifyFieldName String
prefix
}
derivePixivJSON' :: Name -> DecsQ
derivePixivJSON' :: Name -> DecsQ
derivePixivJSON' = String -> Name -> DecsQ
derivePixivJSON String
""
deriveEnumJSON :: String -> Name -> DecsQ
deriveEnumJSON :: String -> Name -> DecsQ
deriveEnumJSON String
prefix =
Options -> Name -> DecsQ
deriveJSON
Options
defaultOptions
{ constructorTagModifier :: String -> String
constructorTagModifier = String -> String -> String
modifyConsturctorName String
prefix
}
deriveEnumJSON' :: Name -> DecsQ
deriveEnumJSON' :: Name -> DecsQ
deriveEnumJSON' = String -> Name -> DecsQ
deriveEnumJSON String
""
deriveEnumToHttpApiData :: String -> Name -> DecsQ
deriveEnumToHttpApiData :: String -> Name -> DecsQ
deriveEnumToHttpApiData String
prefix Name
name =
Name -> Q Info
reify Name
name Q Info -> (Info -> DecsQ) -> DecsQ
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
TyConI Dec
dec -> case Dec
dec of
(DataD Cxt
_ Name
_dataName [] Maybe Kind
_ [Con]
cons [DerivClause]
_) -> do
let conNames :: [Name]
conNames = [Name
n | (NormalC Name
n []) <- [Con]
cons]
if [Con] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [Con]
cons Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [Name] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [Name]
conNames
then String -> DecsQ
forall a. HasCallStack => String -> a
error String
"Data type is not simply an enum"
else do
let clauses :: [ClauseQ]
clauses =
[ [PatQ] -> BodyQ -> [DecQ] -> ClauseQ
clause
[Name -> [PatQ] -> PatQ
conP Name
n []]
(ExpQ -> BodyQ
normalB [|T.pack $ modifyConsturctorName prefix n'|])
[]
| Name
n <- [Name]
conNames,
let n' :: String
n' = Name -> String
nameBase Name
n
]
Dec
func <- Name -> [ClauseQ] -> DecQ
funD (String -> Name
mkName String
"toQueryParam") [ClauseQ]
clauses
[Dec] -> DecsQ
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [Maybe Overlap -> Cxt -> Kind -> [Dec] -> Dec
InstanceD Maybe Overlap
forall a. Maybe a
Nothing [] (Name -> Kind
ConT ''ToHttpApiData Kind -> Kind -> Kind
`AppT` Name -> Kind
ConT Name
name) [Dec
func]]
Dec
_ -> String -> DecsQ
forall a. HasCallStack => String -> a
error String
"Unsupported data declaration"
Info
_ -> String -> DecsQ
forall a. HasCallStack => String -> a
error String
"Not a plain type constructor"
deriveEnumToHttpApiData' :: Name -> DecsQ
deriveEnumToHttpApiData' :: Name -> DecsQ
deriveEnumToHttpApiData' = String -> Name -> DecsQ
deriveEnumToHttpApiData String
""
camel2Snake :: String -> String
camel2Snake :: String -> String
camel2Snake = Char -> String -> String
camelTo2 Char
'_'
modifyFieldName :: String -> String -> String
modifyFieldName :: String -> String -> String
modifyFieldName String
prefix String
s = String -> String
camel2Snake (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ case String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
prefix String
s' of
Maybe String
Nothing -> String
s'
Just String
"" -> String
s'
Just String
x -> String
x
where
s' :: String
s' = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
s (String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"_" String
s)
modifyConsturctorName :: String -> String -> String
modifyConsturctorName :: String -> String -> String
modifyConsturctorName String
prefix = String -> String
camel2Snake (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (String -> Maybe String -> String)
-> (String -> Maybe String) -> String -> String
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
prefix)