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

module U.Codebase.Sqlite.Reference where

import U.Codebase.Reference (Id' (Id), Reference' (ReferenceBuiltin, ReferenceDerived))
import U.Codebase.Sqlite.DbId (HashId, ObjectId, TextId)
import U.Codebase.Sqlite.LocalIds (LocalDefnId, LocalHashId, LocalTextId)
import U.Codebase.Sqlite.Orphans ()
import U.Util.Base32Hex
import Unison.Prelude
import Unison.Sqlite (FromField, FromRow (fromRow), Only (..), RowParser, SQLData (SQLNull), ToField, ToRow (toRow), field)

type Reference = Reference' TextId ObjectId

type TermReference = Reference

type TypeReference = 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 TextReference = Reference' Text Base32Hex

type Id = Id' ObjectId

type TermReferenceId = Id

type TypeReferenceId = Id

type LocalReferenceH = Reference' LocalTextId LocalHashId

type LocalReference = Reference' LocalTextId LocalDefnId

type LocalId = Id' LocalDefnId

type ReferenceH = Reference' TextId HashId

type IdH = Id' HashId

instance ToRow (Reference' Text Base32Hex) where
  toRow :: Reference' Text Base32Hex -> [SQLData]
toRow = Reference' Text Base32Hex -> [SQLData]
forall t h. (ToField t, ToField h) => Reference' t h -> [SQLData]
referenceToRow

instance ToRow (Reference' TextId HashId) where
  toRow :: Reference' TextId HashId -> [SQLData]
toRow = Reference' TextId HashId -> [SQLData]
forall t h. (ToField t, ToField h) => Reference' t h -> [SQLData]
referenceToRow

instance ToRow Reference where
  toRow :: Reference -> [SQLData]
toRow = Reference -> [SQLData]
forall t h. (ToField t, ToField h) => Reference' t h -> [SQLData]
referenceToRow

referenceToRow :: (ToField t, ToField h) => Reference' t h -> [SQLData]
referenceToRow :: forall t h. (ToField t, ToField h) => Reference' t h -> [SQLData]
referenceToRow = \case
  ReferenceBuiltin t
t -> Only t -> [SQLData]
forall a. ToRow a => a -> [SQLData]
toRow (t -> Only t
forall a. a -> Only a
Only t
t) [SQLData] -> [SQLData] -> [SQLData]
forall a. [a] -> [a] -> [a]
++ [SQLData
SQLNull, SQLData
SQLNull]
  ReferenceDerived (Id h
h Pos
i) -> SQLData
SQLNull SQLData -> [SQLData] -> [SQLData]
forall a. a -> [a] -> [a]
: Only h -> [SQLData]
forall a. ToRow a => a -> [SQLData]
toRow (h -> Only h
forall a. a -> Only a
Only h
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)

instance FromRow (Reference' TextId HashId) where
  fromRow :: RowParser (Reference' TextId HashId)
fromRow = RowParser (Reference' TextId HashId)
forall t h.
(FromField t, FromField h, Show t, Show h) =>
RowParser (Reference' t h)
referenceFromRow'

instance FromRow (Reference) where
  fromRow :: RowParser Reference
fromRow = RowParser Reference
forall t h.
(FromField t, FromField h, Show t, Show h) =>
RowParser (Reference' t h)
referenceFromRow'

instance FromRow (Reference' Text Base32Hex) where
  fromRow :: RowParser (Reference' Text Base32Hex)
fromRow = RowParser (Reference' Text Base32Hex)
forall t h.
(FromField t, FromField h, Show t, Show h) =>
RowParser (Reference' t h)
referenceFromRow'

referenceFromRow' :: (FromField t, FromField h, Show t, Show h) => RowParser (Reference' t h)
referenceFromRow' :: forall t h.
(FromField t, FromField h, Show t, Show h) =>
RowParser (Reference' t h)
referenceFromRow' = (Maybe t -> Maybe h -> Maybe Pos -> Reference' t h)
-> RowParser (Maybe t)
-> RowParser (Maybe h)
-> RowParser (Maybe Pos)
-> RowParser (Reference' t h)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 Maybe t -> Maybe h -> Maybe Pos -> Reference' t h
forall {t} {h}.
(Show t, Show h) =>
Maybe t -> Maybe h -> Maybe Pos -> Reference' t h
mkRef RowParser (Maybe t)
forall a. FromField a => RowParser a
field RowParser (Maybe h)
forall a. FromField a => RowParser a
field RowParser (Maybe Pos)
forall a. FromField a => RowParser a
field
  where
    mkRef :: Maybe t -> Maybe h -> Maybe Pos -> Reference' t h
mkRef (Just t
t) Maybe h
Nothing Maybe Pos
Nothing =
      t -> Reference' t h
forall t h. t -> Reference' t h
ReferenceBuiltin t
t
    mkRef Maybe t
Nothing (Just h
h) (Just Pos
componentIdx) =
      Id' h -> Reference' t h
forall t h. Id' h -> Reference' t h
ReferenceDerived (h -> Pos -> Id' h
forall h. h -> Pos -> Id' h
Id h
h Pos
componentIdx)
    mkRef Maybe t
t Maybe h
h Maybe Pos
i =
      [Char] -> Reference' t h
forall a. HasCallStack => [Char] -> a
error ([Char] -> Reference' t h) -> [Char] -> Reference' t h
forall a b. (a -> b) -> a -> b
$ [Char]
"invalid find_type_index type reference: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
str
      where
        str :: [Char]
str = [Char]
"(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Maybe t -> [Char]
forall a. Show a => a -> [Char]
show Maybe t
t [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Maybe h -> [Char]
forall a. Show a => a -> [Char]
show Maybe h
h [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Maybe Pos -> [Char]
forall a. Show a => a -> [Char]
show Maybe Pos
i [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"

instance (ToField h) => ToRow (Id' h) where
  toRow :: Id' h -> [SQLData]
toRow = \case
    Id h
h Pos
i -> Only h -> [SQLData]
forall a. ToRow a => a -> [SQLData]
toRow (h -> Only h
forall a. a -> Only a
Only h
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)

instance (FromField h) => FromRow (Id' h) where
  fromRow :: RowParser (Id' h)
fromRow = h -> Pos -> Id' h
forall h. h -> Pos -> Id' h
Id (h -> Pos -> Id' h) -> RowParser h -> RowParser (Pos -> Id' h)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser h
forall a. FromField a => RowParser a
field RowParser (Pos -> Id' h) -> RowParser Pos -> RowParser (Id' h)
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Pos
forall a. FromField a => RowParser a
field