{-|
Copyright   : (C) 2021, QBayLogic B.V.
License     : BSD2 (see the file LICENSE)
Maintainer  : QBayLogic B.V. <devops@qbaylogic.com>

Bias for influencing generator choice.
-}

{-# LANGUAGE CPP #-}

module Clash.Hedgehog.Internal.Bias
  ( Bias(..)
  ) where

import Clash.Core.Subst (aeqType)
import Clash.Core.TyCon
import Clash.Core.Type
import Clash.Core.TysPrim

-- | Determine the bias of an item. This is used to set the weight of that item
-- so we can sample using the 'Hedgehog.Gen.frequency' generator instead of
-- 'Hedgehog.Gen.element' or 'Hedgehog.Gen.choice'.
--
-- Where might you want to introduce such a bias? If there is a collection of
-- elements where there is a likeliness that real code would use certain values
-- more or less, we want to be able to capture this. An obvious example of this
-- is the @TyConMap@, where without it every constructor would have an even
-- weighting, when in reality some (like @Void#@ or @Addr#@ are much less
-- likely to appear in code written by a Clash user).
--
class Bias a where
  biasOf :: a -> Int

-- Remember, the bias we pick here does not necessarily matter. Only
-- constructors with the correct shape will ever be considered.
--
-- TODO These biases are only very loosely based in reality, and could be
-- completely useless at generating the kinds / types we want to see.
instance Bias TyCon where
  biasOf :: TyCon -> Int
biasOf tc :: TyCon
tc@PrimTyCon{}
    | Type -> Type -> Bool
aeqType Type
ty Type
liftedTypeKind   = Int -> Int
biasBy Int
3  -- Type
    | Type -> Type -> Bool
aeqType Type
ty Type
typeNatKind      = Int -> Int
biasBy Int
2  -- Nat
    | Type -> Type -> Bool
aeqType Type
ty Type
typeSymbolKind   = Int -> Int
biasBy Int
1  -- Symbol

    | Type -> Type -> Bool
aeqType Type
ty Type
integerPrimTy    = Int -> Int
biasBy Int
5  -- Integer, Natural, Int#, Word#
    | Type -> Type -> Bool
aeqType Type
ty Type
naturalPrimTy    = Int -> Int
biasBy Int
5
    | Type -> Type -> Bool
aeqType Type
ty Type
intPrimTy        = Int -> Int
biasBy Int
5
    | Type -> Type -> Bool
aeqType Type
ty Type
wordPrimTy       = Int -> Int
biasBy Int
5
    | Type -> Type -> Bool
aeqType Type
ty Type
int64PrimTy      = Int -> Int
biasBy Int
4  -- Int64#, Word64#
    | Type -> Type -> Bool
aeqType Type
ty Type
word64PrimTy     = Int -> Int
biasBy Int
4
    | Type -> Type -> Bool
aeqType Type
ty Type
floatPrimTy      = Int -> Int
biasBy Int
3  -- Float#, Double#
    | Type -> Type -> Bool
aeqType Type
ty Type
doublePrimTy     = Int -> Int
biasBy Int
3
    | Type -> Type -> Bool
aeqType Type
ty Type
charPrimTy       = Int -> Int
biasBy Int
2  -- Char#, ByteArray#, Addr#
    | Type -> Type -> Bool
aeqType Type
ty Type
byteArrayPrimTy  = Int -> Int
biasBy Int
2
    | Type -> Type -> Bool
aeqType Type
ty Type
stringPrimTy     = Int -> Int
biasBy Int
2
#if !MIN_VERSION_base(4,16,0)
    | Type -> Type -> Bool
aeqType Type
ty Type
voidPrimTy       = Int -> Int
biasBy Int
1  -- Void#
#endif

    | Bool
otherwise                   = Int
baseBias  -- Anything else is base
   where
    baseBias :: Int
baseBias = Int
10
    ty :: Type
ty       = TyConName -> Type
mkTyConTy (TyCon -> TyConName
tyConName TyCon
tc)

    biasBy :: Int -> Int
    biasBy :: Int -> Int
biasBy Int
n = Int
baseBias Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
n

  biasOf AlgTyCon{}         = Int
20 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
4 :: Int)
  biasOf PromotedDataCon{}  = Int
20 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
3 :: Int)
  biasOf FunTyCon{}         = Int
20 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
3 :: Int)