{-# 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 (
    -- * 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 Control.Monad (forM_)
import Data.Coerce (coerce)
import Data.Primitive.SmallArray
import GHC.Exts (Any)
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

{-------------------------------------------------------------------------------
  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 = forall k (a :: k). Proxy a
Base.Proxy

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

type AnyArray = SmallArray Any

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

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

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

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

anyArrayFromRep :: Rep LR.I a -> AnyArray
anyArrayFromRep :: forall a. Rep I a -> AnyArray
anyArrayFromRep = coerce :: 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 = forall (f :: Type -> Type) a. SmallArray (f Any) -> Rep f a
LR.Rep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> SmallArray a
smallArrayFromList

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
_ = 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
_ = forall (name :: Symbol) x.
KnownSymbol name =>
Proxy name -> FieldStrictness -> FieldMetadata x
LR.FieldMetadata (forall k (a :: k). Proxy a
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
_ = forall (name :: Symbol) x.
KnownSymbol name =>
Proxy name -> FieldStrictness -> FieldMetadata x
LR.FieldMetadata (forall k (a :: k). Proxy a
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          = forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [FieldMetadata Any]
fields
    , recordFieldMetadata :: Rep FieldMetadata a
recordFieldMetadata = forall (f :: Type -> Type) a. SmallArray (f Any) -> Rep f a
LR.Rep forall a b. (a -> b) -> a -> b
$ 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 = 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 = 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 = forall a. (Generic a, Constraints a Show) => Int -> a -> ShowS
LR.gshowsPrec

noInlineUnsafeCo :: a -> b
noInlineUnsafeCo :: forall a b. a -> b
noInlineUnsafeCo = 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 = forall a p. a -> ThroughLRGenerics a p
LR.WrapThroughLRGenerics

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