{-
 - Copyright (C) 2019  Koz Ross <koz.ross@retro-freedom.nz>
 -
 - This program is free software: you can redistribute it and/or modify
 - it under the terms of the GNU General Public License as published by
 - the Free Software Foundation, either version 3 of the License, or
 - (at your option) any later version.
 -
 - This program is distributed in the hope that it will be useful,
 - but WITHOUT ANY WARRANTY; without even the implied warranty of
 - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 - GNU General Public License for more details.
 -
 - You should have received a copy of the GNU General Public License
 - along with this program.  If not, see <http://www.gnu.org/licenses/>.
 -}

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Data.Finitary.TH where

import Foreign.Storable (Storable, sizeOf)
import Language.Haskell.TH (Q, Type(..), TyLit(..), Exp(..), Lit(..))

charCardinality :: Q Type
charCardinality :: Q Type
charCardinality = Type -> Q Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Q Type) -> (Char -> Type) -> Char -> Q Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyLit -> Type
LitT (TyLit -> Type) -> (Char -> TyLit) -> Char -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> TyLit
NumTyLit (Integer -> TyLit) -> (Char -> Integer) -> Char -> TyLit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> (Char -> Int) -> Char -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Int) -> (Char -> Int) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum (Char -> Q Type) -> Char -> Q Type
forall a b. (a -> b) -> a -> b
$ Bounded Char => Char
forall a. Bounded a => a
maxBound @Char

cardinalityOf :: forall a . (Storable a) => Q Type
cardinalityOf :: Q Type
cardinalityOf = Type -> Q Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Q Type) -> (Integer -> Type) -> Integer -> Q Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyLit -> Type
LitT (TyLit -> Type) -> (Integer -> TyLit) -> Integer -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> TyLit
NumTyLit (Integer -> TyLit) -> (Integer -> Integer) -> Integer -> TyLit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product ([Integer] -> Integer)
-> (Integer -> [Integer]) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer -> [Integer]
forall a. Int -> a -> [a]
replicate (a -> Int
forall a. Storable a => a -> Int
sizeOf @a a
forall a. HasCallStack => a
undefined Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8) (Integer -> Q Type) -> Integer -> Q Type
forall a b. (a -> b) -> a -> b
$ Integer
2

adjustmentOf :: forall a . (Integral a, Bounded a) => Q Exp
adjustmentOf :: Q Exp
adjustmentOf = Exp -> Q Exp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> (a -> Exp) -> a -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lit -> Exp
LitE (Lit -> Exp) -> (a -> Lit) -> a -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Lit
IntegerL (Integer -> Lit) -> (a -> Integer) -> a -> Lit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) (Integer -> Integer) -> (a -> Integer) -> a -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integral a, Num Integer) => a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral @_ @Integer (a -> Q Exp) -> a -> Q Exp
forall a b. (a -> b) -> a -> b
$ Bounded a => a
forall a. Bounded a => a
maxBound @a