{-# LINE 1 "src/Data/Atlas/Internal.hsc" #-}
{-# language BangPatterns #-}
{-# language LambdaCase #-}
{-# language DeriveLift #-}
{-# language ViewPatterns #-}
{-# language ImplicitParams #-}
{-# language RecordWildCards #-}
{-# language OverloadedStrings #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneDeriving #-}
{-# language UndecidableInstances #-}
{-# language MultiParamTypeClasses #-}
{-# language StrictData #-}
{-# language FunctionalDependencies #-}
{-# language TemplateHaskell #-}
{-# language MultiWayIf #-}
{-# language FlexibleInstances #-}

-- |
-- Copyright :  (c) 2019 Edward Kmett
-- License   :  BSD-2-Clause OR Apache-2.0
-- Maintainer:  Edward Kmett <ekmett@gmail.com>
-- Stability :  experimental
-- Portability: non-portable
--
-- Details of the implementation.
--
-- The contents of this module do not fall under the PVP. Use at your own risk.


{-# LINE 30 "src/Data/Atlas/Internal.hsc" #-}


{-# LINE 32 "src/Data/Atlas/Internal.hsc" #-}

module Data.Atlas.Internal
( Atlas(..)
, AtlasContext
, Coord
, Rect
, Node
, heuristicId, Heuristic(..)
, sizeOfAtlas
, sizeOfNode
, sizeOfRect
, Pt(..)
, peekWH, peekXY
, pokeWH, peekMaybeXY
, atlasCtx
, die
) where

import Control.Exception
import Control.Monad.IO.Class
import Data.Coerce
import Data.Default
import Data.Functor ((<&>))
import qualified Data.Map as Map
import Data.Word
import Data.Int
import Foreign.C.Types
import Foreign.ForeignPtr
import Foreign.Ptr
import Foreign.Storable
import GHC.Arr
import GHC.Exception
import GHC.Stack
import qualified Language.C.Inline as C
import qualified Language.C.Inline.Context as C
import qualified Language.C.Inline.HaskellIdentifier as C
import qualified Language.C.Types as C
import qualified Language.Haskell.TH as TH
import qualified Language.Haskell.TH.Syntax as TH

type Coord = Word16
data Node
data Rect
data AtlasContext

newtype Atlas s = Atlas (ForeignPtr AtlasContext) deriving (Eq,Ord,Show)

die :: (MonadIO m, HasCallStack) => String -> m a
die msg = liftIO $ throwIO (errorCallWithCallStackException msg ?callStack)

getHsVariable :: HasCallStack => C.HaskellIdentifier -> TH.ExpQ
getHsVariable s = TH.lookupValueName (C.unHaskellIdentifier s) >>= \ case
  Nothing -> die $ "Cannot capture Haskell variable " ++ C.unHaskellIdentifier s ++ ", because it's not in scope."
  Just hsName -> TH.varE hsName

anti :: HasCallStack => C.Type C.CIdentifier -> TH.TypeQ -> TH.ExpQ -> C.SomeAntiQuoter
anti cTy hsTyQ w = C.SomeAntiQuoter C.AntiQuoter
  { C.aqParser = C.parseIdentifier <&> \hId -> (C.mangleHaskellIdentifier False hId, cTy, hId)
  , C.aqMarshaller = \_ _ _ cId -> (,) <$> hsTyQ <*> [|$w (coerce $(getHsVariable cId))|]
  }

atlasCtx :: C.Context
atlasCtx = mempty
  { C.ctxTypesTable = Map.fromList
    [ (C.TypeName "stbrp_context", [t|AtlasContext|])
    , (C.TypeName "stbrp_rect",    [t|Rect|])
    ]
  , C.ctxAntiQuoters = Map.fromList
    [ ("atlas"
      , anti
          (C.Ptr [] $ C.TypeSpecifier mempty $ C.TypeName "stbrp_context")
          [t|Ptr AtlasContext|]
          [|withForeignPtr|]
      )
    ]
  }

data Heuristic
  = BottomLeft -- ^ bottom-left sort-height
  | BestFirst -- ^ best first sort-height
  deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,TH.Lift)

instance Default Heuristic where
  def = BottomLeft
  {-# inline def #-}

-- | Use and cast back and forth to ints instead for more natural API?
data Pt = Pt Int Int deriving (Eq,Ord,Show,Read,TH.Lift)

instance Num Pt where
  Pt a b + Pt c d = Pt (a + c) (b + d)
  Pt a b - Pt c d = Pt (a - c) (b - d)
  Pt a b * Pt c d = Pt (a * c) (b * d)
  abs (Pt a b) = Pt (abs a) (abs b)
  signum (Pt a b) = Pt (signum a) (signum b)
  negate (Pt a b) = Pt (negate a) (negate b)
  fromInteger n = Pt (fromInteger n) (fromInteger n)
  {-# inline (+) #-}
  {-# inline (-) #-}
  {-# inline (*) #-}
  {-# inline abs #-}
  {-# inline signum #-}
  {-# inline negate #-}
  {-# inline fromInteger #-}


{-# LINE 138 "src/Data/Atlas/Internal.hsc" #-}

heuristicId :: Heuristic -> CInt
heuristicId BottomLeft = 0
{-# LINE 141 "src/Data/Atlas/Internal.hsc" #-}
heuristicId BestFirst  = 1
{-# LINE 142 "src/Data/Atlas/Internal.hsc" #-}
{-# inline heuristicId #-}

sizeOfAtlas :: Int
sizeOfAtlas = (72)
{-# LINE 146 "src/Data/Atlas/Internal.hsc" #-}
{-# inline sizeOfAtlas #-}

sizeOfNode :: Int
sizeOfNode = (16)
{-# LINE 150 "src/Data/Atlas/Internal.hsc" #-}
{-# inline sizeOfNode #-}

sizeOfRect :: Int
sizeOfRect = (16)
{-# LINE 154 "src/Data/Atlas/Internal.hsc" #-}
{-# inline sizeOfRect #-}

peekWH :: Ptr Rect -> IO Pt
peekWH p = (\(w :: Coord) (h :: Coord) -> Pt (fromIntegral w) (fromIntegral h))
  <$> ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p
{-# LINE 159 "src/Data/Atlas/Internal.hsc" #-}
  <*> ((\hsc_ptr -> peekByteOff hsc_ptr 6)) p
{-# LINE 160 "src/Data/Atlas/Internal.hsc" #-}
{-# inline peekWH #-}

pokeWH :: Ptr Rect -> Pt -> IO ()
pokeWH p (Pt w h) = do
  ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p (0 :: Int32)
{-# LINE 165 "src/Data/Atlas/Internal.hsc" #-}
  ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p (0 :: Coord)
{-# LINE 166 "src/Data/Atlas/Internal.hsc" #-}
  ((\hsc_ptr -> pokeByteOff hsc_ptr 10)) p (0 :: Coord)
{-# LINE 167 "src/Data/Atlas/Internal.hsc" #-}
  ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) p (fromIntegral w :: Coord)
{-# LINE 168 "src/Data/Atlas/Internal.hsc" #-}
  ((\hsc_ptr -> pokeByteOff hsc_ptr 6)) p (fromIntegral h :: Coord)
{-# LINE 169 "src/Data/Atlas/Internal.hsc" #-}
  ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) p (0 :: Int32)
{-# LINE 170 "src/Data/Atlas/Internal.hsc" #-}
{-# inline pokeWH #-}

peekXY :: Ptr Rect -> IO Pt
peekXY p = (\(w :: Coord) (h :: Coord) -> Pt (fromIntegral w) (fromIntegral h))
  <$> ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 175 "src/Data/Atlas/Internal.hsc" #-}
  <*> ((\hsc_ptr -> peekByteOff hsc_ptr 10)) p
{-# LINE 176 "src/Data/Atlas/Internal.hsc" #-}
{-# inline peekXY #-}

peekMaybeXY :: Ptr Rect -> IO (Maybe Pt)
peekMaybeXY p = ((\hsc_ptr -> peekByteOff hsc_ptr 12)) p >>= \case
{-# LINE 180 "src/Data/Atlas/Internal.hsc" #-}
  (0 :: Int32) -> pure Nothing
  _            -> Just <$> peekXY p
{-# inline peekMaybeXY #-}


{-# LINE 185 "src/Data/Atlas/Internal.hsc" #-}