module U.Codebase.Sqlite.Patch.TermEdit where

import Control.Lens
import Data.Bifoldable (Bifoldable (bifoldMap))
import Data.Bitraversable (Bitraversable (bitraverse))
import Data.Text (Text)
import U.Codebase.HashTags
import U.Codebase.Reference (Reference')
import U.Codebase.Reference qualified as Reference
import U.Codebase.Referent qualified as Referent
import U.Codebase.Sqlite.DbId qualified as Db
import U.Codebase.Sqlite.LocalIds (LocalDefnId, LocalTextId)

type TermEdit = TermEdit' Db.TextId Db.ObjectId

type HashTermEdit = TermEdit' Text ComponentHash

type LocalTermEdit = TermEdit' LocalTextId LocalDefnId

type Referent' t h = Referent.Referent' (Reference' t h) (Reference' t h)

data TermEdit' t h = Replace (Referent' t h) Typing | Deprecate
  deriving (TermEdit' t h -> TermEdit' t h -> Bool
(TermEdit' t h -> TermEdit' t h -> Bool)
-> (TermEdit' t h -> TermEdit' t h -> Bool) -> Eq (TermEdit' t h)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall t h. (Eq t, Eq h) => TermEdit' t h -> TermEdit' t h -> Bool
$c== :: forall t h. (Eq t, Eq h) => TermEdit' t h -> TermEdit' t h -> Bool
== :: TermEdit' t h -> TermEdit' t h -> Bool
$c/= :: forall t h. (Eq t, Eq h) => TermEdit' t h -> TermEdit' t h -> Bool
/= :: TermEdit' t h -> TermEdit' t h -> Bool
Eq, Eq (TermEdit' t h)
Eq (TermEdit' t h) =>
(TermEdit' t h -> TermEdit' t h -> Ordering)
-> (TermEdit' t h -> TermEdit' t h -> Bool)
-> (TermEdit' t h -> TermEdit' t h -> Bool)
-> (TermEdit' t h -> TermEdit' t h -> Bool)
-> (TermEdit' t h -> TermEdit' t h -> Bool)
-> (TermEdit' t h -> TermEdit' t h -> TermEdit' t h)
-> (TermEdit' t h -> TermEdit' t h -> TermEdit' t h)
-> Ord (TermEdit' t h)
TermEdit' t h -> TermEdit' t h -> Bool
TermEdit' t h -> TermEdit' t h -> Ordering
TermEdit' t h -> TermEdit' t h -> TermEdit' t h
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall t h. (Ord t, Ord h) => Eq (TermEdit' t h)
forall t h.
(Ord t, Ord h) =>
TermEdit' t h -> TermEdit' t h -> Bool
forall t h.
(Ord t, Ord h) =>
TermEdit' t h -> TermEdit' t h -> Ordering
forall t h.
(Ord t, Ord h) =>
TermEdit' t h -> TermEdit' t h -> TermEdit' t h
$ccompare :: forall t h.
(Ord t, Ord h) =>
TermEdit' t h -> TermEdit' t h -> Ordering
compare :: TermEdit' t h -> TermEdit' t h -> Ordering
$c< :: forall t h.
(Ord t, Ord h) =>
TermEdit' t h -> TermEdit' t h -> Bool
< :: TermEdit' t h -> TermEdit' t h -> Bool
$c<= :: forall t h.
(Ord t, Ord h) =>
TermEdit' t h -> TermEdit' t h -> Bool
<= :: TermEdit' t h -> TermEdit' t h -> Bool
$c> :: forall t h.
(Ord t, Ord h) =>
TermEdit' t h -> TermEdit' t h -> Bool
> :: TermEdit' t h -> TermEdit' t h -> Bool
$c>= :: forall t h.
(Ord t, Ord h) =>
TermEdit' t h -> TermEdit' t h -> Bool
>= :: TermEdit' t h -> TermEdit' t h -> Bool
$cmax :: forall t h.
(Ord t, Ord h) =>
TermEdit' t h -> TermEdit' t h -> TermEdit' t h
max :: TermEdit' t h -> TermEdit' t h -> TermEdit' t h
$cmin :: forall t h.
(Ord t, Ord h) =>
TermEdit' t h -> TermEdit' t h -> TermEdit' t h
min :: TermEdit' t h -> TermEdit' t h -> TermEdit' t h
Ord, Int -> TermEdit' t h -> ShowS
[TermEdit' t h] -> ShowS
TermEdit' t h -> String
(Int -> TermEdit' t h -> ShowS)
-> (TermEdit' t h -> String)
-> ([TermEdit' t h] -> ShowS)
-> Show (TermEdit' t h)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t h. (Show t, Show h) => Int -> TermEdit' t h -> ShowS
forall t h. (Show t, Show h) => [TermEdit' t h] -> ShowS
forall t h. (Show t, Show h) => TermEdit' t h -> String
$cshowsPrec :: forall t h. (Show t, Show h) => Int -> TermEdit' t h -> ShowS
showsPrec :: Int -> TermEdit' t h -> ShowS
$cshow :: forall t h. (Show t, Show h) => TermEdit' t h -> String
show :: TermEdit' t h -> String
$cshowList :: forall t h. (Show t, Show h) => [TermEdit' t h] -> ShowS
showList :: [TermEdit' t h] -> ShowS
Show)

instance Functor (TermEdit' t) where
  fmap :: (a -> b) -> TermEdit' t a -> TermEdit' t b
  fmap :: forall a b. (a -> b) -> TermEdit' t a -> TermEdit' t b
fmap a -> b
f (Replace (Referent.Ref Reference' t a
termRef) Typing
typing) = Referent' t b -> Typing -> TermEdit' t b
forall t h. Referent' t h -> Typing -> TermEdit' t h
Replace (Reference' t b -> Referent' t b
forall termRef typeRef. termRef -> Referent' termRef typeRef
Referent.Ref ((a -> b) -> Reference' t a -> Reference' t b
forall a b. (a -> b) -> Reference' t a -> Reference' t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Reference' t a
termRef)) Typing
typing
  fmap a -> b
f (Replace (Referent.Con Reference' t a
typeRef ConstructorId
consId) Typing
typing) = Referent' t b -> Typing -> TermEdit' t b
forall t h. Referent' t h -> Typing -> TermEdit' t h
Replace (Reference' t b -> ConstructorId -> Referent' t b
forall termRef typeRef.
typeRef -> ConstructorId -> Referent' termRef typeRef
Referent.Con ((a -> b) -> Reference' t a -> Reference' t b
forall a b. (a -> b) -> Reference' t a -> Reference' t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Reference' t a
typeRef) ConstructorId
consId) Typing
typing
  fmap a -> b
_ TermEdit' t a
Deprecate = TermEdit' t b
forall t h. TermEdit' t h
Deprecate

_Replace :: Prism (TermEdit' t h) (TermEdit' t' h') (Referent' t h, Typing) (Referent' t' h', Typing)
_Replace :: forall t h t' h' (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (Referent' t h, Typing) (f (Referent' t' h', Typing))
-> p (TermEdit' t h) (f (TermEdit' t' h'))
_Replace = ((Referent' t' h', Typing) -> TermEdit' t' h')
-> (TermEdit' t h
    -> Either (TermEdit' t' h') (Referent' t h, Typing))
-> Prism
     (TermEdit' t h)
     (TermEdit' t' h')
     (Referent' t h, Typing)
     (Referent' t' h', Typing)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (Referent' t' h', Typing) -> TermEdit' t' h'
forall t' h'. (Referent' t' h', Typing) -> TermEdit' t' h'
embed TermEdit' t h -> Either (TermEdit' t' h') (Referent' t h, Typing)
forall t h t' h'.
TermEdit' t h -> Either (TermEdit' t' h') (Referent' t h, Typing)
project
  where
    project :: TermEdit' t h -> Either (TermEdit' t' h') (Referent' t h, Typing)
    project :: forall t h t' h'.
TermEdit' t h -> Either (TermEdit' t' h') (Referent' t h, Typing)
project (Replace Referent' t h
ref Typing
typ) = (Referent' t h, Typing)
-> Either (TermEdit' t' h') (Referent' t h, Typing)
forall a b. b -> Either a b
Right (Referent' t h
ref, Typing
typ)
    project TermEdit' t h
Deprecate = TermEdit' t' h' -> Either (TermEdit' t' h') (Referent' t h, Typing)
forall a b. a -> Either a b
Left TermEdit' t' h'
forall t h. TermEdit' t h
Deprecate

    embed :: (Referent' t' h', Typing) -> TermEdit' t' h'
    embed :: forall t' h'. (Referent' t' h', Typing) -> TermEdit' t' h'
embed (Referent' t' h'
ref, Typing
typ) = Referent' t' h' -> Typing -> TermEdit' t' h'
forall t h. Referent' t h -> Typing -> TermEdit' t h
Replace Referent' t' h'
ref Typing
typ

h_ :: Traversal (TermEdit' t h) (TermEdit' t h') h h'
h_ :: forall t h h' (f :: * -> *).
Applicative f =>
(h -> f h') -> TermEdit' t h -> f (TermEdit' t h')
h_ h -> f h'
f = ((Referent' t h, Typing) -> f (Referent' t h', Typing))
-> TermEdit' t h -> f (TermEdit' t h')
forall t h t' h' (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (Referent' t h, Typing) (f (Referent' t' h', Typing))
-> p (TermEdit' t h) (f (TermEdit' t' h'))
_Replace (((Referent' t h, Typing) -> f (Referent' t h', Typing))
 -> TermEdit' t h -> f (TermEdit' t h'))
-> ((h -> f h')
    -> (Referent' t h, Typing) -> f (Referent' t h', Typing))
-> (h -> f h')
-> TermEdit' t h
-> f (TermEdit' t h')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Referent' t h -> f (Referent' t h'))
-> (Referent' t h, Typing) -> f (Referent' t h', Typing)
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Referent' t h, Typing)
  (Referent' t h', Typing)
  (Referent' t h)
  (Referent' t h')
_1 ((Referent' t h -> f (Referent' t h'))
 -> (Referent' t h, Typing) -> f (Referent' t h', Typing))
-> ((h -> f h') -> Referent' t h -> f (Referent' t h'))
-> (h -> f h')
-> (Referent' t h, Typing)
-> f (Referent' t h', Typing)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reference' t h -> f (Reference' t h'))
-> Referent' t h -> f (Referent' t h')
forall ref ref' (f :: * -> *).
Applicative f =>
(ref -> f ref') -> Referent' ref ref -> f (Referent' ref' ref')
Referent.refs_ ((Reference' t h -> f (Reference' t h'))
 -> Referent' t h -> f (Referent' t h'))
-> ((h -> f h') -> Reference' t h -> f (Reference' t h'))
-> (h -> f h')
-> Referent' t h
-> f (Referent' t h')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (h -> f h') -> Reference' t h -> f (Reference' t h')
forall t h h' (f :: * -> *).
Applicative f =>
(h -> f h') -> Reference' t h -> f (Reference' t h')
Reference.h_ ((h -> f h') -> TermEdit' t h -> f (TermEdit' t h'))
-> (h -> f h') -> TermEdit' t h -> f (TermEdit' t h')
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ h -> f h'
f

-- Replacements with the Same type can be automatically propagated.
-- Replacements with a Subtype can be automatically propagated but may result in dependents getting more general types, so requires re-inference.
-- Replacements of a Different type need to be manually propagated by the programmer.
data Typing = Same | Subtype | Different
  deriving (Typing -> Typing -> Bool
(Typing -> Typing -> Bool)
-> (Typing -> Typing -> Bool) -> Eq Typing
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Typing -> Typing -> Bool
== :: Typing -> Typing -> Bool
$c/= :: Typing -> Typing -> Bool
/= :: Typing -> Typing -> Bool
Eq, Eq Typing
Eq Typing =>
(Typing -> Typing -> Ordering)
-> (Typing -> Typing -> Bool)
-> (Typing -> Typing -> Bool)
-> (Typing -> Typing -> Bool)
-> (Typing -> Typing -> Bool)
-> (Typing -> Typing -> Typing)
-> (Typing -> Typing -> Typing)
-> Ord Typing
Typing -> Typing -> Bool
Typing -> Typing -> Ordering
Typing -> Typing -> Typing
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Typing -> Typing -> Ordering
compare :: Typing -> Typing -> Ordering
$c< :: Typing -> Typing -> Bool
< :: Typing -> Typing -> Bool
$c<= :: Typing -> Typing -> Bool
<= :: Typing -> Typing -> Bool
$c> :: Typing -> Typing -> Bool
> :: Typing -> Typing -> Bool
$c>= :: Typing -> Typing -> Bool
>= :: Typing -> Typing -> Bool
$cmax :: Typing -> Typing -> Typing
max :: Typing -> Typing -> Typing
$cmin :: Typing -> Typing -> Typing
min :: Typing -> Typing -> Typing
Ord, Int -> Typing -> ShowS
[Typing] -> ShowS
Typing -> String
(Int -> Typing -> ShowS)
-> (Typing -> String) -> ([Typing] -> ShowS) -> Show Typing
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Typing -> ShowS
showsPrec :: Int -> Typing -> ShowS
$cshow :: Typing -> String
show :: Typing -> String
$cshowList :: [Typing] -> ShowS
showList :: [Typing] -> ShowS
Show)

instance Bifunctor TermEdit' where
  bimap :: forall a b c d.
(a -> b) -> (c -> d) -> TermEdit' a c -> TermEdit' b d
bimap a -> b
f c -> d
g (Replace Referent' a c
r Typing
t) = Referent' b d -> Typing -> TermEdit' b d
forall t h. Referent' t h -> Typing -> TermEdit' t h
Replace ((Reference' a c -> Reference' b d)
-> (Reference' a c -> Reference' b d)
-> Referent' a c
-> Referent' b d
forall a b c d.
(a -> b) -> (c -> d) -> Referent' a c -> Referent' b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((a -> b) -> (c -> d) -> Reference' a c -> Reference' b d
forall a b c d.
(a -> b) -> (c -> d) -> Reference' a c -> Reference' b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f c -> d
g) ((a -> b) -> (c -> d) -> Reference' a c -> Reference' b d
forall a b c d.
(a -> b) -> (c -> d) -> Reference' a c -> Reference' b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f c -> d
g) Referent' a c
r) Typing
t
  bimap a -> b
_ c -> d
_ TermEdit' a c
Deprecate = TermEdit' b d
forall t h. TermEdit' t h
Deprecate

instance Bifoldable TermEdit' where
  bifoldMap :: forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> TermEdit' a b -> m
bifoldMap a -> m
f b -> m
g (Replace Referent' a b
r Typing
_t) = (Reference' a b -> m)
-> (Reference' a b -> m) -> Referent' a b -> m
forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> Referent' a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap ((a -> m) -> (b -> m) -> Reference' a b -> m
forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> Reference' a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
f b -> m
g) ((a -> m) -> (b -> m) -> Reference' a b -> m
forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> Reference' a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
f b -> m
g) Referent' a b
r
  bifoldMap a -> m
_ b -> m
_ TermEdit' a b
Deprecate = m
forall a. Monoid a => a
mempty

instance Bitraversable TermEdit' where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> TermEdit' a b -> f (TermEdit' c d)
bitraverse a -> f c
f b -> f d
g (Replace Referent' a b
r Typing
t) = Referent' c d -> Typing -> TermEdit' c d
forall t h. Referent' t h -> Typing -> TermEdit' t h
Replace (Referent' c d -> Typing -> TermEdit' c d)
-> f (Referent' c d) -> f (Typing -> TermEdit' c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Reference' a b -> f (Reference' c d))
-> (Reference' a b -> f (Reference' c d))
-> Referent' a b
-> f (Referent' c d)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Referent' a b -> f (Referent' c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse ((a -> f c) -> (b -> f d) -> Reference' a b -> f (Reference' c d)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Reference' a b -> f (Reference' c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f b -> f d
g) ((a -> f c) -> (b -> f d) -> Reference' a b -> f (Reference' c d)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Reference' a b -> f (Reference' c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f b -> f d
g) Referent' a b
r f (Typing -> TermEdit' c d) -> f Typing -> f (TermEdit' c d)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Typing -> f Typing
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Typing
t
  bitraverse a -> f c
_ b -> f d
_ TermEdit' a b
Deprecate = TermEdit' c d -> f (TermEdit' c d)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TermEdit' c d
forall t h. TermEdit' t h
Deprecate