{-# LANGUAGE
        TemplateHaskell
  #-}

-- |Template Haskell utility code to replicate instance declarations
-- to cover large numbers of types.  I'm doing that rather than using
-- class contexts because most Distribution instances need to cover
-- multiple classes (such as Enum, Integral and Fractional) and that
-- can't be done easily because of overlap.  
-- 
-- I experimented a bit with a convoluted type-level classification 
-- scheme, but I think this is simpler and easier to understand.  It 
-- makes the haddock docs more cluttered because of the combinatorial 
-- explosion of instances, but overall I think it's just more sane than 
-- anything else I've come up with yet.
module Data.Random.Internal.TH
    ( replicateInstances
    , integralTypes, realFloatTypes
    ) where

import Data.Generics
import Language.Haskell.TH

import Data.Word
import Data.Int
import Control.Monad

-- |Names of standard 'Integral' types
integralTypes :: [Name]
integralTypes :: [Name]
integralTypes = 
    [ ''Integer
    , ''Int,  ''Int8,  ''Int16,  ''Int32,  ''Int64
    , ''Word, ''Word8, ''Word16, ''Word32, ''Word64
    ]

-- |Names of standard 'RealFloat' types
realFloatTypes :: [Name]
realFloatTypes :: [Name]
realFloatTypes =
    [ ''Float, ''Double ]

-- @replaceName x y@ is a function that will
-- replace @x@ with @y@ whenever it sees it.  That is:
--
-- > replaceName x y x  ==>  y
-- > replaceName x y z  ==>  z
--  (@z /= x@)
replaceName :: Name -> Name -> Name -> Name
replaceName :: Name -> Name -> Name -> Name
replaceName x :: Name
x y :: Name
y z :: Name
z
    | Name
x Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
z    = Name
y
    | Bool
otherwise = Name
z

-- | @replicateInstances standin types decls@ will take the template-haskell
-- 'Dec's in @decls@ and substitute every instance of the 'Name' @standin@ with
-- each 'Name' in @types@, producing one copy of the 'Dec's in @decls@ for every
-- 'Name' in @types@.
-- 
-- For example, 'Data.Random.Distribution.Uniform' has the following bit of TH code:
-- 
-- @ $( replicateInstances ''Int integralTypes [d|                                                  @
-- 
-- @       instance Distribution Uniform Int   where rvar (Uniform a b) = integralUniform a b       @
-- 
-- @       instance CDF Uniform Int            where cdf  (Uniform a b) = integralUniformCDF a b    @
-- 
-- @   |])                                                                                          @
-- 
-- This code takes those 2 instance declarations and creates identical ones for
-- every type named in 'integralTypes'.
replicateInstances :: (Monad m, Data t) => Name -> [Name] -> m [t] -> m [t]
replicateInstances :: Name -> [Name] -> m [t] -> m [t]
replicateInstances standin :: Name
standin types :: [Name]
types getDecls :: m [t]
getDecls = ([[t]] -> [t]) -> m [[t]] -> m [t]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [[t]] -> [t]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (m [[t]] -> m [t]) -> m [[t]] -> m [t]
forall a b. (a -> b) -> a -> b
$ [m [t]] -> m [[t]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
    [ do
        [t]
decls <- m [t]
getDecls
        [m t] -> m [t]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
            [ GenericM m -> t -> m t
forall (m :: * -> *). Monad m => GenericM m -> GenericM m
everywhereM ((Name -> m Name) -> a -> m a
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(b -> m b) -> a -> m a
mkM (Name -> m Name
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> m Name) -> (Name -> Name) -> Name -> m Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Name -> Name -> Name
replaceName Name
standin Name
t)) t
dec
            | t
dec <- [t]
decls
            ]
    | Name
t <- [Name]
types
    ]