{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeApplications #-}

module JRec
  ( unField,
    (:=) (..),
    FldProxy (..),
    Tup,
    pattern Tup,
    append,
    union,
    insert,
    insertOrSet,
    R.FromNative,
    R.recCopy,
    R.get,
    R.set,
    R.Has,
    R.fromNative,
    R.rnil,
    R.RemoveAccessTo,
    R.RecSize,
    R.RecCopy,
  )
where

import Data.Proxy
import GHC.Exts (Any)
import GHC.Generics
import GHC.OverloadedLabels
import GHC.Records
import GHC.TypeLits
import JRec.Internal (FldProxy (..), Tup, (:=) (..))
import JRec.Internal qualified as R
import JRec.Tuple
import Unsafe.Coerce

----------------------------------------------------------------------------
-- unField
----------------------------------------------------------------------------

unField :: (field ~ field') => R.FldProxy field -> (field' R.:= value) -> value
unField _ (_ R.:= value) = value

----------------------------------------------------------------------------
-- Other operations
----------------------------------------------------------------------------

-- Appends records, without removing duplicates.
--
-- O(n + m) type check complexity.
--
-- FIXME: See spec for a bug when there are duplicates.
append ::
  forall lhs rhs res.
  (res ~ R.RecAppend lhs rhs) =>
  Tup lhs ->
  Tup rhs ->
  Tup res
append = R.combine

-- Merges records, removing duplicates
--
-- Left-biased. Does not sort.
--
-- O(n * m) type check complexity.
union ::
  forall lhs rhs res.
  ( KnownNat (R.RecSize lhs),
    KnownNat (R.RecSize rhs),
    KnownNat (R.RecSize res),
    res ~ R.Union lhs rhs,
    R.RecCopy lhs lhs res,
    R.RecCopy rhs rhs res
  ) =>
  Tup lhs ->
  Tup rhs ->
  Tup res
union = R.union

-- | Insert a field into a record that does not already contain it
--
-- O(n) type check complexity.
insert ::
  forall label value lts res.
  ( KnownNat (1 + R.RecSize lts),
    KnownNat (R.RecSize lts),
    KnownSymbol label,
    R.RecCopy lts lts res,
    res ~ ((label := value) : lts),
    R.RemoveAccessTo label lts ~ lts
  ) =>
  label := value ->
  Tup lts ->
  Tup res
insert = R.combine . Tup

-- | Insert a field into a record. Set it if it already exists
--
-- O(n) type check complexity.
insertOrSet ::
  forall label value rhs res.
  ( KnownNat (R.RecSize rhs),
    KnownNat (R.RecSize res),
    KnownNat (R.RecTyIdxH 0 label res),
    KnownSymbol label,
    value ~ R.RecTy label res,
    R.Reverse (R.Insert (label := value) (R.Reverse rhs)) ~ res,
    R.RecCopy rhs rhs res
  ) =>
  label := value ->
  Tup rhs ->
  Tup res
insertOrSet = R.insert

----------------------------------------------------------------------------
-- Generic
----------------------------------------------------------------------------

type Sel name value = S1 ('MetaSel ('Just name) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 value)

type family Sels fields where
  Sels '[] = U1
  Sels '[name R.:= value] = Sel name value
  Sels ((name R.:= value) ': xs) = Sel name value :*: Sels xs

type RecordRep fields =
  D1
    ('MetaData "Record" "Rec" "" 'False)
    ( C1
        ('MetaCons "Record" 'PrefixI 'True)
        (Sels fields)
    )

-- instance (R.FromNative (RecordRep fields) fields, R.ToNative (RecordRep fields) fields) => Generic (Tup fields) where
--   type Rep (Tup fields) = RecordRep fields
--   from = R.toNative'
--   to = R.fromNative'

pattern Tup ::
  ( RecTuple tuple fields
  ) =>
  tuple ->
  Tup fields
pattern Tup a <-
  (toTuple -> a)
  where
    Tup = fromTuple