module U.Codebase.Sqlite.NamedRef where

import Data.List.NonEmpty qualified as NEL
import Data.List.NonEmpty qualified as NonEmpty
import Data.Text qualified as Text
import U.Codebase.Sqlite.NameLookups (ReversedName)
import Unison.Prelude
import Unison.Sqlite

data ConstructorType
  = DataConstructor
  | EffectConstructor

instance ToField (ConstructorType) where
  toField :: ConstructorType -> SQLData
toField ConstructorType
ct = case ConstructorType
ct of
    ConstructorType
DataConstructor -> (Int64 -> SQLData
SQLInteger Int64
0)
    ConstructorType
EffectConstructor -> (Int64 -> SQLData
SQLInteger Int64
1)

instance FromField (ConstructorType) where
  fromField :: FieldParser ConstructorType
fromField Field
f =
    forall a. FromField a => FieldParser a
fromField @Int Field
f Ok Int -> (Int -> Ok ConstructorType) -> Ok ConstructorType
forall a b. Ok a -> (a -> Ok b) -> Ok b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Int
0 -> ConstructorType -> Ok ConstructorType
forall a. a -> Ok a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConstructorType
DataConstructor
      Int
1 -> ConstructorType -> Ok ConstructorType
forall a. a -> Ok a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConstructorType
EffectConstructor
      Int
_ -> String -> Ok ConstructorType
forall a. String -> Ok a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid ConstructorType"

data NamedRef ref = NamedRef {forall ref. NamedRef ref -> ReversedName
reversedSegments :: ReversedName, forall ref. NamedRef ref -> ref
ref :: ref}
  deriving stock (Int -> NamedRef ref -> ShowS
[NamedRef ref] -> ShowS
NamedRef ref -> String
(Int -> NamedRef ref -> ShowS)
-> (NamedRef ref -> String)
-> ([NamedRef ref] -> ShowS)
-> Show (NamedRef ref)
forall ref. Show ref => Int -> NamedRef ref -> ShowS
forall ref. Show ref => [NamedRef ref] -> ShowS
forall ref. Show ref => NamedRef ref -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall ref. Show ref => Int -> NamedRef ref -> ShowS
showsPrec :: Int -> NamedRef ref -> ShowS
$cshow :: forall ref. Show ref => NamedRef ref -> String
show :: NamedRef ref -> String
$cshowList :: forall ref. Show ref => [NamedRef ref] -> ShowS
showList :: [NamedRef ref] -> ShowS
Show, (forall a b. (a -> b) -> NamedRef a -> NamedRef b)
-> (forall a b. a -> NamedRef b -> NamedRef a) -> Functor NamedRef
forall a b. a -> NamedRef b -> NamedRef a
forall a b. (a -> b) -> NamedRef a -> NamedRef b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> NamedRef a -> NamedRef b
fmap :: forall a b. (a -> b) -> NamedRef a -> NamedRef b
$c<$ :: forall a b. a -> NamedRef b -> NamedRef a
<$ :: forall a b. a -> NamedRef b -> NamedRef a
Functor, (forall m. Monoid m => NamedRef m -> m)
-> (forall m a. Monoid m => (a -> m) -> NamedRef a -> m)
-> (forall m a. Monoid m => (a -> m) -> NamedRef a -> m)
-> (forall a b. (a -> b -> b) -> b -> NamedRef a -> b)
-> (forall a b. (a -> b -> b) -> b -> NamedRef a -> b)
-> (forall b a. (b -> a -> b) -> b -> NamedRef a -> b)
-> (forall b a. (b -> a -> b) -> b -> NamedRef a -> b)
-> (forall a. (a -> a -> a) -> NamedRef a -> a)
-> (forall a. (a -> a -> a) -> NamedRef a -> a)
-> (forall a. NamedRef a -> [a])
-> (forall a. NamedRef a -> Bool)
-> (forall a. NamedRef a -> Int)
-> (forall a. Eq a => a -> NamedRef a -> Bool)
-> (forall a. Ord a => NamedRef a -> a)
-> (forall a. Ord a => NamedRef a -> a)
-> (forall a. Num a => NamedRef a -> a)
-> (forall a. Num a => NamedRef a -> a)
-> Foldable NamedRef
forall a. Eq a => a -> NamedRef a -> Bool
forall a. Num a => NamedRef a -> a
forall a. Ord a => NamedRef a -> a
forall m. Monoid m => NamedRef m -> m
forall a. NamedRef a -> Bool
forall a. NamedRef a -> Int
forall a. NamedRef a -> [a]
forall a. (a -> a -> a) -> NamedRef a -> a
forall m a. Monoid m => (a -> m) -> NamedRef a -> m
forall b a. (b -> a -> b) -> b -> NamedRef a -> b
forall a b. (a -> b -> b) -> b -> NamedRef a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => NamedRef m -> m
fold :: forall m. Monoid m => NamedRef m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> NamedRef a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> NamedRef a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> NamedRef a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> NamedRef a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> NamedRef a -> b
foldr :: forall a b. (a -> b -> b) -> b -> NamedRef a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> NamedRef a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> NamedRef a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> NamedRef a -> b
foldl :: forall b a. (b -> a -> b) -> b -> NamedRef a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> NamedRef a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> NamedRef a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> NamedRef a -> a
foldr1 :: forall a. (a -> a -> a) -> NamedRef a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> NamedRef a -> a
foldl1 :: forall a. (a -> a -> a) -> NamedRef a -> a
$ctoList :: forall a. NamedRef a -> [a]
toList :: forall a. NamedRef a -> [a]
$cnull :: forall a. NamedRef a -> Bool
null :: forall a. NamedRef a -> Bool
$clength :: forall a. NamedRef a -> Int
length :: forall a. NamedRef a -> Int
$celem :: forall a. Eq a => a -> NamedRef a -> Bool
elem :: forall a. Eq a => a -> NamedRef a -> Bool
$cmaximum :: forall a. Ord a => NamedRef a -> a
maximum :: forall a. Ord a => NamedRef a -> a
$cminimum :: forall a. Ord a => NamedRef a -> a
minimum :: forall a. Ord a => NamedRef a -> a
$csum :: forall a. Num a => NamedRef a -> a
sum :: forall a. Num a => NamedRef a -> a
$cproduct :: forall a. Num a => NamedRef a -> a
product :: forall a. Num a => NamedRef a -> a
Foldable, Functor NamedRef
Foldable NamedRef
(Functor NamedRef, Foldable NamedRef) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> NamedRef a -> f (NamedRef b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    NamedRef (f a) -> f (NamedRef a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> NamedRef a -> m (NamedRef b))
-> (forall (m :: * -> *) a.
    Monad m =>
    NamedRef (m a) -> m (NamedRef a))
-> Traversable NamedRef
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => NamedRef (m a) -> m (NamedRef a)
forall (f :: * -> *) a.
Applicative f =>
NamedRef (f a) -> f (NamedRef a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NamedRef a -> m (NamedRef b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NamedRef a -> f (NamedRef b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NamedRef a -> f (NamedRef b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NamedRef a -> f (NamedRef b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
NamedRef (f a) -> f (NamedRef a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
NamedRef (f a) -> f (NamedRef a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NamedRef a -> m (NamedRef b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NamedRef a -> m (NamedRef b)
$csequence :: forall (m :: * -> *) a. Monad m => NamedRef (m a) -> m (NamedRef a)
sequence :: forall (m :: * -> *) a. Monad m => NamedRef (m a) -> m (NamedRef a)
Traversable)

instance (ToRow ref) => ToRow (NamedRef ref) where
  toRow :: NamedRef ref -> [SQLData]
toRow (NamedRef {$sel:reversedSegments:NamedRef :: forall ref. NamedRef ref -> ReversedName
reversedSegments = ReversedName
segments, ref
$sel:ref:NamedRef :: forall ref. NamedRef ref -> ref
ref :: ref
ref}) =
    [Text -> SQLData
forall a. ToField a => a -> SQLData
toField Text
reversedName] [SQLData] -> [SQLData] -> [SQLData]
forall a. Semigroup a => a -> a -> a
<> ref -> [SQLData]
forall a. ToRow a => a -> [SQLData]
toRow ref
ref
    where
      reversedName :: Text
reversedName =
        ReversedName
segments
          ReversedName -> (ReversedName -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& forall target source. From source target => source -> target
into @[Text]
          [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
"."
          Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".") -- Add trailing dot, see notes on scoped_term_name_lookup schema

instance (FromRow ref) => FromRow (NamedRef ref) where
  fromRow :: RowParser (NamedRef ref)
fromRow = do
    ReversedName
reversedSegments <-
      RowParser Text
forall a. FromField a => RowParser a
field RowParser Text -> (Text -> ReversedName) -> RowParser ReversedName
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Text
f ->
        Text
f
          Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& HasCallStack => Text -> Text
Text -> Text
Text.init -- Drop trailing dot, see notes on scoped_term_name_lookup schema
          Text -> (Text -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
Text.splitOn Text
"."
          [Text] -> ([Text] -> NonEmpty Text) -> NonEmpty Text
forall a b. a -> (a -> b) -> b
& [Text] -> NonEmpty Text
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList
          NonEmpty Text -> (NonEmpty Text -> ReversedName) -> ReversedName
forall a b. a -> (a -> b) -> b
& forall target source. From source target => source -> target
into @ReversedName
    ref
ref <- RowParser ref
forall a. FromRow a => RowParser a
fromRow
    pure (NamedRef {ReversedName
$sel:reversedSegments:NamedRef :: ReversedName
reversedSegments :: ReversedName
reversedSegments, ref
$sel:ref:NamedRef :: ref
ref :: ref
ref})

-- | The new 'scoped' name lookup format is different from the old version.
--
-- Specifically, the scoped format adds the 'lastNameSegment' as well as adding a trailing '.' to the db format
-- of both the namespace and reversed_name.
--
-- This type has a ToRow instance of the form:
-- [reversedName, namespace, lastNameSegment] <> ref fields...
newtype ScopedRow ref
  = ScopedRow (NamedRef ref)

instance (ToRow ref) => ToRow (ScopedRow ref) where
  toRow :: ScopedRow ref -> [SQLData]
toRow (ScopedRow (NamedRef {$sel:reversedSegments:NamedRef :: forall ref. NamedRef ref -> ReversedName
reversedSegments = ReversedName
revSegments, ref
$sel:ref:NamedRef :: forall ref. NamedRef ref -> ref
ref :: ref
ref})) =
    Text -> SQLData
SQLText Text
reversedName SQLData -> [SQLData] -> [SQLData]
forall a. a -> [a] -> [a]
: Text -> SQLData
SQLText Text
namespace SQLData -> [SQLData] -> [SQLData]
forall a. a -> [a] -> [a]
: Text -> SQLData
SQLText Text
lastNameSegment SQLData -> [SQLData] -> [SQLData]
forall a. a -> [a] -> [a]
: ref -> [SQLData]
forall a. ToRow a => a -> [SQLData]
toRow ref
ref
    where
      reversedName :: Text
reversedName = (Text -> [Text] -> Text
Text.intercalate Text
"." ([Text] -> Text)
-> (ReversedName -> [Text]) -> ReversedName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall target source. From source target => source -> target
into @[Text] (ReversedName -> Text) -> ReversedName -> Text
forall a b. (a -> b) -> a -> b
$ ReversedName
revSegments) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
      namespace :: Text
namespace = (Text -> [Text] -> Text
Text.intercalate Text
"." ([Text] -> Text)
-> (ReversedName -> [Text]) -> ReversedName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text])
-> (ReversedName -> [Text]) -> ReversedName -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NEL.tail (NonEmpty Text -> [Text])
-> (ReversedName -> NonEmpty Text) -> ReversedName -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReversedName -> NonEmpty Text
forall source target. From source target => source -> target
from (ReversedName -> Text) -> ReversedName -> Text
forall a b. (a -> b) -> a -> b
$ ReversedName
revSegments) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
      lastNameSegment :: Text
lastNameSegment = NonEmpty Text -> Text
forall a. NonEmpty a -> a
NEL.head (NonEmpty Text -> Text)
-> (ReversedName -> NonEmpty Text) -> ReversedName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReversedName -> NonEmpty Text
forall source target. From source target => source -> target
from (ReversedName -> Text) -> ReversedName -> Text
forall a b. (a -> b) -> a -> b
$ ReversedName
revSegments