{-# LANGUAGE TemplateHaskell #-}

-- |
-- Module      :  Codec.Scale.TH
-- Copyright   :  Aleksandr Krupenkin 2016-2024
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  noportable
--
-- It contains template haskell SCALE helper functions.
--

module Codec.Scale.TH where


import           Control.Monad       (replicateM)
import           Language.Haskell.TH (DecsQ, Type (VarT), appT, conT, cxt,
                                      instanceD, newName, tupleT)

import           Codec.Scale.Class   (Decode, Encode)

tupleInstances :: Int -> DecsQ
tupleInstances :: Int -> DecsQ
tupleInstances Int
n = do
    [Name]
vars <- Int -> Q Name -> Q [Name]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (Q Name -> Q [Name]) -> Q Name -> Q [Name]
forall a b. (a -> b) -> a -> b
$ String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"a"
    let types :: [Q Type]
types = (Name -> Q Type) -> [Name] -> [Q Type]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Type -> Q Type
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Q Type) -> (Name -> Type) -> Name -> Q Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Type
VarT) [Name]
vars
    [Q Dec] -> DecsQ
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([Q Dec] -> DecsQ) -> [Q Dec] -> DecsQ
forall a b. (a -> b) -> a -> b
$
      [ Q Cxt -> Q Type -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt -> m Type -> [m Dec] -> m Dec
instanceD ([Q Type] -> Q Cxt
forall (m :: * -> *). Quote m => [m Type] -> m Cxt
cxt ([Q Type] -> Q Cxt) -> [Q Type] -> Q Cxt
forall a b. (a -> b) -> a -> b
$ (Q Type -> Q Type) -> [Q Type] -> [Q Type]
forall a b. (a -> b) -> [a] -> [b]
map (Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Q Type -> Q Type -> Q Type) -> Q Type -> Q Type -> Q Type
forall a b. (a -> b) -> a -> b
$ Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT ''Decode) [Q Type]
types) (Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT ''Decode) ((Q Type -> Q Type -> Q Type) -> Q Type -> [Q Type] -> Q Type
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Int -> Q Type
forall (m :: * -> *). Quote m => Int -> m Type
tupleT Int
n) [Q Type]
types)) []
      , Q Cxt -> Q Type -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt -> m Type -> [m Dec] -> m Dec
instanceD ([Q Type] -> Q Cxt
forall (m :: * -> *). Quote m => [m Type] -> m Cxt
cxt ([Q Type] -> Q Cxt) -> [Q Type] -> Q Cxt
forall a b. (a -> b) -> a -> b
$ (Q Type -> Q Type) -> [Q Type] -> [Q Type]
forall a b. (a -> b) -> [a] -> [b]
map (Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Q Type -> Q Type -> Q Type) -> Q Type -> Q Type -> Q Type
forall a b. (a -> b) -> a -> b
$ Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT ''Encode) [Q Type]
types) (Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT ''Encode) ((Q Type -> Q Type -> Q Type) -> Q Type -> [Q Type] -> Q Type
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Int -> Q Type
forall (m :: * -> *). Quote m => Int -> m Type
tupleT Int
n) [Q Type]
types)) []
      ]