{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE NamedFieldPuns #-}

module Days.D08 where

import Common

import Data.ByteString.Char8 qualified as BS
import Data.ByteString.Unsafe qualified as BS
import Data.Int
import Data.Maybe (fromMaybe)
import Data.Vector.Storable qualified as VS
import Data.Vector.Storable.Mutable qualified as VSM
import Foreign qualified as F
import Foreign.C qualified as FT
import GHC.IO (unsafePerformIO)

foreign import ccall unsafe "analyze"
    cAnalyze ::
        -- | grid
        FT.CString ->
        -- | result_visible
        F.Ptr FT.CBool ->
        -- | result_fwd
        F.Ptr Int32 ->
        -- | result_bwd
        F.Ptr Int32 ->
        -- | h
        Int32 ->
        -- | w
        Int32 ->
        -- | x_stride
        Int32 ->
        -- | y_stride
        Int32 ->
        IO ()

analyzeHorizontal :: FT.CString -> F.Ptr FT.CBool -> F.Ptr Int32 -> F.Ptr Int32 -> Int32 -> Int32 -> IO ()
analyzeHorizontal grid vis fwd bwd h w = cAnalyze grid vis fwd bwd h w w 1

analyzeVertical :: FT.CString -> F.Ptr FT.CBool -> F.Ptr Int32 -> F.Ptr Int32 -> Int32 -> Int32 -> IO ()
analyzeVertical grid vis fwd bwd h w = cAnalyze grid vis fwd bwd h w 1 h

data Intermediate = Intermediate
    { h :: Int
    , w :: Int
    , v :: VS.Vector FT.CBool
    , u :: VS.Vector Int32
    , d :: VS.Vector Int32
    , l :: VS.Vector Int32
    , r :: VS.Vector Int32
    }
    deriving (Show)

process :: BS.ByteString -> Intermediate
process bs =
    let
        w = fromMaybe 0 (BS.elemIndex '\n' bs)
        h = (BS.length bs + 1) `div` (w + 1)
        grid = BS.filter (/= '\n') bs
        gridLen = h * w
     in
        unsafePerformIO $ do
            v <- VSM.new gridLen
            l <- VSM.unsafeNew gridLen
            r <- VSM.unsafeNew gridLen
            u <- VSM.unsafeNew gridLen
            d <- VSM.unsafeNew gridLen

            BS.unsafeUseAsCString
                grid
                ( \gridptr ->
                    VSM.unsafeWith
                        v
                        ( \vptr -> do
                            VSM.unsafeWith
                                l
                                ( \lptr ->
                                    VSM.unsafeWith
                                        r
                                        ( \rptr ->
                                            analyzeHorizontal
                                                gridptr
                                                vptr
                                                rptr
                                                lptr
                                                (fromIntegral h)
                                                (fromIntegral w)
                                        )
                                )
                            VSM.unsafeWith
                                d
                                ( \dptr ->
                                    VSM.unsafeWith
                                        u
                                        ( \uptr ->
                                            analyzeVertical
                                                gridptr
                                                vptr
                                                dptr
                                                uptr
                                                (fromIntegral h)
                                                (fromIntegral w)
                                        )
                                )
                        )
                )

            lf <- VS.unsafeFreeze l
            rf <- VS.unsafeFreeze r
            uf <- VS.unsafeFreeze u
            df <- VS.unsafeFreeze d
            vf <- VS.unsafeFreeze v

            return (Intermediate{h = h, w = w, u = uf, d = df, l = lf, r = rf, v = vf})

part1 :: Intermediate -> Int
part1 (Intermediate{v}) = VS.sum $ VS.map fromIntegral v

part2 :: Intermediate -> Int
part2 (Intermediate{u, d, l, r}) =
    fromIntegral
        . VS.maximum
        $ VS.zipWith4 (\a1 a2 a3 a4 -> a1 * a2 * a3 * a4) u d l r

day :: Day
day =
    ByteStringDay
        ( \bs ->
            let ffiResult = process bs
             in Right (definitive $ part1 ffiResult, definitive $ part2 ffiResult)
        )