{-|
Module:         Day6
Description:    Generates lookup tables for "Day6"
-}
{-# LANGUAGE TemplateHaskell, TypeApplications #-}
module Day6Meta (mkLUT) where

import Data.Array (Array)
import Data.Array.IArray (IArray, (!), accumArray, bounds, elems, listArray, range)
import Data.Semigroup (stimes)
import Language.Haskell.TH.Syntax (lift)
import Language.Haskell.TH.Quote (QuasiQuoter(..))

newtype Matrix a e = Matrix (a (Int, Int) e)

instance (IArray a e, Num e) => Semigroup (Matrix a e) where
    Matrix a (Int, Int) e
x <> :: Matrix a e -> Matrix a e -> Matrix a e
<> Matrix a (Int, Int) e
y = a (Int, Int) e -> Matrix a e
forall (a :: * -> * -> *) e. a (Int, Int) e -> Matrix a e
Matrix (a (Int, Int) e -> Matrix a e) -> a (Int, Int) e -> Matrix a e
forall a b. (a -> b) -> a -> b
$ ((Int, Int), (Int, Int)) -> [e] -> a (Int, Int) e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray ((Int
i0, Int
j0), (Int
i1, Int
j1))
      [ [e] -> e
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([e] -> e) -> [e] -> e
forall a b. (a -> b) -> a -> b
$ (e -> e -> e) -> [e] -> [e] -> [e]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith e -> e -> e
forall a. Num a => a -> a -> a
(*) [a (Int, Int) e
x a (Int, Int) e -> (Int, Int) -> e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (Int
i, Int
k0) | Int
k0 <- (Int, Int) -> [Int]
forall a. Ix a => (a, a) -> [a]
range (Int
k00, Int
k01)] [a (Int, Int) e
y a (Int, Int) e -> (Int, Int) -> e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (Int
k1, Int
j) | Int
k1 <- (Int, Int) -> [Int]
forall a. Ix a => (a, a) -> [a]
range (Int
k10, Int
k11)]
      | (Int
i, Int
j) <- ((Int, Int), (Int, Int)) -> [(Int, Int)]
forall a. Ix a => (a, a) -> [a]
range ((Int
i0, Int
j0), (Int
i1, Int
j1))
      ] where
        ((Int
i0, Int
k00), (Int
i1, Int
k01)) = a (Int, Int) e -> ((Int, Int), (Int, Int))
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds a (Int, Int) e
x
        ((Int
k10, Int
j0), (Int
k11, Int
j1)) = a (Int, Int) e -> ((Int, Int), (Int, Int))
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds a (Int, Int) e
y

flatten :: (IArray a e, Num e) => Matrix a e -> a Int e
flatten :: Matrix a e -> a Int e
flatten (Matrix a (Int, Int) e
arr) = (Int, Int) -> [e] -> a Int e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
j0, Int
j1)
    [[e] -> e
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [a (Int, Int) e
arr a (Int, Int) e -> (Int, Int) -> e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (Int
i, Int
j) | Int
i <- (Int, Int) -> [Int]
forall a. Ix a => (a, a) -> [a]
range (Int
i0, Int
i1)] | Int
j <- (Int, Int) -> [Int]
forall a. Ix a => (a, a) -> [a]
range (Int
j0, Int
j1)] where
    ((Int
i0, Int
j0), (Int
i1, Int
j1)) = a (Int, Int) e -> ((Int, Int), (Int, Int))
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds a (Int, Int) e
arr

step :: Matrix Array Integer
step :: Matrix Array Integer
step = Array (Int, Int) Integer -> Matrix Array Integer
forall (a :: * -> * -> *) e. a (Int, Int) e -> Matrix a e
Matrix (Array (Int, Int) Integer -> Matrix Array Integer)
-> Array (Int, Int) Integer -> Matrix Array Integer
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer -> Integer)
-> Integer
-> ((Int, Int), (Int, Int))
-> [((Int, Int), Integer)]
-> Array (Int, Int) Integer
forall (a :: * -> * -> *) e i e'.
(IArray a e, Ix i) =>
(e -> e' -> e) -> e -> (i, i) -> [(i, e')] -> a i e
accumArray ((Integer -> Integer) -> Integer -> Integer -> Integer
forall a b. a -> b -> a
const Integer -> Integer
forall a. a -> a
id) Integer
0 ((Int
0, Int
0), (Int
8, Int
8)) ([((Int, Int), Integer)] -> Array (Int, Int) Integer)
-> [((Int, Int), Integer)] -> Array (Int, Int) Integer
forall a b. (a -> b) -> a -> b
$
    ((Int
6, Int
0), Integer
1) ((Int, Int), Integer)
-> [((Int, Int), Integer)] -> [((Int, Int), Integer)]
forall a. a -> [a] -> [a]
: ((Int
8, Int
0), Integer
1) ((Int, Int), Integer)
-> [((Int, Int), Integer)] -> [((Int, Int), Integer)]
forall a. a -> [a] -> [a]
: [((Int
i, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1), Integer
1) | Int
i <- [Int
0..Int
7]]

mkLUT :: QuasiQuoter
mkLUT :: QuasiQuoter
mkLUT = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
  { quoteExp :: String -> Q Exp
quoteExp = \String
times ->
        let lut :: Array Int Integer
lut = Matrix Array Integer -> Array Int Integer
forall (a :: * -> * -> *) e.
(IArray a e, Num e) =>
Matrix a e -> a Int e
flatten (Matrix Array Integer -> Array Int Integer)
-> Matrix Array Integer -> Array Int Integer
forall a b. (a -> b) -> a -> b
$ Int -> Matrix Array Integer -> Matrix Array Integer
forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes (String -> Int
forall a. Read a => String -> a
read @Int String
times) Matrix Array Integer
step
        in [| listArray $(lift $ bounds lut) $(lift $ elems lut) |]
  , quotePat :: String -> Q Pat
quotePat = String -> String -> Q Pat
forall a. HasCallStack => String -> a
error String
"unsupported"
  , quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall a. HasCallStack => String -> a
error String
"unsupported"
  , quoteDec :: String -> Q [Dec]
quoteDec = String -> String -> Q [Dec]
forall a. HasCallStack => String -> a
error String
"unsupported"
  }