{-# LANGUAGE DataKinds, FlexibleInstances, LiberalTypeSynonyms            #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE MultiParamTypeClasses, TemplateHaskell, TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Algebra.Field.Galois.Conway
       (Conway,
        ConwayPolynomial(..),
        addConwayPolynomials,
        conwayFile) where
import Algebra.Field.Galois.Internal
import Algebra.Prelude.Core
import System.Directory
import Language.Haskell.TH           (runIO, DecsQ)

do dat <- tail . init . lines <$> runIO do
    fp : _ <- filterM doesFileExist 
      ["data/conway.txt", "halg-galois-fields/data/conway.txt"]
    readFile fp
   concat <$> mapM (buildInstance . head . parseLine) dat

-- | Macro to add Conway polynomials dictionary.
addConwayPolynomials :: [(Integer, Integer, [Integer])] -> DecsQ
addConwayPolynomials :: [(Integer, Integer, [Integer])] -> DecsQ
addConwayPolynomials = ([[Dec]] -> [Dec]) -> Q [[Dec]] -> DecsQ
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Dec]] -> [Dec]
forall w. Monoid w => [w] -> w
concat (Q [[Dec]] -> DecsQ)
-> ([(Integer, Integer, [Integer])] -> Q [[Dec]])
-> [(Integer, Integer, [Integer])]
-> DecsQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Integer, Integer, [Integer]) -> DecsQ)
-> [(Integer, Integer, [Integer])] -> Q [[Dec]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Integer, Integer, [Integer]) -> DecsQ
buildInstance

-- | Parse conway polynomial file and define instances for them.
--   File-format must be the same as
--   <http://www.math.rwth-aachen.de/~Frank.Luebeck/data/ConwayPol/index.html?LANG=en Lueback's file>.
conwayFile :: FilePath -> DecsQ
conwayFile :: FilePath -> DecsQ
conwayFile FilePath
fp = do
  [FilePath]
dat <- [FilePath] -> [FilePath]
forall a. [a] -> [a]
tail ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. [a] -> [a]
init ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines (FilePath -> [FilePath]) -> Q FilePath -> Q [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath -> Q FilePath
forall a. IO a -> Q a
runIO (FilePath -> IO FilePath
readFile FilePath
fp)
  [(Integer, Integer, [Integer])] -> DecsQ
addConwayPolynomials ([(Integer, Integer, [Integer])] -> DecsQ)
-> [(Integer, Integer, [Integer])] -> DecsQ
forall a b. (a -> b) -> a -> b
$ (FilePath -> [(Integer, Integer, [Integer])])
-> [FilePath] -> [(Integer, Integer, [Integer])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FilePath -> [(Integer, Integer, [Integer])]
parseLine [FilePath]
dat