{-# LANGUAGE DataKinds, EmptyDataDecls, FlexibleInstances              #-}
{-# LANGUAGE MultiParamTypeClasses, NoImplicitPrelude                  #-}
{-# LANGUAGE NoMonomorphismRestriction, PolyKinds, ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell, UndecidableInstances                     #-}
module Algebra.Field.Galois.Internal
       (ConwayPolynomial(..),
        Conway,
        buildInstance,
        parseLine
       ) where
import           Algebra.Field.Prime
import           Algebra.Prelude.Core               hiding (lex, lift)
import           Algebra.Ring.Polynomial.Univariate (Unipol)
import           Data.Char                          (isDigit)
import           Data.Char                          (digitToInt)
import           Data.Reflection
import qualified GHC.TypeLits                       as TL
import           Language.Haskell.TH
import           Language.Haskell.TH.Syntax         (lift)
import           Numeric                            (readInt)
import           Prelude                            (lex)

-- | Type-class to provide the dictionary for Conway polynomials
class ConwayPolynomial (p :: TL.Nat) (n :: TL.Nat) where
  conwayPolynomial :: proxy p -> proxy n -> Unipol (F p)

-- | Empty tag to reify Conway polynomial to type-level
data Conway p n

-- instance  {-# OVERLAPPABLE #-} (KnownNat p, KnownNat n) => ConwayPolynomial p n where
--   conwayPolynomial _ _ = undefined

instance (ConwayPolynomial p n) => Reifies (Conway p n) (Unipol (F p)) where
  reflect :: proxy (Conway p n) -> Unipol (F p)
reflect proxy (Conway p n)
_ = Proxy p -> Proxy n -> Unipol (F p)
forall (p :: Nat) (n :: Nat) (proxy :: Nat -> *).
ConwayPolynomial p n =>
proxy p -> proxy n -> Unipol (F p)
conwayPolynomial (Proxy p
forall k (t :: k). Proxy t
Proxy :: Proxy p) (Proxy n
forall k (t :: k). Proxy t
Proxy :: Proxy n)

parseLine :: String -> [(Integer, Integer, [Integer])]
parseLine :: String -> [(Integer, Integer, [Integer])]
parseLine (Char
'[':String
xs) =
  [(Integer
p,Integer
n,[Integer]
poly) | (String
f, Char
',':String
rest) <- ReadS String
lex String
xs
              , (Integer
p, String
"") <- Integer -> (Char -> Bool) -> (Char -> Int) -> ReadS Integer
forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
readInt Integer
10 Char -> Bool
isDigit Char -> Int
digitToInt String
f
              , (Integer
n, Char
',':String
ys) <- Integer -> (Char -> Bool) -> (Char -> Int) -> ReadS Integer
forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
readInt Integer
10 Char -> Bool
isDigit Char -> Int
digitToInt String
rest
              , ([Integer]
poly, String
_)    <- ReadS [Integer]
forall a. Read a => ReadS [a]
readList String
ys
              ]
parseLine String
_ = []

plusOp :: ExpQ -> ExpQ -> ExpQ
plusOp :: ExpQ -> ExpQ -> ExpQ
plusOp ExpQ
e = ExpQ -> ExpQ -> ExpQ -> ExpQ
infixApp ExpQ
e [| (+) |]

toPoly :: [Integer] -> ExpQ
toPoly :: [Integer] -> ExpQ
toPoly [Integer]
as =
  (ExpQ -> ExpQ -> ExpQ) -> [ExpQ] -> ExpQ
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 ExpQ -> ExpQ -> ExpQ
plusOp ([ExpQ] -> ExpQ) -> [ExpQ] -> ExpQ
forall a b. (a -> b) -> a -> b
$
  (Integer -> Integer -> ExpQ) -> [Integer] -> [Integer] -> [ExpQ]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Integer
i Integer
c -> [| injectCoeff (modNat $(litE $ integerL c)) * var 0 ^ $(lift i) |])
  [Integer
0 :: Integer ..] [Integer]
as

buildInstance :: (Integer, Integer, [Integer]) -> DecsQ
buildInstance :: (Integer, Integer, [Integer]) -> DecsQ
buildInstance (Integer
p,Integer
n,[Integer]
cs) =
  let tp :: TypeQ
tp = TyLitQ -> TypeQ
litT (TyLitQ -> TypeQ) -> TyLitQ -> TypeQ
forall a b. (a -> b) -> a -> b
$ Integer -> TyLitQ
numTyLit Integer
p
      tn :: TypeQ
tn = TyLitQ -> TypeQ
litT (TyLitQ -> TypeQ) -> TyLitQ -> TypeQ
forall a b. (a -> b) -> a -> b
$ Integer -> TyLitQ
numTyLit Integer
n
  in [d| instance {-# OVERLAPPING #-} ConwayPolynomial $tp $tn where
           conwayPolynomial _ _ = $(toPoly cs)
           {-# INLINE conwayPolynomial #-}
       |]