{-# LANGUAGE ConstraintKinds          #-}
{-# LANGUAGE DataKinds                #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE KindSignatures           #-}
{-# LANGUAGE PolyKinds                #-}
{-# LANGUAGE ScopedTypeVariables      #-}
{-# LANGUAGE TypeApplications         #-}

-- | Re-exports of types and functions used by generated code
--
-- This exports all functionality required by the generated code, with the
-- exception of GHC generics (name clash with @large-records@ generics).
module Data.Record.Plugin.Runtime (
    -- * Prelude
    Int
  , error
    -- * Other base
  , Constraint
  , Proxy
  , Type
  , proxy
    -- * AnyArray
  , AnyArray
  , anyArrayFromList
  , anyArrayToList
  , anyArrayIndex
  , anyArrayUpdate
    -- * large-generics
  , Rep
  , Dict
  , anyArrayToRep
  , anyArrayFromRep
  , mkDicts
  , mkDict
  , mkStrictField
  , mkLazyField
  , mkMetadata
    -- ** wrappers
  , gcompare
  , geq
  , gshowsPrec
  , noInlineUnsafeCo
    -- ** ThroughLRGenerics
  , ThroughLRGenerics
  , wrapThroughLRGenerics
  , unwrapThroughLRGenerics
  ) where

import Prelude hiding (Int, error)
import qualified Prelude as Prelude

import Control.Monad (forM_)
import Data.Coerce (coerce)
import Data.Primitive.SmallArray
import GHC.Exts (Any)
import GHC.Stack (HasCallStack)
import GHC.TypeLits

import qualified Data.Foldable                    as Foldable
import qualified Data.Kind                        as Base
import qualified Data.Proxy                       as Base
import qualified Data.Record.Generic              as LR
import qualified Data.Record.Generic.Eq           as LR
import qualified Data.Record.Generic.GHC          as LR
import qualified Data.Record.Generic.Rep.Internal as LR
import qualified Data.Record.Generic.Show         as LR

{-------------------------------------------------------------------------------
  Prelude
-------------------------------------------------------------------------------}

type Int = Prelude.Int

error :: HasCallStack => String -> a
error :: forall a. HasCallStack => String -> a
error = String -> a
forall a. HasCallStack => String -> a
Prelude.error

{-------------------------------------------------------------------------------
  base
-------------------------------------------------------------------------------}

type Constraint = Base.Constraint
type Proxy      = Base.Proxy
type Type       = Base.Type

proxy :: forall k (a :: k). Proxy a
proxy :: forall k (a :: k). Proxy a
proxy = Proxy a
forall k (a :: k). Proxy a
Base.Proxy

{-------------------------------------------------------------------------------
  AnyArray
-------------------------------------------------------------------------------}

type AnyArray = SmallArray Any

anyArrayFromList :: [Any] -> AnyArray
anyArrayFromList :: [Any] -> AnyArray
anyArrayFromList = [Any] -> AnyArray
forall a. [a] -> SmallArray a
smallArrayFromList

anyArrayToList :: AnyArray -> [Any]
anyArrayToList :: AnyArray -> [Any]
anyArrayToList = AnyArray -> [Any]
forall a. SmallArray a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
Foldable.toList

anyArrayIndex :: AnyArray -> Int -> Any
anyArrayIndex :: AnyArray -> Int -> Any
anyArrayIndex = AnyArray -> Int -> Any
forall a. SmallArray a -> Int -> a
indexSmallArray

anyArrayUpdate :: AnyArray -> [(Int, Any)] -> AnyArray
anyArrayUpdate :: AnyArray -> [(Int, Any)] -> AnyArray
anyArrayUpdate AnyArray
v [(Int, Any)]
updates = (forall s. ST s (SmallMutableArray s Any)) -> AnyArray
forall a. (forall s. ST s (SmallMutableArray s a)) -> SmallArray a
runSmallArray (do
    SmallMutableArray s Any
v' <- AnyArray
-> Int -> Int -> ST s (SmallMutableArray (PrimState (ST s)) Any)
forall (m :: Type -> Type) a.
PrimMonad m =>
SmallArray a -> Int -> Int -> m (SmallMutableArray (PrimState m) a)
thawSmallArray AnyArray
v Int
0 (AnyArray -> Int
forall a. SmallArray a -> Int
sizeofSmallArray AnyArray
v)
    [(Int, Any)] -> ((Int, Any) -> ST s ()) -> ST s ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Int, Any)]
updates (\(Int
i, Any
a) -> SmallMutableArray (PrimState (ST s)) Any -> Int -> Any -> ST s ()
forall (m :: Type -> Type) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s Any
SmallMutableArray (PrimState (ST s)) Any
v' Int
i Any
a)
    SmallMutableArray s Any -> ST s (SmallMutableArray s Any)
forall a. a -> ST s a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SmallMutableArray s Any
v'
  )

{-------------------------------------------------------------------------------
  large-generics: utilities
-------------------------------------------------------------------------------}

anyArrayToRep :: AnyArray -> Rep LR.I a
anyArrayToRep :: forall a. AnyArray -> Rep I a
anyArrayToRep = AnyArray -> Rep I a
forall a b. Coercible a b => a -> b
coerce

anyArrayFromRep :: Rep LR.I a -> AnyArray
anyArrayFromRep :: forall a. Rep I a -> AnyArray
anyArrayFromRep = Rep I a -> AnyArray
forall a b. Coercible a b => a -> b
coerce

mkDicts :: [Dict c Any] -> Rep (Dict c) a
mkDicts :: forall (c :: Type -> Constraint) a. [Dict c Any] -> Rep (Dict c) a
mkDicts [Dict c Any]
ds = SmallArray (Dict c Any) -> Rep (Dict c) a
forall (f :: Type -> Type) a. SmallArray (f Any) -> Rep f a
LR.Rep ([Dict c Any] -> SmallArray (Dict c Any)
forall a. [a] -> SmallArray a
smallArrayFromList [Dict c Any]
ds)

mkDict :: c x => Proxy c -> Proxy x -> Dict c x
mkDict :: forall {k} (c :: k -> Constraint) (x :: k).
c x =>
Proxy c -> Proxy x -> Dict c x
mkDict Proxy c
_ Proxy x
_ = Dict c x
forall {k} (c :: k -> Constraint) (a :: k). c a => Dict c a
LR.Dict

mkStrictField :: forall name a.
     KnownSymbol name
  => Proxy name -> LR.FieldMetadata a
mkStrictField :: forall (name :: Symbol) a.
KnownSymbol name =>
Proxy name -> FieldMetadata a
mkStrictField Proxy name
_ = Proxy name -> FieldStrictness -> FieldMetadata a
forall (name :: Symbol) x.
KnownSymbol name =>
Proxy name -> FieldStrictness -> FieldMetadata x
LR.FieldMetadata (forall k (a :: k). Proxy a
forall (t :: Symbol). Proxy t
Base.Proxy @name) FieldStrictness
LR.FieldStrict

mkLazyField :: forall name a.
     KnownSymbol name
  => Proxy name -> LR.FieldMetadata a
mkLazyField :: forall (name :: Symbol) a.
KnownSymbol name =>
Proxy name -> FieldMetadata a
mkLazyField Proxy name
_ = Proxy name -> FieldStrictness -> FieldMetadata a
forall (name :: Symbol) x.
KnownSymbol name =>
Proxy name -> FieldStrictness -> FieldMetadata x
LR.FieldMetadata (forall k (a :: k). Proxy a
forall (t :: Symbol). Proxy t
Base.Proxy @name) FieldStrictness
LR.FieldLazy

mkMetadata ::
     String  -- ^ Record name
  -> String  -- ^ Constructor name
  -> [LR.FieldMetadata Any]
  -> LR.Metadata a
mkMetadata :: forall a. String -> String -> [FieldMetadata Any] -> Metadata a
mkMetadata String
name String
constr [FieldMetadata Any]
fields = LR.Metadata {
      recordName :: String
recordName          = String
name
    , recordConstructor :: String
recordConstructor   = String
constr
    , recordSize :: Int
recordSize          = [FieldMetadata Any] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [FieldMetadata Any]
fields
    , recordFieldMetadata :: Rep FieldMetadata a
recordFieldMetadata = SmallArray (FieldMetadata Any) -> Rep FieldMetadata a
forall (f :: Type -> Type) a. SmallArray (f Any) -> Rep f a
LR.Rep ([FieldMetadata Any] -> SmallArray (FieldMetadata Any)
forall a. [a] -> SmallArray a
smallArrayFromList [FieldMetadata Any]
fields)
    }

{-------------------------------------------------------------------------------
  large-generics: wrappers
-------------------------------------------------------------------------------}

type Rep  = LR.Rep
type Dict = LR.Dict

gcompare :: (LR.Generic a, LR.Constraints a Ord) => a -> a -> Ordering
gcompare :: forall a. (Generic a, Constraints a Ord) => a -> a -> Ordering
gcompare = a -> a -> Ordering
forall a. (Generic a, Constraints a Ord) => a -> a -> Ordering
LR.gcompare

geq :: (LR.Generic a, LR.Constraints a Eq) => a -> a -> Bool
geq :: forall a. (Generic a, Constraints a Eq) => a -> a -> Bool
geq = a -> a -> Bool
forall a. (Generic a, Constraints a Eq) => a -> a -> Bool
LR.geq

gshowsPrec :: (LR.Generic a, LR.Constraints a Show) => Int -> a -> ShowS
gshowsPrec :: forall a. (Generic a, Constraints a Show) => Int -> a -> ShowS
gshowsPrec = Int -> a -> ShowS
forall a. (Generic a, Constraints a Show) => Int -> a -> ShowS
LR.gshowsPrec

noInlineUnsafeCo :: a -> b
noInlineUnsafeCo :: forall a b. a -> b
noInlineUnsafeCo = a -> b
forall a b. a -> b
LR.noInlineUnsafeCo

{-------------------------------------------------------------------------------
  large-generics: ThroughLRGenerics
-------------------------------------------------------------------------------}

type ThroughLRGenerics = LR.ThroughLRGenerics

wrapThroughLRGenerics :: a -> ThroughLRGenerics a p
wrapThroughLRGenerics :: forall a p. a -> ThroughLRGenerics a p
wrapThroughLRGenerics = a -> ThroughLRGenerics a p
forall a p. a -> ThroughLRGenerics a p
LR.WrapThroughLRGenerics

unwrapThroughLRGenerics :: ThroughLRGenerics a p -> a
unwrapThroughLRGenerics :: forall a p. ThroughLRGenerics a p -> a
unwrapThroughLRGenerics = ThroughLRGenerics a p -> a
forall a p. ThroughLRGenerics a p -> a
LR.unwrapThroughLRGenerics