{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module U.Codebase.Sqlite.Referent where

import Control.Applicative (liftA3)
import U.Codebase.Reference qualified as Reference
import U.Codebase.Referent (Id', Referent')
import U.Codebase.Referent qualified as Referent
import U.Codebase.Sqlite.DbId (ObjectId)
import U.Codebase.Sqlite.Reference qualified as Sqlite
import Unison.Sqlite (FromRow (..), Only (..), SQLData (..), ToField (toField), ToRow (..), field)

type Referent = Referent' Sqlite.Reference Sqlite.Reference

-- | The name lookup table uses this because normalizing/denormalizing hashes to ids is slower
-- than we'd like when writing/reading the entire name lookup table.
type TextReferent = Referent' Sqlite.TextReference Sqlite.TextReference

type ReferentH = Referent' Sqlite.ReferenceH Sqlite.ReferenceH

type Id = Id' ObjectId ObjectId

type LocalReferent = Referent' Sqlite.LocalReference Sqlite.LocalReference

type LocalReferentH = Referent' Sqlite.LocalReferenceH Sqlite.LocalReferenceH

instance ToRow Id where
  toRow :: Id -> [SQLData]
toRow = \case
    Referent.RefId (Reference.Id ObjectId
h Pos
i) -> Only ObjectId -> [SQLData]
forall a. ToRow a => a -> [SQLData]
toRow (ObjectId -> Only ObjectId
forall a. a -> Only a
Only ObjectId
h) [SQLData] -> [SQLData] -> [SQLData]
forall a. [a] -> [a] -> [a]
++ Only Pos -> [SQLData]
forall a. ToRow a => a -> [SQLData]
toRow (Pos -> Only Pos
forall a. a -> Only a
Only Pos
i) [SQLData] -> [SQLData] -> [SQLData]
forall a. [a] -> [a] -> [a]
++ [SQLData
SQLNull]
    Referent.ConId (Reference.Id ObjectId
h Pos
i) Pos
cid -> Only ObjectId -> [SQLData]
forall a. ToRow a => a -> [SQLData]
toRow (ObjectId -> Only ObjectId
forall a. a -> Only a
Only ObjectId
h) [SQLData] -> [SQLData] -> [SQLData]
forall a. [a] -> [a] -> [a]
++ Only Pos -> [SQLData]
forall a. ToRow a => a -> [SQLData]
toRow (Pos -> Only Pos
forall a. a -> Only a
Only Pos
i) [SQLData] -> [SQLData] -> [SQLData]
forall a. [a] -> [a] -> [a]
++ Only Pos -> [SQLData]
forall a. ToRow a => a -> [SQLData]
toRow (Pos -> Only Pos
forall a. a -> Only a
Only Pos
cid)

instance FromRow Id where
  fromRow :: RowParser Id
fromRow = (ObjectId -> Pos -> Maybe Pos -> Id)
-> RowParser ObjectId
-> RowParser Pos
-> RowParser (Maybe Pos)
-> RowParser Id
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 ObjectId -> Pos -> Maybe Pos -> Id
forall {hTp}. hTp -> Pos -> Maybe Pos -> Id' hTp hTp
mkId RowParser ObjectId
forall a. FromField a => RowParser a
field RowParser Pos
forall a. FromField a => RowParser a
field RowParser (Maybe Pos)
forall a. FromField a => RowParser a
field
    where
      mkId :: hTp -> Pos -> Maybe Pos -> Id' hTp hTp
mkId hTp
h Pos
i Maybe Pos
mayCid = case Maybe Pos
mayCid of
        Maybe Pos
Nothing -> Id' hTp -> Id' hTp hTp
forall hTm hTp. Id' hTm -> Id' hTm hTp
Referent.RefId (hTp -> Pos -> Id' hTp
forall h. h -> Pos -> Id' h
Reference.Id hTp
h Pos
i)
        Just Pos
cid -> Id' hTp -> Pos -> Id' hTp hTp
forall hTm hTp. Id' hTp -> Pos -> Id' hTm hTp
Referent.ConId (hTp -> Pos -> Id' hTp
forall h. h -> Pos -> Id' h
Reference.Id hTp
h Pos
i) Pos
cid

instance (ToRow (Reference.Reference' t h)) => ToRow (Referent' (Reference.Reference' t h) (Reference.Reference' t h)) where
  toRow :: Referent' (Reference' t h) (Reference' t h) -> [SQLData]
toRow = \case
    Referent.Ref Reference' t h
ref -> Reference' t h -> [SQLData]
forall a. ToRow a => a -> [SQLData]
toRow Reference' t h
ref [SQLData] -> [SQLData] -> [SQLData]
forall a. Semigroup a => a -> a -> a
<> [SQLData
SQLNull]
    Referent.Con Reference' t h
ref Pos
conId -> Reference' t h -> [SQLData]
forall a. ToRow a => a -> [SQLData]
toRow Reference' t h
ref [SQLData] -> [SQLData] -> [SQLData]
forall a. Semigroup a => a -> a -> a
<> [Pos -> SQLData
forall a. ToField a => a -> SQLData
toField Pos
conId]

instance (FromRow (Reference.Reference' t h)) => FromRow (Referent' (Reference.Reference' t h) (Reference.Reference' t h)) where
  fromRow :: RowParser (Referent' (Reference' t h) (Reference' t h))
fromRow = do
    Reference' t h
ref <- RowParser (Reference' t h)
forall a. FromRow a => RowParser a
fromRow
    Maybe Pos
mayCid <- RowParser (Maybe Pos)
forall a. FromField a => RowParser a
field
    case Maybe Pos
mayCid of
      Maybe Pos
Nothing -> Referent' (Reference' t h) (Reference' t h)
-> RowParser (Referent' (Reference' t h) (Reference' t h))
forall a. a -> RowParser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Referent' (Reference' t h) (Reference' t h)
 -> RowParser (Referent' (Reference' t h) (Reference' t h)))
-> Referent' (Reference' t h) (Reference' t h)
-> RowParser (Referent' (Reference' t h) (Reference' t h))
forall a b. (a -> b) -> a -> b
$ Reference' t h -> Referent' (Reference' t h) (Reference' t h)
forall termRef typeRef. termRef -> Referent' termRef typeRef
Referent.Ref Reference' t h
ref
      Just Pos
cid -> Referent' (Reference' t h) (Reference' t h)
-> RowParser (Referent' (Reference' t h) (Reference' t h))
forall a. a -> RowParser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Referent' (Reference' t h) (Reference' t h)
 -> RowParser (Referent' (Reference' t h) (Reference' t h)))
-> Referent' (Reference' t h) (Reference' t h)
-> RowParser (Referent' (Reference' t h) (Reference' t h))
forall a b. (a -> b) -> a -> b
$ Reference' t h
-> Pos -> Referent' (Reference' t h) (Reference' t h)
forall termRef typeRef. typeRef -> Pos -> Referent' termRef typeRef
Referent.Con Reference' t h
ref Pos
cid