module Unison.Codebase.SqliteCodebase.Conversions where

import Control.Lens
import Data.Map qualified as Map
import Data.Set qualified as Set
import Data.Text (pack)
import U.Codebase.Branch qualified as V2.Branch
import U.Codebase.Causal qualified as V2
import U.Codebase.Decl qualified as V2.Decl
import U.Codebase.HashTags
import U.Codebase.Kind qualified as V2.Kind
import U.Codebase.Reference qualified as V2
import U.Codebase.Reference qualified as V2.Reference
import U.Codebase.Referent qualified as V2
import U.Codebase.Referent qualified as V2.Referent
import U.Codebase.Sqlite.Symbol qualified as V2
import U.Codebase.Term qualified as V2.Term
import U.Codebase.TermEdit qualified as V2.TermEdit
import U.Codebase.Type qualified as V2.Type
import U.Codebase.TypeEdit qualified as V2.TypeEdit
import U.Codebase.WatchKind qualified as V2
import U.Codebase.WatchKind qualified as V2.WatchKind
import U.Core.ABT qualified as ABT
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Branch qualified as V1.Branch
import Unison.Codebase.Causal.Type qualified as V1.Causal
import Unison.Codebase.Metadata qualified as V1.Metadata
import Unison.Codebase.Patch qualified as V1
import Unison.Codebase.ShortCausalHash qualified as V1
import Unison.Codebase.SqliteCodebase.Branch.Cache
import Unison.Codebase.TermEdit qualified as V1.TermEdit
import Unison.Codebase.TypeEdit qualified as V1.TypeEdit
import Unison.ConstructorReference qualified as V1 (GConstructorReference (..))
import Unison.ConstructorType qualified as CT
import Unison.DataDeclaration qualified as V1.Decl
import Unison.Hash (Hash)
import Unison.Hash qualified as Hash
import Unison.Hash qualified as V1
import Unison.Kind qualified as V1.Kind
import Unison.NameSegment (NameSegment)
import Unison.Parser.Ann (Ann)
import Unison.Parser.Ann qualified as Ann
import Unison.Pattern qualified as V1.Pattern
import Unison.Prelude
import Unison.Reference qualified as V1
import Unison.Reference qualified as V1.Reference
import Unison.Referent qualified as V1
import Unison.Referent qualified as V1.Referent
import Unison.ShortHash (ShortCausalHash (..), ShortHash)
import Unison.ShortHash qualified as ShortHash
import Unison.Symbol qualified as V1
import Unison.Term qualified as V1.Term
import Unison.Type qualified as V1.Type
import Unison.Util.Map qualified as Map
import Unison.Util.Relation qualified as Relation
import Unison.Util.Star2 qualified as V1.Star2
import Unison.Var qualified as Var
import Unison.WatchKind qualified as V1.WK

sch1to2 :: V1.ShortCausalHash -> ShortCausalHash
sch1to2 :: ShortCausalHash -> ShortCausalHash
sch1to2 (V1.ShortCausalHash Text
b32) = Text -> ShortCausalHash
ShortCausalHash Text
b32

decltype2to1 :: V2.Decl.DeclType -> CT.ConstructorType
decltype2to1 :: DeclType -> ConstructorType
decltype2to1 = \case
  DeclType
V2.Decl.Data -> ConstructorType
CT.Data
  DeclType
V2.Decl.Effect -> ConstructorType
CT.Effect

decltype1to2 :: CT.ConstructorType -> V2.Decl.DeclType
decltype1to2 :: ConstructorType -> DeclType
decltype1to2 = \case
  ConstructorType
CT.Data -> DeclType
V2.Decl.Data
  ConstructorType
CT.Effect -> DeclType
V2.Decl.Effect

watchKind1to2 :: V1.WK.WatchKind -> V2.WatchKind
watchKind1to2 :: [Char] -> WatchKind
watchKind1to2 = \case
  [Char]
V1.WK.RegularWatch -> WatchKind
V2.WatchKind.RegularWatch
  [Char]
V1.WK.TestWatch -> WatchKind
V2.WatchKind.TestWatch
  [Char]
other -> [Char] -> WatchKind
forall a. HasCallStack => [Char] -> a
error ([Char] -> WatchKind) -> [Char] -> WatchKind
forall a b. (a -> b) -> a -> b
$ [Char]
"What kind of watchkind is " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
other [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"?"

watchKind2to1 :: V2.WatchKind -> V1.WK.WatchKind
watchKind2to1 :: WatchKind -> [Char]
watchKind2to1 = \case
  WatchKind
V2.WatchKind.RegularWatch -> [Char]
forall a. (Eq a, IsString a) => a
V1.WK.RegularWatch
  WatchKind
V2.WatchKind.TestWatch -> [Char]
forall a. (Eq a, IsString a) => a
V1.WK.TestWatch

term1to2 :: Hash -> V1.Term.Term V1.Symbol Ann -> V2.Term.Term V2.Symbol
term1to2 :: Hash -> Term Symbol Ann -> Term Symbol
term1to2 Hash
h =
  (forall a1. F Symbol Ann Ann a1 -> F Symbol a1)
-> Term (F Symbol Ann Ann) Symbol () -> Term Symbol
forall v (g :: * -> *) (f :: * -> *) a.
(Ord v, Foldable g, Functor g) =>
(forall a1. f a1 -> g a1) -> Term f v a -> Term g v a
ABT.transform F Symbol Ann Ann a1 -> F Symbol a1
forall a1. F Symbol Ann Ann a1 -> F Symbol a1
termF1to2
    (Term (F Symbol Ann Ann) Symbol () -> Term Symbol)
-> (Term Symbol Ann -> Term (F Symbol Ann Ann) Symbol ())
-> Term Symbol Ann
-> Term Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Symbol -> Symbol)
-> Term (F Symbol Ann Ann) Symbol ()
-> Term (F Symbol Ann Ann) Symbol ()
forall (f :: * -> *) v' v a.
(Functor f, Foldable f, Ord v') =>
(v -> v') -> Term f v a -> Term f v' a
ABT.vmap Symbol -> Symbol
symbol1to2
    (Term (F Symbol Ann Ann) Symbol ()
 -> Term (F Symbol Ann Ann) Symbol ())
-> (Term Symbol Ann -> Term (F Symbol Ann Ann) Symbol ())
-> Term Symbol Ann
-> Term (F Symbol Ann Ann) Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ann -> ()) -> Term Symbol Ann -> Term (F Symbol Ann Ann) Symbol ()
forall (f :: * -> *) a a' v.
Functor f =>
(a -> a') -> Term f v a -> Term f v a'
ABT.amap (() -> Ann -> ()
forall a b. a -> b -> a
const ())
  where
    termF1to2 :: V1.Term.F V1.Symbol Ann Ann a -> V2.Term.F V2.Symbol a
    termF1to2 :: forall a1. F Symbol Ann Ann a1 -> F Symbol a1
termF1to2 = F Symbol Ann Ann a -> F Symbol a
forall a1. F Symbol Ann Ann a1 -> F Symbol a1
go

    go :: V1.Term.F V1.Symbol Ann Ann a -> V2.Term.F V2.Symbol a
    go :: forall a1. F Symbol Ann Ann a1 -> F Symbol a1
go = \case
      V1.Term.Int Int64
i -> Int64 -> F Symbol a
forall text termRef typeRef termLink typeLink vt a.
Int64 -> F' text termRef typeRef termLink typeLink vt a
V2.Term.Int Int64
i
      V1.Term.Nat Pos
n -> Pos -> F Symbol a
forall text termRef typeRef termLink typeLink vt a.
Pos -> F' text termRef typeRef termLink typeLink vt a
V2.Term.Nat Pos
n
      V1.Term.Float Double
f -> Double -> F Symbol a
forall text termRef typeRef termLink typeLink vt a.
Double -> F' text termRef typeRef termLink typeLink vt a
V2.Term.Float Double
f
      V1.Term.Boolean Bool
b -> Bool -> F Symbol a
forall text termRef typeRef termLink typeLink vt a.
Bool -> F' text termRef typeRef termLink typeLink vt a
V2.Term.Boolean Bool
b
      V1.Term.Text Text
t -> Text -> F Symbol a
forall text termRef typeRef termLink typeLink vt a.
text -> F' text termRef typeRef termLink typeLink vt a
V2.Term.Text Text
t
      V1.Term.Char Char
c -> Char -> F Symbol a
forall text termRef typeRef termLink typeLink vt a.
Char -> F' text termRef typeRef termLink typeLink vt a
V2.Term.Char Char
c
      V1.Term.Ref Reference
r -> TermRef -> F Symbol a
forall text termRef typeRef termLink typeLink vt a.
termRef -> F' text termRef typeRef termLink typeLink vt a
V2.Term.Ref (Hash -> Reference -> TermRef
rreference1to2 Hash
h Reference
r)
      V1.Term.Constructor (V1.ConstructorReference Reference
r Pos
i) -> Reference -> Pos -> F Symbol a
forall text termRef typeRef termLink typeLink vt a.
typeRef -> Pos -> F' text termRef typeRef termLink typeLink vt a
V2.Term.Constructor (Reference -> Reference
reference1to2 Reference
r) (Pos -> Pos
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pos
i)
      V1.Term.Request (V1.ConstructorReference Reference
r Pos
i) -> Reference -> Pos -> F Symbol a
forall text termRef typeRef termLink typeLink vt a.
typeRef -> Pos -> F' text termRef typeRef termLink typeLink vt a
V2.Term.Request (Reference -> Reference
reference1to2 Reference
r) (Pos -> Pos
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pos
i)
      V1.Term.Handle a
b a
h -> a -> a -> F Symbol a
forall text termRef typeRef termLink typeLink vt a.
a -> a -> F' text termRef typeRef termLink typeLink vt a
V2.Term.Handle a
b a
h
      V1.Term.App a
f a
a -> a -> a -> F Symbol a
forall text termRef typeRef termLink typeLink vt a.
a -> a -> F' text termRef typeRef termLink typeLink vt a
V2.Term.App a
f a
a
      V1.Term.Ann a
e Type Symbol Ann
t -> a -> TypeR Reference Symbol -> F Symbol a
forall text termRef typeRef termLink typeLink vt a.
a
-> TypeR typeRef vt
-> F' text termRef typeRef termLink typeLink vt a
V2.Term.Ann a
e (Type Symbol Ann -> TypeR Reference Symbol
forall a. Type Symbol a -> TypeR Reference Symbol
ttype1to2 Type Symbol Ann
t)
      V1.Term.List Seq a
as -> Seq a -> F Symbol a
forall text termRef typeRef termLink typeLink vt a.
Seq a -> F' text termRef typeRef termLink typeLink vt a
V2.Term.List Seq a
as
      V1.Term.If a
c a
t a
f -> a -> a -> a -> F Symbol a
forall text termRef typeRef termLink typeLink vt a.
a -> a -> a -> F' text termRef typeRef termLink typeLink vt a
V2.Term.If a
c a
t a
f
      V1.Term.And a
a a
b -> a -> a -> F Symbol a
forall text termRef typeRef termLink typeLink vt a.
a -> a -> F' text termRef typeRef termLink typeLink vt a
V2.Term.And a
a a
b
      V1.Term.Or a
a a
b -> a -> a -> F Symbol a
forall text termRef typeRef termLink typeLink vt a.
a -> a -> F' text termRef typeRef termLink typeLink vt a
V2.Term.Or a
a a
b
      V1.Term.Lam a
a -> a -> F Symbol a
forall text termRef typeRef termLink typeLink vt a.
a -> F' text termRef typeRef termLink typeLink vt a
V2.Term.Lam a
a
      V1.Term.LetRec Bool
_ [a]
bs a
body -> [a] -> a -> F Symbol a
forall text termRef typeRef termLink typeLink vt a.
[a] -> a -> F' text termRef typeRef termLink typeLink vt a
V2.Term.LetRec [a]
bs a
body
      V1.Term.Let Bool
_ a
b a
body -> a -> a -> F Symbol a
forall text termRef typeRef termLink typeLink vt a.
a -> a -> F' text termRef typeRef termLink typeLink vt a
V2.Term.Let a
b a
body
      V1.Term.Match a
e [MatchCase Ann a]
cases -> a -> [MatchCase Text Reference a] -> F Symbol a
forall text termRef typeRef termLink typeLink vt a.
a
-> [MatchCase text typeRef a]
-> F' text termRef typeRef termLink typeLink vt a
V2.Term.Match a
e (MatchCase Ann a -> MatchCase Text Reference a
forall {a} {a}. MatchCase a a -> MatchCase Text Reference a
goCase (MatchCase Ann a -> MatchCase Text Reference a)
-> [MatchCase Ann a] -> [MatchCase Text Reference a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [MatchCase Ann a]
cases)
      V1.Term.TermLink Referent
r -> TermLink -> F Symbol a
forall text termRef typeRef termLink typeLink vt a.
termLink -> F' text termRef typeRef termLink typeLink vt a
V2.Term.TermLink (Hash -> Referent -> TermLink
rreferent1to2 Hash
h Referent
r)
      V1.Term.TypeLink Reference
r -> Reference -> F Symbol a
forall text termRef typeRef termLink typeLink vt a.
typeLink -> F' text termRef typeRef termLink typeLink vt a
V2.Term.TypeLink (Reference -> Reference
reference1to2 Reference
r)
      V1.Term.Blank Blank Ann
_ -> [Char] -> F Symbol a
forall a. HasCallStack => [Char] -> a
error ([Char]
"can't serialize term with blanks (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Hash -> [Char]
forall a. Show a => a -> [Char]
show Hash
h [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")")

    goCase :: MatchCase a a -> MatchCase Text Reference a
goCase (V1.Term.MatchCase Pattern a
p Maybe a
g a
b) =
      Pattern Text Reference
-> Maybe a -> a -> MatchCase Text Reference a
forall t r a. Pattern t r -> Maybe a -> a -> MatchCase t r a
V2.Term.MatchCase (Pattern a -> Pattern Text Reference
forall a. Pattern a -> Pattern Text Reference
goPat Pattern a
p) Maybe a
g a
b

    goPat :: V1.Pattern.Pattern a -> V2.Term.Pattern Text V2.Reference
    goPat :: forall a. Pattern a -> Pattern Text Reference
goPat = \case
      V1.Pattern.Unbound a
_ -> Pattern Text Reference
forall t r. Pattern t r
V2.Term.PUnbound
      V1.Pattern.Var a
_ -> Pattern Text Reference
forall t r. Pattern t r
V2.Term.PVar
      V1.Pattern.Boolean a
_ Bool
b -> Bool -> Pattern Text Reference
forall t r. Bool -> Pattern t r
V2.Term.PBoolean Bool
b
      V1.Pattern.Int a
_ Int64
i -> Int64 -> Pattern Text Reference
forall t r. Int64 -> Pattern t r
V2.Term.PInt Int64
i
      V1.Pattern.Nat a
_ Pos
n -> Pos -> Pattern Text Reference
forall t r. Pos -> Pattern t r
V2.Term.PNat Pos
n
      V1.Pattern.Float a
_ Double
d -> Double -> Pattern Text Reference
forall t r. Double -> Pattern t r
V2.Term.PFloat Double
d
      V1.Pattern.Text a
_ Text
t -> Text -> Pattern Text Reference
forall t r. t -> Pattern t r
V2.Term.PText Text
t
      V1.Pattern.Char a
_ Char
c -> Char -> Pattern Text Reference
forall t r. Char -> Pattern t r
V2.Term.PChar Char
c
      V1.Pattern.Constructor a
_ (V1.ConstructorReference Reference
r Pos
i) [Pattern a]
ps ->
        Reference
-> Pos -> [Pattern Text Reference] -> Pattern Text Reference
forall t r. r -> Pos -> [Pattern t r] -> Pattern t r
V2.Term.PConstructor (Reference -> Reference
reference1to2 Reference
r) Pos
i (Pattern a -> Pattern Text Reference
forall a. Pattern a -> Pattern Text Reference
goPat (Pattern a -> Pattern Text Reference)
-> [Pattern a] -> [Pattern Text Reference]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pattern a]
ps)
      V1.Pattern.As a
_ Pattern a
p -> Pattern Text Reference -> Pattern Text Reference
forall t r. Pattern t r -> Pattern t r
V2.Term.PAs (Pattern a -> Pattern Text Reference
forall a. Pattern a -> Pattern Text Reference
goPat Pattern a
p)
      V1.Pattern.EffectPure a
_ Pattern a
p -> Pattern Text Reference -> Pattern Text Reference
forall t r. Pattern t r -> Pattern t r
V2.Term.PEffectPure (Pattern a -> Pattern Text Reference
forall a. Pattern a -> Pattern Text Reference
goPat Pattern a
p)
      V1.Pattern.EffectBind a
_ (V1.ConstructorReference Reference
r Pos
i) [Pattern a]
ps Pattern a
k ->
        Reference
-> Pos
-> [Pattern Text Reference]
-> Pattern Text Reference
-> Pattern Text Reference
forall t r. r -> Pos -> [Pattern t r] -> Pattern t r -> Pattern t r
V2.Term.PEffectBind (Reference -> Reference
reference1to2 Reference
r) Pos
i (Pattern a -> Pattern Text Reference
forall a. Pattern a -> Pattern Text Reference
goPat (Pattern a -> Pattern Text Reference)
-> [Pattern a] -> [Pattern Text Reference]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pattern a]
ps) (Pattern a -> Pattern Text Reference
forall a. Pattern a -> Pattern Text Reference
goPat Pattern a
k)
      V1.Pattern.SequenceLiteral a
_ [Pattern a]
ps -> [Pattern Text Reference] -> Pattern Text Reference
forall t r. [Pattern t r] -> Pattern t r
V2.Term.PSequenceLiteral (Pattern a -> Pattern Text Reference
forall a. Pattern a -> Pattern Text Reference
goPat (Pattern a -> Pattern Text Reference)
-> [Pattern a] -> [Pattern Text Reference]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pattern a]
ps)
      V1.Pattern.SequenceOp a
_ Pattern a
p SeqOp
op Pattern a
p2 ->
        Pattern Text Reference
-> SeqOp -> Pattern Text Reference -> Pattern Text Reference
forall t r. Pattern t r -> SeqOp -> Pattern t r -> Pattern t r
V2.Term.PSequenceOp (Pattern a -> Pattern Text Reference
forall a. Pattern a -> Pattern Text Reference
goPat Pattern a
p) (SeqOp -> SeqOp
goSeqOp SeqOp
op) (Pattern a -> Pattern Text Reference
forall a. Pattern a -> Pattern Text Reference
goPat Pattern a
p2)
    goSeqOp :: SeqOp -> SeqOp
goSeqOp = \case
      SeqOp
V1.Pattern.Cons -> SeqOp
V2.Term.PCons
      SeqOp
V1.Pattern.Snoc -> SeqOp
V2.Term.PSnoc
      SeqOp
V1.Pattern.Concat -> SeqOp
V2.Term.PConcat

term2to1 :: forall m. (Monad m) => Hash -> (V2.Reference -> m CT.ConstructorType) -> V2.Term.Term V2.Symbol -> m (V1.Term.Term V1.Symbol Ann)
term2to1 :: forall (m :: * -> *).
Monad m =>
Hash
-> (Reference -> m ConstructorType)
-> Term Symbol
-> m (Term Symbol Ann)
term2to1 Hash
h Reference -> m ConstructorType
lookupCT =
  (forall a1. F Symbol a1 -> m (F Symbol Ann Ann a1))
-> Term (F Symbol) Symbol Ann -> m (Term Symbol Ann)
forall v (m :: * -> *) (g :: * -> *) (f :: * -> *) a.
(Ord v, Monad m, Traversable g) =>
(forall a1. f a1 -> m (g a1)) -> Term f v a -> m (Term g v a)
ABT.transformM (Hash
-> (Reference -> m ConstructorType)
-> F' Text TermRef Reference TermLink Reference Symbol a1
-> m (F Symbol Ann Ann a1)
forall (m :: * -> *) a.
Monad m =>
Hash
-> (Reference -> m ConstructorType)
-> F Symbol a
-> m (F Symbol Ann Ann a)
termF2to1 Hash
h Reference -> m ConstructorType
lookupCT)
    (Term (F Symbol) Symbol Ann -> m (Term Symbol Ann))
-> (Term Symbol -> Term (F Symbol) Symbol Ann)
-> Term Symbol
-> m (Term Symbol Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Symbol -> Symbol)
-> Term (F Symbol) Symbol Ann -> Term (F Symbol) Symbol Ann
forall (f :: * -> *) v' v a.
(Functor f, Foldable f, Ord v') =>
(v -> v') -> Term f v a -> Term f v' a
ABT.vmap Symbol -> Symbol
symbol2to1
    (Term (F Symbol) Symbol Ann -> Term (F Symbol) Symbol Ann)
-> (Term Symbol -> Term (F Symbol) Symbol Ann)
-> Term Symbol
-> Term (F Symbol) Symbol Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> Ann) -> Term Symbol -> Term (F Symbol) Symbol Ann
forall (f :: * -> *) a a' v.
Functor f =>
(a -> a') -> Term f v a -> Term f v a'
ABT.amap (Ann -> () -> Ann
forall a b. a -> b -> a
const Ann
Ann.External)
  where
    termF2to1 :: forall m a. (Monad m) => Hash -> (V2.Reference -> m CT.ConstructorType) -> V2.Term.F V2.Symbol a -> m (V1.Term.F V1.Symbol Ann Ann a)
    termF2to1 :: forall (m :: * -> *) a.
Monad m =>
Hash
-> (Reference -> m ConstructorType)
-> F Symbol a
-> m (F Symbol Ann Ann a)
termF2to1 Hash
h Reference -> m ConstructorType
lookupCT = F Symbol a -> m (F Symbol Ann Ann a)
go
      where
        go :: V2.Term.F V2.Symbol a -> m (V1.Term.F V1.Symbol Ann Ann a)
        go :: F Symbol a -> m (F Symbol Ann Ann a)
go = \case
          V2.Term.Int Int64
i -> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (F Symbol Ann Ann a -> m (F Symbol Ann Ann a))
-> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a b. (a -> b) -> a -> b
$ Int64 -> F Symbol Ann Ann a
forall typeVar typeAnn patternAnn a.
Int64 -> F typeVar typeAnn patternAnn a
V1.Term.Int Int64
i
          V2.Term.Nat Pos
n -> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (F Symbol Ann Ann a -> m (F Symbol Ann Ann a))
-> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a b. (a -> b) -> a -> b
$ Pos -> F Symbol Ann Ann a
forall typeVar typeAnn patternAnn a.
Pos -> F typeVar typeAnn patternAnn a
V1.Term.Nat Pos
n
          V2.Term.Float Double
d -> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (F Symbol Ann Ann a -> m (F Symbol Ann Ann a))
-> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a b. (a -> b) -> a -> b
$ Double -> F Symbol Ann Ann a
forall typeVar typeAnn patternAnn a.
Double -> F typeVar typeAnn patternAnn a
V1.Term.Float Double
d
          V2.Term.Boolean Bool
b -> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (F Symbol Ann Ann a -> m (F Symbol Ann Ann a))
-> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a b. (a -> b) -> a -> b
$ Bool -> F Symbol Ann Ann a
forall typeVar typeAnn patternAnn a.
Bool -> F typeVar typeAnn patternAnn a
V1.Term.Boolean Bool
b
          V2.Term.Text Text
t -> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (F Symbol Ann Ann a -> m (F Symbol Ann Ann a))
-> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a b. (a -> b) -> a -> b
$ Text -> F Symbol Ann Ann a
forall typeVar typeAnn patternAnn a.
Text -> F typeVar typeAnn patternAnn a
V1.Term.Text Text
t
          V2.Term.Char Char
c -> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (F Symbol Ann Ann a -> m (F Symbol Ann Ann a))
-> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a b. (a -> b) -> a -> b
$ Char -> F Symbol Ann Ann a
forall typeVar typeAnn patternAnn a.
Char -> F typeVar typeAnn patternAnn a
V1.Term.Char Char
c
          V2.Term.Ref TermRef
r -> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (F Symbol Ann Ann a -> m (F Symbol Ann Ann a))
-> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a b. (a -> b) -> a -> b
$ Reference -> F Symbol Ann Ann a
forall typeVar typeAnn patternAnn a.
Reference -> F typeVar typeAnn patternAnn a
V1.Term.Ref (Hash -> TermRef -> Reference
rreference2to1 Hash
h TermRef
r)
          V2.Term.Constructor Reference
r Pos
i ->
            F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GConstructorReference Reference -> F Symbol Ann Ann a
forall typeVar typeAnn patternAnn a.
GConstructorReference Reference -> F typeVar typeAnn patternAnn a
V1.Term.Constructor (Reference -> Pos -> GConstructorReference Reference
forall r. r -> Pos -> GConstructorReference r
V1.ConstructorReference (Reference -> Reference
reference2to1 Reference
r) (Pos -> Pos
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pos
i)))
          V2.Term.Request Reference
r Pos
i ->
            F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GConstructorReference Reference -> F Symbol Ann Ann a
forall typeVar typeAnn patternAnn a.
GConstructorReference Reference -> F typeVar typeAnn patternAnn a
V1.Term.Request (Reference -> Pos -> GConstructorReference Reference
forall r. r -> Pos -> GConstructorReference r
V1.ConstructorReference (Reference -> Reference
reference2to1 Reference
r) (Pos -> Pos
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pos
i)))
          V2.Term.Handle a
a a
a4 -> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (F Symbol Ann Ann a -> m (F Symbol Ann Ann a))
-> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a b. (a -> b) -> a -> b
$ a -> a -> F Symbol Ann Ann a
forall typeVar typeAnn patternAnn a.
a -> a -> F typeVar typeAnn patternAnn a
V1.Term.Handle a
a a
a4
          V2.Term.App a
a a
a4 -> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (F Symbol Ann Ann a -> m (F Symbol Ann Ann a))
-> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a b. (a -> b) -> a -> b
$ a -> a -> F Symbol Ann Ann a
forall typeVar typeAnn patternAnn a.
a -> a -> F typeVar typeAnn patternAnn a
V1.Term.App a
a a
a4
          V2.Term.Ann a
a TypeR Reference Symbol
t2 -> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (F Symbol Ann Ann a -> m (F Symbol Ann Ann a))
-> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a b. (a -> b) -> a -> b
$ a -> Type Symbol Ann -> F Symbol Ann Ann a
forall typeVar typeAnn patternAnn a.
a -> Type typeVar typeAnn -> F typeVar typeAnn patternAnn a
V1.Term.Ann a
a (TypeR Reference Symbol -> Type Symbol Ann
ttype2to1 TypeR Reference Symbol
t2)
          V2.Term.List Seq a
sa -> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (F Symbol Ann Ann a -> m (F Symbol Ann Ann a))
-> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a b. (a -> b) -> a -> b
$ Seq a -> F Symbol Ann Ann a
forall typeVar typeAnn patternAnn a.
Seq a -> F typeVar typeAnn patternAnn a
V1.Term.List Seq a
sa
          V2.Term.If a
a a
a4 a
a5 -> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (F Symbol Ann Ann a -> m (F Symbol Ann Ann a))
-> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> F Symbol Ann Ann a
forall typeVar typeAnn patternAnn a.
a -> a -> a -> F typeVar typeAnn patternAnn a
V1.Term.If a
a a
a4 a
a5
          V2.Term.And a
a a
a4 -> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (F Symbol Ann Ann a -> m (F Symbol Ann Ann a))
-> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a b. (a -> b) -> a -> b
$ a -> a -> F Symbol Ann Ann a
forall typeVar typeAnn patternAnn a.
a -> a -> F typeVar typeAnn patternAnn a
V1.Term.And a
a a
a4
          V2.Term.Or a
a a
a4 -> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (F Symbol Ann Ann a -> m (F Symbol Ann Ann a))
-> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a b. (a -> b) -> a -> b
$ a -> a -> F Symbol Ann Ann a
forall typeVar typeAnn patternAnn a.
a -> a -> F typeVar typeAnn patternAnn a
V1.Term.Or a
a a
a4
          V2.Term.Lam a
a -> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (F Symbol Ann Ann a -> m (F Symbol Ann Ann a))
-> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a b. (a -> b) -> a -> b
$ a -> F Symbol Ann Ann a
forall typeVar typeAnn patternAnn a.
a -> F typeVar typeAnn patternAnn a
V1.Term.Lam a
a
          V2.Term.LetRec [a]
as a
a -> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (F Symbol Ann Ann a -> m (F Symbol Ann Ann a))
-> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a b. (a -> b) -> a -> b
$ Bool -> [a] -> a -> F Symbol Ann Ann a
forall typeVar typeAnn patternAnn a.
Bool -> [a] -> a -> F typeVar typeAnn patternAnn a
V1.Term.LetRec Bool
False [a]
as a
a
          V2.Term.Let a
a a
a4 -> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (F Symbol Ann Ann a -> m (F Symbol Ann Ann a))
-> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a b. (a -> b) -> a -> b
$ Bool -> a -> a -> F Symbol Ann Ann a
forall typeVar typeAnn patternAnn a.
Bool -> a -> a -> F typeVar typeAnn patternAnn a
V1.Term.Let Bool
False a
a a
a4
          V2.Term.Match a
a [MatchCase Text Reference a]
cases -> a -> [MatchCase Ann a] -> F Symbol Ann Ann a
forall typeVar typeAnn patternAnn a.
a -> [MatchCase patternAnn a] -> F typeVar typeAnn patternAnn a
V1.Term.Match a
a ([MatchCase Ann a] -> F Symbol Ann Ann a)
-> m [MatchCase Ann a] -> m (F Symbol Ann Ann a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MatchCase Text Reference a -> m (MatchCase Ann a))
-> [MatchCase Text Reference a] -> m [MatchCase Ann a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse MatchCase Text Reference a -> m (MatchCase Ann a)
goCase [MatchCase Text Reference a]
cases
          V2.Term.TermLink TermLink
rr -> Referent -> F Symbol Ann Ann a
forall typeVar typeAnn patternAnn a.
Referent -> F typeVar typeAnn patternAnn a
V1.Term.TermLink (Referent -> F Symbol Ann Ann a)
-> m Referent -> m (F Symbol Ann Ann a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Hash -> (Reference -> m ConstructorType) -> TermLink -> m Referent
forall (m :: * -> *).
Applicative m =>
Hash -> (Reference -> m ConstructorType) -> TermLink -> m Referent
rreferent2to1 Hash
h Reference -> m ConstructorType
lookupCT TermLink
rr
          V2.Term.TypeLink Reference
r -> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (F Symbol Ann Ann a -> m (F Symbol Ann Ann a))
-> F Symbol Ann Ann a -> m (F Symbol Ann Ann a)
forall a b. (a -> b) -> a -> b
$ Reference -> F Symbol Ann Ann a
forall typeVar typeAnn patternAnn a.
Reference -> F typeVar typeAnn patternAnn a
V1.Term.TypeLink (Reference -> Reference
reference2to1 Reference
r)
        goCase :: MatchCase Text Reference a -> m (MatchCase Ann a)
goCase = \case
          V2.Term.MatchCase Pattern Text Reference
pat Maybe a
cond a
body ->
            Pattern Ann -> Maybe a -> a -> MatchCase Ann a
forall loc a. Pattern loc -> Maybe a -> a -> MatchCase loc a
V1.Term.MatchCase (Pattern Ann -> Maybe a -> a -> MatchCase Ann a)
-> m (Pattern Ann) -> m (Maybe a -> a -> MatchCase Ann a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pattern Text Reference -> m (Pattern Ann)
goPat Pattern Text Reference
pat) m (Maybe a -> a -> MatchCase Ann a)
-> m (Maybe a) -> m (a -> MatchCase Ann a)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
cond m (a -> MatchCase Ann a) -> m a -> m (MatchCase Ann a)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
body
        goPat :: Pattern Text Reference -> m (Pattern Ann)
goPat = \case
          Pattern Text Reference
V2.Term.PUnbound -> Pattern Ann -> m (Pattern Ann)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pattern Ann -> m (Pattern Ann)) -> Pattern Ann -> m (Pattern Ann)
forall a b. (a -> b) -> a -> b
$ Ann -> Pattern Ann
forall loc. loc -> Pattern loc
V1.Pattern.Unbound Ann
a
          Pattern Text Reference
V2.Term.PVar -> Pattern Ann -> m (Pattern Ann)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pattern Ann -> m (Pattern Ann)) -> Pattern Ann -> m (Pattern Ann)
forall a b. (a -> b) -> a -> b
$ Ann -> Pattern Ann
forall loc. loc -> Pattern loc
V1.Pattern.Var Ann
a
          V2.Term.PBoolean Bool
b -> Pattern Ann -> m (Pattern Ann)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pattern Ann -> m (Pattern Ann)) -> Pattern Ann -> m (Pattern Ann)
forall a b. (a -> b) -> a -> b
$ Ann -> Bool -> Pattern Ann
forall loc. loc -> Bool -> Pattern loc
V1.Pattern.Boolean Ann
a Bool
b
          V2.Term.PInt Int64
i -> Pattern Ann -> m (Pattern Ann)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pattern Ann -> m (Pattern Ann)) -> Pattern Ann -> m (Pattern Ann)
forall a b. (a -> b) -> a -> b
$ Ann -> Int64 -> Pattern Ann
forall loc. loc -> Int64 -> Pattern loc
V1.Pattern.Int Ann
a Int64
i
          V2.Term.PNat Pos
n -> Pattern Ann -> m (Pattern Ann)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pattern Ann -> m (Pattern Ann)) -> Pattern Ann -> m (Pattern Ann)
forall a b. (a -> b) -> a -> b
$ Ann -> Pos -> Pattern Ann
forall loc. loc -> Pos -> Pattern loc
V1.Pattern.Nat Ann
a Pos
n
          V2.Term.PFloat Double
d -> Pattern Ann -> m (Pattern Ann)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pattern Ann -> m (Pattern Ann)) -> Pattern Ann -> m (Pattern Ann)
forall a b. (a -> b) -> a -> b
$ Ann -> Double -> Pattern Ann
forall loc. loc -> Double -> Pattern loc
V1.Pattern.Float Ann
a Double
d
          V2.Term.PText Text
t -> Pattern Ann -> m (Pattern Ann)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pattern Ann -> m (Pattern Ann)) -> Pattern Ann -> m (Pattern Ann)
forall a b. (a -> b) -> a -> b
$ Ann -> Text -> Pattern Ann
forall loc. loc -> Text -> Pattern loc
V1.Pattern.Text Ann
a Text
t
          V2.Term.PChar Char
c -> Pattern Ann -> m (Pattern Ann)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pattern Ann -> m (Pattern Ann)) -> Pattern Ann -> m (Pattern Ann)
forall a b. (a -> b) -> a -> b
$ Ann -> Char -> Pattern Ann
forall loc. loc -> Char -> Pattern loc
V1.Pattern.Char Ann
a Char
c
          V2.Term.PConstructor Reference
r Pos
i [Pattern Text Reference]
ps ->
            Ann
-> GConstructorReference Reference -> [Pattern Ann] -> Pattern Ann
forall loc.
loc
-> GConstructorReference Reference -> [Pattern loc] -> Pattern loc
V1.Pattern.Constructor Ann
a (Reference -> Pos -> GConstructorReference Reference
forall r. r -> Pos -> GConstructorReference r
V1.ConstructorReference (Reference -> Reference
reference2to1 Reference
r) Pos
i) ([Pattern Ann] -> Pattern Ann)
-> m [Pattern Ann] -> m (Pattern Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pattern Text Reference -> m (Pattern Ann))
-> [Pattern Text Reference] -> m [Pattern Ann]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Pattern Text Reference -> m (Pattern Ann)
goPat [Pattern Text Reference]
ps
          V2.Term.PAs Pattern Text Reference
p -> Ann -> Pattern Ann -> Pattern Ann
forall loc. loc -> Pattern loc -> Pattern loc
V1.Pattern.As Ann
a (Pattern Ann -> Pattern Ann) -> m (Pattern Ann) -> m (Pattern Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Text Reference -> m (Pattern Ann)
goPat Pattern Text Reference
p
          V2.Term.PEffectPure Pattern Text Reference
p -> Ann -> Pattern Ann -> Pattern Ann
forall loc. loc -> Pattern loc -> Pattern loc
V1.Pattern.EffectPure Ann
a (Pattern Ann -> Pattern Ann) -> m (Pattern Ann) -> m (Pattern Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Text Reference -> m (Pattern Ann)
goPat Pattern Text Reference
p
          V2.Term.PEffectBind Reference
r Pos
i [Pattern Text Reference]
ps Pattern Text Reference
p ->
            Ann
-> GConstructorReference Reference
-> [Pattern Ann]
-> Pattern Ann
-> Pattern Ann
forall loc.
loc
-> GConstructorReference Reference
-> [Pattern loc]
-> Pattern loc
-> Pattern loc
V1.Pattern.EffectBind Ann
a (Reference -> Pos -> GConstructorReference Reference
forall r. r -> Pos -> GConstructorReference r
V1.ConstructorReference (Reference -> Reference
reference2to1 Reference
r) Pos
i) ([Pattern Ann] -> Pattern Ann -> Pattern Ann)
-> m [Pattern Ann] -> m (Pattern Ann -> Pattern Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pattern Text Reference -> m (Pattern Ann))
-> [Pattern Text Reference] -> m [Pattern Ann]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Pattern Text Reference -> m (Pattern Ann)
goPat [Pattern Text Reference]
ps m (Pattern Ann -> Pattern Ann)
-> m (Pattern Ann) -> m (Pattern Ann)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern Text Reference -> m (Pattern Ann)
goPat Pattern Text Reference
p
          V2.Term.PSequenceLiteral [Pattern Text Reference]
ps -> Ann -> [Pattern Ann] -> Pattern Ann
forall loc. loc -> [Pattern loc] -> Pattern loc
V1.Pattern.SequenceLiteral Ann
a ([Pattern Ann] -> Pattern Ann)
-> m [Pattern Ann] -> m (Pattern Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pattern Text Reference -> m (Pattern Ann))
-> [Pattern Text Reference] -> m [Pattern Ann]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Pattern Text Reference -> m (Pattern Ann)
goPat [Pattern Text Reference]
ps
          V2.Term.PSequenceOp Pattern Text Reference
p1 SeqOp
op Pattern Text Reference
p2 -> Ann -> Pattern Ann -> SeqOp -> Pattern Ann -> Pattern Ann
forall loc.
loc -> Pattern loc -> SeqOp -> Pattern loc -> Pattern loc
V1.Pattern.SequenceOp Ann
a (Pattern Ann -> SeqOp -> Pattern Ann -> Pattern Ann)
-> m (Pattern Ann) -> m (SeqOp -> Pattern Ann -> Pattern Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Text Reference -> m (Pattern Ann)
goPat Pattern Text Reference
p1 m (SeqOp -> Pattern Ann -> Pattern Ann)
-> m SeqOp -> m (Pattern Ann -> Pattern Ann)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SeqOp -> m SeqOp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SeqOp -> SeqOp
goOp SeqOp
op) m (Pattern Ann -> Pattern Ann)
-> m (Pattern Ann) -> m (Pattern Ann)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern Text Reference -> m (Pattern Ann)
goPat Pattern Text Reference
p2
        goOp :: SeqOp -> SeqOp
goOp = \case
          SeqOp
V2.Term.PCons -> SeqOp
V1.Pattern.Cons
          SeqOp
V2.Term.PSnoc -> SeqOp
V1.Pattern.Snoc
          SeqOp
V2.Term.PConcat -> SeqOp
V1.Pattern.Concat
        a :: Ann
a = Ann
Ann.External

termComponent1to2 ::
  Hash ->
  [(V1.Term.Term V1.Symbol Ann, V1.Type.Type V1.Symbol a)] ->
  [(V2.Term.Term V2.Symbol, V2.Type.TypeT V2.Symbol)]
termComponent1to2 :: forall a.
Hash
-> [(Term Symbol Ann, Type Symbol a)]
-> [(Term Symbol, TypeR Reference Symbol)]
termComponent1to2 Hash
h =
  ((Term Symbol Ann, Type Symbol a)
 -> (Term Symbol, TypeR Reference Symbol))
-> [(Term Symbol Ann, Type Symbol a)]
-> [(Term Symbol, TypeR Reference Symbol)]
forall a b. (a -> b) -> [a] -> [b]
map ((Term Symbol Ann -> Term Symbol)
-> (Type Symbol a -> TypeR Reference Symbol)
-> (Term Symbol Ann, Type Symbol a)
-> (Term Symbol, TypeR Reference Symbol)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Hash -> Term Symbol Ann -> Term Symbol
term1to2 Hash
h) Type Symbol a -> TypeR Reference Symbol
forall a. Type Symbol a -> TypeR Reference Symbol
ttype1to2)

decl2to1 :: Hash -> V2.Decl.Decl V2.Symbol -> V1.Decl.Decl V1.Symbol Ann
decl2to1 :: Hash -> Decl Symbol -> Decl Symbol Ann
decl2to1 Hash
h (V2.Decl.DataDeclaration DeclType
dt Modifier
m [Symbol]
bound [TypeR TermRef Symbol]
cts) =
  DeclType -> DataDeclaration Symbol Ann -> Decl Symbol Ann
forall {v} {a}.
DeclType
-> DataDeclaration v a
-> Either (EffectDeclaration v a) (DataDeclaration v a)
goCT DeclType
dt (DataDeclaration Symbol Ann -> Decl Symbol Ann)
-> DataDeclaration Symbol Ann -> Decl Symbol Ann
forall a b. (a -> b) -> a -> b
$
    Modifier
-> Ann
-> [Symbol]
-> [(Ann, Symbol, Type Symbol Ann)]
-> DataDeclaration Symbol Ann
forall v a.
Modifier -> a -> [v] -> [(a, v, Type v a)] -> DataDeclaration v a
V1.Decl.DataDeclaration (Modifier -> Modifier
goMod Modifier
m) Ann
Ann.External (Symbol -> Symbol
symbol2to1 (Symbol -> Symbol) -> [Symbol] -> [Symbol]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Symbol]
bound) [(Ann, Symbol, Type Symbol Ann)]
cts'
  where
    goMod :: Modifier -> Modifier
goMod = \case
      Modifier
V2.Decl.Structural -> Modifier
V1.Decl.Structural
      V2.Decl.Unique Text
t -> Text -> Modifier
V1.Decl.Unique Text
t
    goCT :: DeclType
-> DataDeclaration v a
-> Either (EffectDeclaration v a) (DataDeclaration v a)
goCT = \case
      DeclType
V2.Decl.Data -> DataDeclaration v a
-> Either (EffectDeclaration v a) (DataDeclaration v a)
forall a b. b -> Either a b
Right
      DeclType
V2.Decl.Effect -> EffectDeclaration v a
-> Either (EffectDeclaration v a) (DataDeclaration v a)
forall a b. a -> Either a b
Left (EffectDeclaration v a
 -> Either (EffectDeclaration v a) (DataDeclaration v a))
-> (DataDeclaration v a -> EffectDeclaration v a)
-> DataDeclaration v a
-> Either (EffectDeclaration v a) (DataDeclaration v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataDeclaration v a -> EffectDeclaration v a
forall v a. DataDeclaration v a -> EffectDeclaration v a
V1.Decl.EffectDeclaration
    cts' :: [(Ann, Symbol, Type Symbol Ann)]
cts' = ((TypeR TermRef Symbol, Pos) -> (Ann, Symbol, Type Symbol Ann))
-> [(TypeR TermRef Symbol, Pos)]
-> [(Ann, Symbol, Type Symbol Ann)]
forall a b. (a -> b) -> [a] -> [b]
map (TypeR TermRef Symbol, Pos) -> (Ann, Symbol, Type Symbol Ann)
mkCtor ([TypeR TermRef Symbol] -> [Pos] -> [(TypeR TermRef Symbol, Pos)]
forall a b. [a] -> [b] -> [(a, b)]
zip [TypeR TermRef Symbol]
cts [Pos
0 :: V2.Decl.ConstructorId ..])
    mkCtor :: (TypeR TermRef Symbol, Pos) -> (Ann, Symbol, Type Symbol Ann)
mkCtor (TypeR TermRef Symbol
type1, Pos
i) =
      (Ann
Ann.External, Text -> Symbol
V1.symbol (Text -> Symbol) -> ([Char] -> Text) -> [Char] -> Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack ([Char] -> Symbol) -> [Char] -> Symbol
forall a b. (a -> b) -> a -> b
$ [Char]
"Constructor" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Pos -> [Char]
forall a. Show a => a -> [Char]
show Pos
i, Type Symbol Ann
type2)
      where
        type2 :: Type Symbol Ann
type2 = Hash -> TypeR TermRef Symbol -> Type Symbol Ann
dtype2to1 Hash
h TypeR TermRef Symbol
type1

decl1to2 :: Hash -> V1.Decl.Decl V1.Symbol a -> V2.Decl.Decl V2.Symbol
decl1to2 :: forall a. Hash -> Decl Symbol a -> Decl Symbol
decl1to2 Hash
h Decl Symbol a
decl1 = case Decl Symbol a -> DataDeclaration Symbol a
forall v a. Decl v a -> DataDeclaration v a
V1.Decl.asDataDecl Decl Symbol a
decl1 of
  V1.Decl.DataDeclaration Modifier
m a
_ann [Symbol]
bound [(a, Symbol, Type Symbol a)]
cts ->
    DeclType
-> Modifier -> [Symbol] -> [TypeR TermRef Symbol] -> Decl Symbol
forall r v. DeclType -> Modifier -> [v] -> [TypeR r v] -> DeclR r v
V2.Decl.DataDeclaration
      (ConstructorType -> DeclType
decltype1to2 (ConstructorType -> DeclType) -> ConstructorType -> DeclType
forall a b. (a -> b) -> a -> b
$ Decl Symbol a -> ConstructorType
forall v a. Decl v a -> ConstructorType
V1.Decl.constructorType Decl Symbol a
decl1)
      (Modifier -> Modifier
goMod Modifier
m)
      (Symbol -> Symbol
symbol1to2 (Symbol -> Symbol) -> [Symbol] -> [Symbol]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Symbol]
bound)
      [TypeR TermRef Symbol]
cts'
    where
      goMod :: Modifier -> Modifier
goMod = \case
        Modifier
V1.Decl.Structural -> Modifier
V2.Decl.Structural
        V1.Decl.Unique Text
t -> Text -> Modifier
V2.Decl.Unique Text
t
      cts' :: [TypeR TermRef Symbol]
cts' = [Hash -> Type Symbol a -> TypeR TermRef Symbol
forall a. Hash -> Type Symbol a -> TypeR TermRef Symbol
dtype1to2 Hash
h Type Symbol a
t | (a
_, Symbol
_, Type Symbol a
t) <- [(a, Symbol, Type Symbol a)]
cts]

symbol2to1 :: V2.Symbol -> V1.Symbol
symbol2to1 :: Symbol -> Symbol
symbol2to1 (V2.Symbol Pos
i Text
t) = Pos -> Type -> Symbol
V1.Symbol Pos
i (Text -> Type
Var.User Text
t)

symbol1to2 :: V1.Symbol -> V2.Symbol
symbol1to2 :: Symbol -> Symbol
symbol1to2 (V1.Symbol Pos
i Type
varType) = Pos -> Text -> Symbol
V2.Symbol Pos
i (Type -> Text
Var.rawName Type
varType)

rreference2to1 :: Hash -> V2.Reference' Text (Maybe Hash) -> V1.Reference
rreference2to1 :: Hash -> TermRef -> Reference
rreference2to1 Hash
h = \case
  V2.ReferenceBuiltin Text
t -> Text -> Reference
forall t h. t -> Reference' t h
V1.Reference.Builtin Text
t
  V2.ReferenceDerived Id' (Maybe Hash)
i -> Id' Hash -> Reference
forall h t. Id' h -> Reference' t h
V1.Reference.DerivedId (Id' Hash -> Reference) -> Id' Hash -> Reference
forall a b. (a -> b) -> a -> b
$ Hash -> Id' (Maybe Hash) -> Id' Hash
rreferenceid2to1 Hash
h Id' (Maybe Hash)
i

rreference1to2 :: Hash -> V1.Reference -> V2.Reference' Text (Maybe Hash)
rreference1to2 :: Hash -> Reference -> TermRef
rreference1to2 Hash
h = \case
  V1.Reference.Builtin Text
t -> Text -> TermRef
forall t h. t -> Reference' t h
V2.ReferenceBuiltin Text
t
  V1.Reference.DerivedId Id' Hash
i -> Id' (Maybe Hash) -> TermRef
forall t h. Id' h -> Reference' t h
V2.ReferenceDerived (Hash -> Id' Hash -> Id' (Maybe Hash)
rreferenceid1to2 Hash
h Id' Hash
i)

rreferenceid2to1 :: Hash -> V2.Reference.Id' (Maybe Hash) -> V1.Reference.Id
rreferenceid2to1 :: Hash -> Id' (Maybe Hash) -> Id' Hash
rreferenceid2to1 Hash
h (V2.Reference.Id Maybe Hash
oh Pos
i) = Hash -> Pos -> Id' Hash
forall h. h -> Pos -> Id' h
V1.Reference.Id Hash
h' Pos
i
  where
    h' :: Hash
h' = Hash -> Maybe Hash -> Hash
forall a. a -> Maybe a -> a
fromMaybe Hash
h Maybe Hash
oh

rreferenceid1to2 :: Hash -> V1.Reference.Id -> V2.Reference.Id' (Maybe Hash)
rreferenceid1to2 :: Hash -> Id' Hash -> Id' (Maybe Hash)
rreferenceid1to2 Hash
h (V1.Reference.Id Hash
h' Pos
i) = Maybe Hash -> Pos -> Id' (Maybe Hash)
forall h. h -> Pos -> Id' h
V2.Reference.Id Maybe Hash
oh Pos
i
  where
    oh :: Maybe Hash
oh = if Hash
h Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
h' then Maybe Hash
forall a. Maybe a
Nothing else Hash -> Maybe Hash
forall a. a -> Maybe a
Just Hash
h'

branchHash1to2 :: V1.Branch.NamespaceHash m -> BranchHash
branchHash1to2 :: forall (m :: * -> *). NamespaceHash m -> BranchHash
branchHash1to2 = Hash -> BranchHash
BranchHash (Hash -> BranchHash)
-> (NamespaceHash m -> Hash) -> NamespaceHash m -> BranchHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamespaceHash m -> Hash
forall t. HashFor t -> Hash
V1.genericHash

branchHash2to1 :: forall m. BranchHash -> V1.Branch.NamespaceHash m
branchHash2to1 :: forall (m :: * -> *). BranchHash -> NamespaceHash m
branchHash2to1 = Hash -> HashFor (Branch0 m)
forall t. Hash -> HashFor t
V1.HashFor (Hash -> HashFor (Branch0 m))
-> (BranchHash -> Hash) -> BranchHash -> HashFor (Branch0 m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BranchHash -> Hash
unBranchHash

reference2to1 :: V2.Reference -> V1.Reference
reference2to1 :: Reference -> Reference
reference2to1 = Reference -> Reference
forall a. a -> a
id

reference1to2 :: V1.Reference -> V2.Reference
reference1to2 :: Reference -> Reference
reference1to2 = Reference -> Reference
forall a. a -> a
id

referenceid1to2 :: V1.Reference.Id -> V2.Reference.Id
referenceid1to2 :: Id' Hash -> Id' Hash
referenceid1to2 = Id' Hash -> Id' Hash
forall a. a -> a
id

referenceid2to1 :: V2.Reference.Id -> V1.Reference.Id
referenceid2to1 :: Id' Hash -> Id' Hash
referenceid2to1 = Id' Hash -> Id' Hash
forall a. a -> a
id

rreferent2to1 :: (Applicative m) => Hash -> (V2.Reference -> m CT.ConstructorType) -> V2.ReferentH -> m V1.Referent
rreferent2to1 :: forall (m :: * -> *).
Applicative m =>
Hash -> (Reference -> m ConstructorType) -> TermLink -> m Referent
rreferent2to1 Hash
h Reference -> m ConstructorType
lookupCT = \case
  V2.Ref TermRef
r -> Referent -> m Referent
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Referent -> m Referent)
-> (Reference -> Referent) -> Reference -> m Referent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Referent
V1.Ref (Reference -> m Referent) -> Reference -> m Referent
forall a b. (a -> b) -> a -> b
$ Hash -> TermRef -> Reference
rreference2to1 Hash
h TermRef
r
  V2.Con Reference
r Pos
i -> GConstructorReference Reference -> ConstructorType -> Referent
V1.Con (Reference -> Pos -> GConstructorReference Reference
forall r. r -> Pos -> GConstructorReference r
V1.ConstructorReference (Reference -> Reference
reference2to1 Reference
r) (Pos -> Pos
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pos
i)) (ConstructorType -> Referent) -> m ConstructorType -> m Referent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Reference -> m ConstructorType
lookupCT Reference
r

rreferent1to2 :: Hash -> V1.Referent -> V2.ReferentH
rreferent1to2 :: Hash -> Referent -> TermLink
rreferent1to2 Hash
h = \case
  V1.Ref Reference
r -> TermRef -> TermLink
forall termRef typeRef. termRef -> Referent' termRef typeRef
V2.Ref (Hash -> Reference -> TermRef
rreference1to2 Hash
h Reference
r)
  V1.Con (V1.ConstructorReference Reference
r Pos
i) ConstructorType
_ct -> Reference -> Pos -> TermLink
forall termRef typeRef. typeRef -> Pos -> Referent' termRef typeRef
V2.Con (Reference -> Reference
reference1to2 Reference
r) (Pos -> Pos
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pos
i)

referent2to1 :: (Applicative m) => (V2.Reference -> m CT.ConstructorType) -> V2.Referent -> m V1.Referent
referent2to1 :: forall (m :: * -> *).
Applicative m =>
(Reference -> m ConstructorType)
-> Referent' Reference Reference -> m Referent
referent2to1 Reference -> m ConstructorType
lookupCT = \case
  V2.Ref Reference
r -> Referent -> m Referent
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Referent -> m Referent) -> Referent -> m Referent
forall a b. (a -> b) -> a -> b
$ Reference -> Referent
V1.Ref (Reference -> Reference
reference2to1 Reference
r)
  V2.Con Reference
r Pos
i -> GConstructorReference Reference -> ConstructorType -> Referent
V1.Con (Reference -> Pos -> GConstructorReference Reference
forall r. r -> Pos -> GConstructorReference r
V1.ConstructorReference (Reference -> Reference
reference2to1 Reference
r) (Pos -> Pos
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pos
i)) (ConstructorType -> Referent) -> m ConstructorType -> m Referent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Reference -> m ConstructorType
lookupCT Reference
r

-- | Like referent2to1, but uses the provided constructor type directly
referent2to1UsingCT :: V2.ConstructorType -> V2.Referent -> V1.Referent
referent2to1UsingCT :: ConstructorType -> Referent' Reference Reference -> Referent
referent2to1UsingCT ConstructorType
ct = \case
  V2.Ref Reference
r -> Reference -> Referent
V1.Ref (Reference -> Reference
reference2to1 Reference
r)
  V2.Con Reference
r Pos
i -> GConstructorReference Reference -> ConstructorType -> Referent
V1.Con (Reference -> Pos -> GConstructorReference Reference
forall r. r -> Pos -> GConstructorReference r
V1.ConstructorReference (Reference -> Reference
reference2to1 Reference
r) (Pos -> Pos
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pos
i)) (ConstructorType -> ConstructorType
constructorType2to1 ConstructorType
ct)

referent1to2 :: V1.Referent -> V2.Referent
referent1to2 :: Referent -> Referent' Reference Reference
referent1to2 = \case
  V1.Ref Reference
r -> Reference -> Referent' Reference Reference
forall termRef typeRef. termRef -> Referent' termRef typeRef
V2.Ref (Reference -> Referent' Reference Reference)
-> Reference -> Referent' Reference Reference
forall a b. (a -> b) -> a -> b
$ Reference -> Reference
reference1to2 Reference
r
  V1.Con (V1.ConstructorReference Reference
r Pos
i) ConstructorType
_ct -> Reference -> Pos -> Referent' Reference Reference
forall termRef typeRef. typeRef -> Pos -> Referent' termRef typeRef
V2.Con (Reference -> Reference
reference1to2 Reference
r) (Pos -> Pos
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pos
i)

referentid1to2 :: V1.Referent.Id -> V2.Referent.Id
referentid1to2 :: Id -> Id
referentid1to2 = \case
  V1.RefId Id' Hash
r -> Id' Hash -> Id
forall hTm hTp. Id' hTm -> Id' hTm hTp
V2.RefId (Id' Hash -> Id' Hash
referenceid1to2 Id' Hash
r)
  V1.ConId (V1.ConstructorReference Id' Hash
r Pos
i) ConstructorType
_ct -> Id' Hash -> Pos -> Id
forall hTm hTp. Id' hTp -> Pos -> Id' hTm hTp
V2.ConId (Id' Hash -> Id' Hash
referenceid1to2 Id' Hash
r) Pos
i

referentid2to1 :: (Applicative m) => (V2.Reference -> m CT.ConstructorType) -> V2.Referent.Id -> m V1.Referent.Id
referentid2to1 :: forall (m :: * -> *).
Applicative m =>
(Reference -> m ConstructorType) -> Id -> m Id
referentid2to1 Reference -> m ConstructorType
lookupCT = \case
  V2.RefId Id' Hash
r -> Id -> m Id
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Id -> m Id) -> Id -> m Id
forall a b. (a -> b) -> a -> b
$ Id' Hash -> Id
V1.RefId (Id' Hash -> Id' Hash
referenceid2to1 Id' Hash
r)
  V2.ConId Id' Hash
r Pos
i ->
    GConstructorReference (Id' Hash) -> ConstructorType -> Id
V1.ConId (Id' Hash -> Pos -> GConstructorReference (Id' Hash)
forall r. r -> Pos -> GConstructorReference r
V1.ConstructorReference (Id' Hash -> Id' Hash
referenceid2to1 Id' Hash
r) (Pos -> Pos
forall a b. (Integral a, Num b) => a -> b
fromIntegral Pos
i)) (ConstructorType -> Id) -> m ConstructorType -> m Id
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Reference -> m ConstructorType
lookupCT (Id' Hash -> Reference
forall t h. Id' h -> Reference' t h
V2.ReferenceDerived Id' Hash
r)

constructorType1to2 :: CT.ConstructorType -> V2.ConstructorType
constructorType1to2 :: ConstructorType -> ConstructorType
constructorType1to2 = \case
  ConstructorType
CT.Data -> ConstructorType
V2.DataConstructor
  ConstructorType
CT.Effect -> ConstructorType
V2.EffectConstructor

constructorType2to1 :: V2.ConstructorType -> CT.ConstructorType
constructorType2to1 :: ConstructorType -> ConstructorType
constructorType2to1 = \case
  ConstructorType
V2.DataConstructor -> ConstructorType
CT.Data
  ConstructorType
V2.EffectConstructor -> ConstructorType
CT.Effect

ttype2to1 :: V2.Term.Type V2.Symbol -> V1.Type.Type V1.Symbol Ann
ttype2to1 :: TypeR Reference Symbol -> Type Symbol Ann
ttype2to1 = (Reference -> Reference)
-> TypeR Reference Symbol -> Type Symbol Ann
forall r. (r -> Reference) -> TypeR r Symbol -> Type Symbol Ann
type2to1' Reference -> Reference
reference2to1

dtype2to1 :: Hash -> V2.Decl.Type V2.Symbol -> V1.Type.Type V1.Symbol Ann
dtype2to1 :: Hash -> TypeR TermRef Symbol -> Type Symbol Ann
dtype2to1 Hash
h = (TermRef -> Reference) -> TypeR TermRef Symbol -> Type Symbol Ann
forall r. (r -> Reference) -> TypeR r Symbol -> Type Symbol Ann
type2to1' (Hash -> TermRef -> Reference
rreference2to1 Hash
h)

type2to1' :: (r -> V1.Reference) -> V2.Type.TypeR r V2.Symbol -> V1.Type.Type V1.Symbol Ann
type2to1' :: forall r. (r -> Reference) -> TypeR r Symbol -> Type Symbol Ann
type2to1' r -> Reference
convertRef =
  (forall a1. F' r a1 -> F a1)
-> Term (F' r) Symbol Ann -> Type Symbol Ann
forall v (g :: * -> *) (f :: * -> *) a.
(Ord v, Foldable g, Functor g) =>
(forall a1. f a1 -> g a1) -> Term f v a -> Term g v a
ABT.transform ((r -> Reference) -> F' r a1 -> F a1
forall r a. (r -> Reference) -> F' r a -> F a
typeF2to1 r -> Reference
convertRef)
    (Term (F' r) Symbol Ann -> Type Symbol Ann)
-> (TypeR r Symbol -> Term (F' r) Symbol Ann)
-> TypeR r Symbol
-> Type Symbol Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Symbol -> Symbol)
-> Term (F' r) Symbol Ann -> Term (F' r) Symbol Ann
forall (f :: * -> *) v' v a.
(Functor f, Foldable f, Ord v') =>
(v -> v') -> Term f v a -> Term f v' a
ABT.vmap Symbol -> Symbol
symbol2to1
    (Term (F' r) Symbol Ann -> Term (F' r) Symbol Ann)
-> (TypeR r Symbol -> Term (F' r) Symbol Ann)
-> TypeR r Symbol
-> Term (F' r) Symbol Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> Ann) -> TypeR r Symbol -> Term (F' r) Symbol Ann
forall (f :: * -> *) a a' v.
Functor f =>
(a -> a') -> Term f v a -> Term f v a'
ABT.amap (Ann -> () -> Ann
forall a b. a -> b -> a
const Ann
Ann.External)
  where
    typeF2to1 :: (r -> V1.Reference) -> V2.Type.F' r a -> (V1.Type.F a)
    typeF2to1 :: forall r a. (r -> Reference) -> F' r a -> F a
typeF2to1 r -> Reference
convertRef = \case
      V2.Type.Ref r
r -> Reference -> F a
forall a. Reference -> F a
V1.Type.Ref (Reference -> F a) -> Reference -> F a
forall a b. (a -> b) -> a -> b
$ r -> Reference
convertRef r
r
      V2.Type.Arrow a
i a
o -> a -> a -> F a
forall a. a -> a -> F a
V1.Type.Arrow a
i a
o
      V2.Type.Ann a
a Kind
k -> a -> Kind -> F a
forall a. a -> Kind -> F a
V1.Type.Ann a
a (Kind -> Kind
convertKind Kind
k)
      V2.Type.App a
f a
x -> a -> a -> F a
forall a. a -> a -> F a
V1.Type.App a
f a
x
      V2.Type.Effect a
e a
b -> a -> a -> F a
forall a. a -> a -> F a
V1.Type.Effect a
e a
b
      V2.Type.Effects [a]
as -> [a] -> F a
forall a. [a] -> F a
V1.Type.Effects [a]
as
      V2.Type.Forall a
a -> a -> F a
forall a. a -> F a
V1.Type.Forall a
a
      V2.Type.IntroOuter a
a -> a -> F a
forall a. a -> F a
V1.Type.IntroOuter a
a
      where
        convertKind :: Kind -> Kind
convertKind = \case
          Kind
V2.Kind.Star -> Kind
V1.Kind.Star
          V2.Kind.Arrow Kind
i Kind
o -> Kind -> Kind -> Kind
V1.Kind.Arrow (Kind -> Kind
convertKind Kind
i) (Kind -> Kind
convertKind Kind
o)

dtype1to2 :: Hash -> V1.Type.Type V1.Symbol a -> V2.Type.TypeD V2.Symbol
dtype1to2 :: forall a. Hash -> Type Symbol a -> TypeR TermRef Symbol
dtype1to2 Hash
h = (Reference -> TermRef) -> Type Symbol a -> TypeR TermRef Symbol
forall r a. (Reference -> r) -> Type Symbol a -> TypeR r Symbol
type1to2' (Hash -> Reference -> TermRef
rreference1to2 Hash
h)

ttype1to2 :: V1.Type.Type V1.Symbol a -> V2.Type.TypeT V2.Symbol
ttype1to2 :: forall a. Type Symbol a -> TypeR Reference Symbol
ttype1to2 = (Reference -> Reference) -> Type Symbol a -> TypeR Reference Symbol
forall r a. (Reference -> r) -> Type Symbol a -> TypeR r Symbol
type1to2' Reference -> Reference
reference1to2

type1to2' :: (V1.Reference -> r) -> V1.Type.Type V1.Symbol a -> V2.Type.TypeR r V2.Symbol
type1to2' :: forall r a. (Reference -> r) -> Type Symbol a -> TypeR r Symbol
type1to2' Reference -> r
convertRef =
  (forall a1. F a1 -> F' r a1)
-> Term F Symbol () -> Term (F' r) Symbol ()
forall v (g :: * -> *) (f :: * -> *) a.
(Ord v, Foldable g, Functor g) =>
(forall a1. f a1 -> g a1) -> Term f v a -> Term g v a
ABT.transform ((Reference -> r) -> F a1 -> F' r a1
forall r a. (Reference -> r) -> F a -> F' r a
typeF1to2' Reference -> r
convertRef)
    (Term F Symbol () -> Term (F' r) Symbol ())
-> (Type Symbol a -> Term F Symbol ())
-> Type Symbol a
-> Term (F' r) Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Symbol -> Symbol) -> Term F Symbol () -> Term F Symbol ()
forall (f :: * -> *) v' v a.
(Functor f, Foldable f, Ord v') =>
(v -> v') -> Term f v a -> Term f v' a
ABT.vmap Symbol -> Symbol
symbol1to2
    (Term F Symbol () -> Term F Symbol ())
-> (Type Symbol a -> Term F Symbol ())
-> Type Symbol a
-> Term F Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ()) -> Type Symbol a -> Term F Symbol ()
forall (f :: * -> *) a a' v.
Functor f =>
(a -> a') -> Term f v a -> Term f v a'
ABT.amap (() -> a -> ()
forall a b. a -> b -> a
const ())
  where
    typeF1to2' :: (V1.Reference -> r) -> V1.Type.F a -> V2.Type.F' r a
    typeF1to2' :: forall r a. (Reference -> r) -> F a -> F' r a
typeF1to2' Reference -> r
convertRef = \case
      V1.Type.Ref Reference
r -> r -> F' r a
forall r a. r -> F' r a
V2.Type.Ref (Reference -> r
convertRef Reference
r)
      V1.Type.Arrow a
i a
o -> a -> a -> F' r a
forall r a. a -> a -> F' r a
V2.Type.Arrow a
i a
o
      V1.Type.Ann a
a Kind
k -> a -> Kind -> F' r a
forall r a. a -> Kind -> F' r a
V2.Type.Ann a
a (Kind -> Kind
convertKind Kind
k)
      V1.Type.App a
f a
x -> a -> a -> F' r a
forall r a. a -> a -> F' r a
V2.Type.App a
f a
x
      V1.Type.Effect a
e a
b -> a -> a -> F' r a
forall r a. a -> a -> F' r a
V2.Type.Effect a
e a
b
      V1.Type.Effects [a]
as -> [a] -> F' r a
forall r a. [a] -> F' r a
V2.Type.Effects [a]
as
      V1.Type.Forall a
a -> a -> F' r a
forall r a. a -> F' r a
V2.Type.Forall a
a
      V1.Type.IntroOuter a
a -> a -> F' r a
forall r a. a -> F' r a
V2.Type.IntroOuter a
a
      where
        convertKind :: Kind -> Kind
convertKind = \case
          Kind
V1.Kind.Star -> Kind
V2.Kind.Star
          V1.Kind.Arrow Kind
i Kind
o -> Kind -> Kind -> Kind
V2.Kind.Arrow (Kind -> Kind
convertKind Kind
i) (Kind -> Kind
convertKind Kind
o)

-- | forces loading v1 branches even if they may not exist
causalbranch2to1 :: (Monad m) => BranchCache m -> (V2.Reference -> m CT.ConstructorType) -> V2.Branch.CausalBranch m -> m (V1.Branch.Branch m)
causalbranch2to1 :: forall (m :: * -> *).
Monad m =>
BranchCache m
-> (Reference -> m ConstructorType)
-> CausalBranch m
-> m (Branch m)
causalbranch2to1 BranchCache m
branchCache Reference -> m ConstructorType
lookupCT CausalBranch m
cb = do
  let ch :: CausalHash
ch = CausalBranch m -> CausalHash
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> hc
V2.causalHash CausalBranch m
cb
  BranchCache m -> CausalHash -> m (Maybe (Branch m))
forall (m :: * -> *).
BranchCache m -> CausalHash -> m (Maybe (Branch m))
lookupCachedBranch BranchCache m
branchCache CausalHash
ch m (Maybe (Branch m))
-> (Maybe (Branch m) -> m (Branch m)) -> m (Branch m)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just Branch m
b -> Branch m -> m (Branch m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Branch m
b
    Maybe (Branch m)
Nothing -> do
      Branch m
b <- UnwrappedBranch m -> Branch m
forall (m :: * -> *). UnwrappedBranch m -> Branch m
V1.Branch.Branch (UnwrappedBranch m -> Branch m)
-> m (UnwrappedBranch m) -> m (Branch m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BranchCache m
-> (Reference -> m ConstructorType)
-> CausalBranch m
-> m (UnwrappedBranch m)
forall (m :: * -> *).
Monad m =>
BranchCache m
-> (Reference -> m ConstructorType)
-> CausalBranch m
-> m (UnwrappedBranch m)
causalbranch2to1' BranchCache m
branchCache Reference -> m ConstructorType
lookupCT CausalBranch m
cb
      BranchCache m -> CausalHash -> Branch m -> m ()
forall (m :: * -> *).
BranchCache m -> CausalHash -> Branch m -> m ()
insertCachedBranch BranchCache m
branchCache CausalHash
ch Branch m
b
      pure Branch m
b

causalbranch2to1' :: (Monad m) => BranchCache m -> (V2.Reference -> m CT.ConstructorType) -> V2.Branch.CausalBranch m -> m (V1.Branch.UnwrappedBranch m)
causalbranch2to1' :: forall (m :: * -> *).
Monad m =>
BranchCache m
-> (Reference -> m ConstructorType)
-> CausalBranch m
-> m (UnwrappedBranch m)
causalbranch2to1' BranchCache m
branchCache Reference -> m ConstructorType
lookupCT (V2.Causal CausalHash
currentHash BranchHash
eh (Map
  CausalHash
  (m (Causal m CausalHash BranchHash (Branch m) (Branch m)))
-> [(CausalHash,
     m (Causal m CausalHash BranchHash (Branch m) (Branch m)))]
forall k a. Map k a -> [(k, a)]
Map.toList -> [(CausalHash,
  m (Causal m CausalHash BranchHash (Branch m) (Branch m)))]
parents) m (Branch m)
me) = do
  let branchHash :: NamespaceHash m
branchHash = BranchHash -> NamespaceHash m
forall (m :: * -> *). BranchHash -> NamespaceHash m
branchHash2to1 BranchHash
eh
  case [(CausalHash,
  m (Causal m CausalHash BranchHash (Branch m) (Branch m)))]
parents of
    [] -> CausalHash -> NamespaceHash m -> Branch0 m -> UnwrappedBranch m
forall (m :: * -> *) e. CausalHash -> HashFor e -> e -> Causal m e
V1.Causal.UnsafeOne CausalHash
currentHash NamespaceHash m
branchHash (Branch0 m -> UnwrappedBranch m)
-> m (Branch0 m) -> m (UnwrappedBranch m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (m (Branch m)
me m (Branch m) -> (Branch m -> m (Branch0 m)) -> m (Branch0 m)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BranchCache m
-> (Reference -> m ConstructorType) -> Branch m -> m (Branch0 m)
forall (m :: * -> *).
Monad m =>
BranchCache m
-> (Reference -> m ConstructorType) -> Branch m -> m (Branch0 m)
branch2to1 BranchCache m
branchCache Reference -> m ConstructorType
lookupCT)
    [(CausalHash
parentHash, m (Causal m CausalHash BranchHash (Branch m) (Branch m))
mp)] -> do
      CausalHash
-> NamespaceHash m
-> Branch0 m
-> (CausalHash, m (UnwrappedBranch m))
-> UnwrappedBranch m
forall (m :: * -> *) e.
CausalHash
-> HashFor e -> e -> (CausalHash, m (Causal m e)) -> Causal m e
V1.Causal.UnsafeCons CausalHash
currentHash NamespaceHash m
branchHash
        (Branch0 m
 -> (CausalHash, m (UnwrappedBranch m)) -> UnwrappedBranch m)
-> m (Branch0 m)
-> m ((CausalHash, m (UnwrappedBranch m)) -> UnwrappedBranch m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (m (Branch m)
me m (Branch m) -> (Branch m -> m (Branch0 m)) -> m (Branch0 m)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BranchCache m
-> (Reference -> m ConstructorType) -> Branch m -> m (Branch0 m)
forall (m :: * -> *).
Monad m =>
BranchCache m
-> (Reference -> m ConstructorType) -> Branch m -> m (Branch0 m)
branch2to1 BranchCache m
branchCache Reference -> m ConstructorType
lookupCT)
        m ((CausalHash, m (UnwrappedBranch m)) -> UnwrappedBranch m)
-> m (CausalHash, m (UnwrappedBranch m)) -> m (UnwrappedBranch m)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (CausalHash, m (UnwrappedBranch m))
-> m (CausalHash, m (UnwrappedBranch m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CausalHash
parentHash, BranchCache m
-> (Reference -> m ConstructorType)
-> Causal m CausalHash BranchHash (Branch m) (Branch m)
-> m (UnwrappedBranch m)
forall (m :: * -> *).
Monad m =>
BranchCache m
-> (Reference -> m ConstructorType)
-> CausalBranch m
-> m (UnwrappedBranch m)
causalbranch2to1' BranchCache m
branchCache Reference -> m ConstructorType
lookupCT (Causal m CausalHash BranchHash (Branch m) (Branch m)
 -> m (UnwrappedBranch m))
-> m (Causal m CausalHash BranchHash (Branch m) (Branch m))
-> m (UnwrappedBranch m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (Causal m CausalHash BranchHash (Branch m) (Branch m))
mp)
    [(CausalHash,
  m (Causal m CausalHash BranchHash (Branch m) (Branch m)))]
merge -> do
      let tailsList :: [(CausalHash, m (UnwrappedBranch m))]
tailsList = ((CausalHash,
  m (Causal m CausalHash BranchHash (Branch m) (Branch m)))
 -> (CausalHash, m (UnwrappedBranch m)))
-> [(CausalHash,
     m (Causal m CausalHash BranchHash (Branch m) (Branch m)))]
-> [(CausalHash, m (UnwrappedBranch m))]
forall a b. (a -> b) -> [a] -> [b]
map ((m (Causal m CausalHash BranchHash (Branch m) (Branch m))
 -> m (UnwrappedBranch m))
-> (CausalHash,
    m (Causal m CausalHash BranchHash (Branch m) (Branch m)))
-> (CausalHash, m (UnwrappedBranch m))
forall a b. (a -> b) -> (CausalHash, a) -> (CausalHash, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (BranchCache m
-> (Reference -> m ConstructorType)
-> Causal m CausalHash BranchHash (Branch m) (Branch m)
-> m (UnwrappedBranch m)
forall (m :: * -> *).
Monad m =>
BranchCache m
-> (Reference -> m ConstructorType)
-> CausalBranch m
-> m (UnwrappedBranch m)
causalbranch2to1' BranchCache m
branchCache Reference -> m ConstructorType
lookupCT (Causal m CausalHash BranchHash (Branch m) (Branch m)
 -> m (UnwrappedBranch m))
-> m (Causal m CausalHash BranchHash (Branch m) (Branch m))
-> m (UnwrappedBranch m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)) [(CausalHash,
  m (Causal m CausalHash BranchHash (Branch m) (Branch m)))]
merge
      Branch m
e <- m (Branch m)
me
      CausalHash
-> NamespaceHash m
-> Branch0 m
-> Map CausalHash (m (UnwrappedBranch m))
-> UnwrappedBranch m
forall (m :: * -> *) e.
CausalHash
-> HashFor e -> e -> Map CausalHash (m (Causal m e)) -> Causal m e
V1.Causal.UnsafeMerge CausalHash
currentHash NamespaceHash m
branchHash (Branch0 m
 -> Map CausalHash (m (UnwrappedBranch m)) -> UnwrappedBranch m)
-> m (Branch0 m)
-> m (Map CausalHash (m (UnwrappedBranch m)) -> UnwrappedBranch m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BranchCache m
-> (Reference -> m ConstructorType) -> Branch m -> m (Branch0 m)
forall (m :: * -> *).
Monad m =>
BranchCache m
-> (Reference -> m ConstructorType) -> Branch m -> m (Branch0 m)
branch2to1 BranchCache m
branchCache Reference -> m ConstructorType
lookupCT Branch m
e m (Map CausalHash (m (UnwrappedBranch m)) -> UnwrappedBranch m)
-> m (Map CausalHash (m (UnwrappedBranch m)))
-> m (UnwrappedBranch m)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map CausalHash (m (UnwrappedBranch m))
-> m (Map CausalHash (m (UnwrappedBranch m)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(CausalHash, m (UnwrappedBranch m))]
-> Map CausalHash (m (UnwrappedBranch m))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(CausalHash, m (UnwrappedBranch m))]
tailsList)

causalbranch1to2 :: forall m. (Monad m) => V1.Branch.Branch m -> V2.Branch.CausalBranch m
causalbranch1to2 :: forall (m :: * -> *). Monad m => Branch m -> CausalBranch m
causalbranch1to2 (V1.Branch.Branch UnwrappedBranch m
c) =
  (HashFor (Branch0 m) -> BranchHash)
-> (Branch0 m -> m (Branch m))
-> UnwrappedBranch m
-> Causal m CausalHash BranchHash (Branch m) (Branch m)
forall (m :: * -> *) h2e e e2.
Monad m =>
(HashFor e -> h2e)
-> (e -> m e2) -> Causal m e -> Causal m CausalHash h2e e2 e2
causal1to2 HashFor (Branch0 m) -> BranchHash
forall (m :: * -> *). NamespaceHash m -> BranchHash
branchHash1to2 Branch0 m -> m (Branch m)
forall (m :: * -> *). Monad m => Branch0 m -> m (Branch m)
branch1to2 UnwrappedBranch m
c
  where
    causal1to2 :: forall m h2e e e2. (Monad m) => (V1.HashFor e -> h2e) -> (e -> m e2) -> V1.Causal.Causal m e -> V2.Causal m CausalHash h2e e2 e2
    causal1to2 :: forall (m :: * -> *) h2e e e2.
Monad m =>
(HashFor e -> h2e)
-> (e -> m e2) -> Causal m e -> Causal m CausalHash h2e e2 e2
causal1to2 HashFor e -> h2e
eh1to2 e -> m e2
e1to2 = \case
      V1.Causal.One CausalHash
hc HashFor e
eh e
e -> CausalHash
-> h2e
-> Map CausalHash (m (Causal m CausalHash h2e e2 e2))
-> m e2
-> Causal m CausalHash h2e e2 e2
forall (m :: * -> *) hc he pe e.
hc
-> he
-> Map hc (m (Causal m hc he pe pe))
-> m e
-> Causal m hc he pe e
V2.Causal CausalHash
hc (HashFor e -> h2e
eh1to2 HashFor e
eh) Map CausalHash (m (Causal m CausalHash h2e e2 e2))
forall k a. Map k a
Map.empty (e -> m e2
e1to2 e
e)
      V1.Causal.Cons CausalHash
hc HashFor e
eh e
e (CausalHash
ht, m (Causal m e)
mt) -> CausalHash
-> h2e
-> Map CausalHash (m (Causal m CausalHash h2e e2 e2))
-> m e2
-> Causal m CausalHash h2e e2 e2
forall (m :: * -> *) hc he pe e.
hc
-> he
-> Map hc (m (Causal m hc he pe pe))
-> m e
-> Causal m hc he pe e
V2.Causal CausalHash
hc (HashFor e -> h2e
eh1to2 HashFor e
eh) (CausalHash
-> m (Causal m CausalHash h2e e2 e2)
-> Map CausalHash (m (Causal m CausalHash h2e e2 e2))
forall k a. k -> a -> Map k a
Map.singleton CausalHash
ht ((HashFor e -> h2e)
-> (e -> m e2) -> Causal m e -> Causal m CausalHash h2e e2 e2
forall (m :: * -> *) h2e e e2.
Monad m =>
(HashFor e -> h2e)
-> (e -> m e2) -> Causal m e -> Causal m CausalHash h2e e2 e2
causal1to2 HashFor e -> h2e
eh1to2 e -> m e2
e1to2 (Causal m e -> Causal m CausalHash h2e e2 e2)
-> m (Causal m e) -> m (Causal m CausalHash h2e e2 e2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Causal m e)
mt)) (e -> m e2
e1to2 e
e)
      V1.Causal.Merge CausalHash
hc HashFor e
eh e
e Map CausalHash (m (Causal m e))
parents -> CausalHash
-> h2e
-> Map CausalHash (m (Causal m CausalHash h2e e2 e2))
-> m e2
-> Causal m CausalHash h2e e2 e2
forall (m :: * -> *) hc he pe e.
hc
-> he
-> Map hc (m (Causal m hc he pe pe))
-> m e
-> Causal m hc he pe e
V2.Causal CausalHash
hc (HashFor e -> h2e
eh1to2 HashFor e
eh) ((m (Causal m e) -> m (Causal m CausalHash h2e e2 e2))
-> Map CausalHash (m (Causal m e))
-> Map CausalHash (m (Causal m CausalHash h2e e2 e2))
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((HashFor e -> h2e)
-> (e -> m e2) -> Causal m e -> Causal m CausalHash h2e e2 e2
forall (m :: * -> *) h2e e e2.
Monad m =>
(HashFor e -> h2e)
-> (e -> m e2) -> Causal m e -> Causal m CausalHash h2e e2 e2
causal1to2 HashFor e -> h2e
eh1to2 e -> m e2
e1to2 (Causal m e -> Causal m CausalHash h2e e2 e2)
-> m (Causal m e) -> m (Causal m CausalHash h2e e2 e2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) Map CausalHash (m (Causal m e))
parents) (e -> m e2
e1to2 e
e)

    -- todo: this could be a pure function
    branch1to2 :: forall m. (Monad m) => V1.Branch.Branch0 m -> m (V2.Branch.Branch m)
    branch1to2 :: forall (m :: * -> *). Monad m => Branch0 m -> m (Branch m)
branch1to2 Branch0 m
b =
      Branch m -> m (Branch m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Branch m -> m (Branch m)) -> Branch m -> m (Branch m)
forall a b. (a -> b) -> a -> b
$
        Map NameSegment (Map (Referent' Reference Reference) (m MdValues))
-> Map NameSegment (Map Reference (m MdValues))
-> Map NameSegment (PatchHash, m Patch)
-> Map NameSegment (CausalBranch m)
-> Branch m
forall (m :: * -> *).
Map NameSegment (Map (Referent' Reference Reference) (m MdValues))
-> Map NameSegment (Map Reference (m MdValues))
-> Map NameSegment (PatchHash, m Patch)
-> Map NameSegment (CausalBranch m)
-> Branch m
V2.Branch.Branch
          (Star Referent NameSegment
-> Map
     NameSegment (Map (Referent' Reference Reference) (m MdValues))
doTerms (Branch0 m
b Branch0 m
-> Getting
     (Star Referent NameSegment) (Branch0 m) (Star Referent NameSegment)
-> Star Referent NameSegment
forall s a. s -> Getting a s a -> a
^. Getting
  (Star Referent NameSegment) (Branch0 m) (Star Referent NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star Referent NameSegment -> f (Star Referent NameSegment))
-> Branch0 m -> f (Branch0 m)
Branch.terms))
          (Star Reference NameSegment
-> Map NameSegment (Map Reference (m MdValues))
doTypes (Branch0 m
b Branch0 m
-> Getting
     (Star Reference NameSegment)
     (Branch0 m)
     (Star Reference NameSegment)
-> Star Reference NameSegment
forall s a. s -> Getting a s a -> a
^. Getting
  (Star Reference NameSegment)
  (Branch0 m)
  (Star Reference NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star Reference NameSegment -> f (Star Reference NameSegment))
-> Branch0 m -> f (Branch0 m)
Branch.types))
          (Map NameSegment (PatchHash, m Patch)
-> Map NameSegment (PatchHash, m Patch)
doPatches (Branch0 m
b Branch0 m
-> Getting
     (Map NameSegment (PatchHash, m Patch))
     (Branch0 m)
     (Map NameSegment (PatchHash, m Patch))
-> Map NameSegment (PatchHash, m Patch)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map NameSegment (PatchHash, m Patch))
  (Branch0 m)
  (Map NameSegment (PatchHash, m Patch))
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Map NameSegment (PatchHash, m Patch)
 -> f (Map NameSegment (PatchHash, m Patch)))
-> Branch0 m -> f (Branch0 m)
Branch.edits))
          (Map NameSegment (Branch m) -> Map NameSegment (CausalBranch m)
doChildren (Branch0 m
b Branch0 m
-> Getting
     (Map NameSegment (Branch m))
     (Branch0 m)
     (Map NameSegment (Branch m))
-> Map NameSegment (Branch m)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map NameSegment (Branch m))
  (Branch0 m)
  (Map NameSegment (Branch m))
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Branch0 m -> f (Branch0 m)
Branch.children))
      where
        -- is there a more readable way to structure these that's also linear?
        doTerms :: V1.Branch.Star V1.Referent.Referent NameSegment -> Map NameSegment (Map V2.Referent.Referent (m V2.Branch.MdValues))
        doTerms :: Star Referent NameSegment
-> Map
     NameSegment (Map (Referent' Reference Reference) (m MdValues))
doTerms Star Referent NameSegment
s =
          [(NameSegment, Map (Referent' Reference Reference) (m MdValues))]
-> Map
     NameSegment (Map (Referent' Reference Reference) (m MdValues))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
            [ (NameSegment
ns, Map (Referent' Reference Reference) (m MdValues)
m2)
              | NameSegment
ns <- Set NameSegment -> [NameSegment]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set NameSegment -> [NameSegment])
-> (Relation Referent NameSegment -> Set NameSegment)
-> Relation Referent NameSegment
-> [NameSegment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation Referent NameSegment -> Set NameSegment
forall a b. Relation a b -> Set b
Relation.ran (Relation Referent NameSegment -> [NameSegment])
-> Relation Referent NameSegment -> [NameSegment]
forall a b. (a -> b) -> a -> b
$ Star Referent NameSegment -> Relation Referent NameSegment
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d1
V1.Star2.d1 Star Referent NameSegment
s,
                let m2 :: Map (Referent' Reference Reference) (m MdValues)
m2 =
                      [(Referent' Reference Reference, m MdValues)]
-> Map (Referent' Reference Reference) (m MdValues)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                        [ (Referent -> Referent' Reference Reference
referent1to2 Referent
r, MdValues -> m MdValues
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MdValues
md)
                          | Referent
r <- Set Referent -> [Referent]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set Referent -> [Referent])
-> (Relation Referent NameSegment -> Set Referent)
-> Relation Referent NameSegment
-> [Referent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSegment -> Relation Referent NameSegment -> Set Referent
forall b a. Ord b => b -> Relation a b -> Set a
Relation.lookupRan NameSegment
ns (Relation Referent NameSegment -> [Referent])
-> Relation Referent NameSegment -> [Referent]
forall a b. (a -> b) -> a -> b
$ Star Referent NameSegment -> Relation Referent NameSegment
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d1
V1.Star2.d1 Star Referent NameSegment
s,
                            let md :: MdValues
md = Set Reference -> MdValues
V2.Branch.MdValues (Set Reference -> MdValues)
-> (Relation Referent Reference -> Set Reference)
-> Relation Referent Reference
-> MdValues
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reference -> Reference) -> Set Reference -> Set Reference
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Reference -> Reference
reference1to2 (Set Reference -> Set Reference)
-> (Relation Referent Reference -> Set Reference)
-> Relation Referent Reference
-> Set Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Referent -> Relation Referent Reference -> Set Reference
forall a b. Ord a => a -> Relation a b -> Set b
Relation.lookupDom Referent
r (Relation Referent Reference -> MdValues)
-> Relation Referent Reference -> MdValues
forall a b. (a -> b) -> a -> b
$ Star Referent NameSegment -> Relation Referent Reference
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d2
V1.Star2.d2 Star Referent NameSegment
s
                        ]
            ]

        doTypes :: V1.Branch.Star V1.Reference.Reference NameSegment -> Map NameSegment (Map V2.Reference.Reference (m V2.Branch.MdValues))
        doTypes :: Star Reference NameSegment
-> Map NameSegment (Map Reference (m MdValues))
doTypes Star Reference NameSegment
s =
          [(NameSegment, Map Reference (m MdValues))]
-> Map NameSegment (Map Reference (m MdValues))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
            [ (NameSegment
ns, Map Reference (m MdValues)
m2)
              | NameSegment
ns <- Set NameSegment -> [NameSegment]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set NameSegment -> [NameSegment])
-> (Relation Reference NameSegment -> Set NameSegment)
-> Relation Reference NameSegment
-> [NameSegment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation Reference NameSegment -> Set NameSegment
forall a b. Relation a b -> Set b
Relation.ran (Relation Reference NameSegment -> [NameSegment])
-> Relation Reference NameSegment -> [NameSegment]
forall a b. (a -> b) -> a -> b
$ Star Reference NameSegment -> Relation Reference NameSegment
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d1
V1.Star2.d1 Star Reference NameSegment
s,
                let m2 :: Map Reference (m MdValues)
m2 =
                      [(Reference, m MdValues)] -> Map Reference (m MdValues)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                        [ (Reference -> Reference
reference1to2 Reference
r, MdValues -> m MdValues
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MdValues
md)
                          | Reference
r <- Set Reference -> [Reference]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set Reference -> [Reference])
-> (Relation Reference NameSegment -> Set Reference)
-> Relation Reference NameSegment
-> [Reference]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSegment -> Relation Reference NameSegment -> Set Reference
forall b a. Ord b => b -> Relation a b -> Set a
Relation.lookupRan NameSegment
ns (Relation Reference NameSegment -> [Reference])
-> Relation Reference NameSegment -> [Reference]
forall a b. (a -> b) -> a -> b
$ Star Reference NameSegment -> Relation Reference NameSegment
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d1
V1.Star2.d1 Star Reference NameSegment
s,
                            let md :: MdValues
md = Set Reference -> MdValues
V2.Branch.MdValues (Set Reference -> MdValues)
-> (Relation Reference Reference -> Set Reference)
-> Relation Reference Reference
-> MdValues
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reference -> Reference) -> Set Reference -> Set Reference
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Reference -> Reference
reference1to2 (Set Reference -> Set Reference)
-> (Relation Reference Reference -> Set Reference)
-> Relation Reference Reference
-> Set Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Relation Reference Reference -> Set Reference
forall a b. Ord a => a -> Relation a b -> Set b
Relation.lookupDom Reference
r (Relation Reference Reference -> MdValues)
-> Relation Reference Reference -> MdValues
forall a b. (a -> b) -> a -> b
$ Star Reference NameSegment -> Relation Reference Reference
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d2
V1.Star2.d2 Star Reference NameSegment
s
                        ]
            ]

        doPatches :: Map NameSegment (PatchHash, m V1.Patch) -> Map NameSegment (PatchHash, m V2.Branch.Patch)
        doPatches :: Map NameSegment (PatchHash, m Patch)
-> Map NameSegment (PatchHash, m Patch)
doPatches = ((PatchHash, m Patch) -> (PatchHash, m Patch))
-> Map NameSegment (PatchHash, m Patch)
-> Map NameSegment (PatchHash, m Patch)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((m Patch -> m Patch)
-> (PatchHash, m Patch) -> (PatchHash, m Patch)
forall a b. (a -> b) -> (PatchHash, a) -> (PatchHash, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Patch -> Patch) -> m Patch -> m Patch
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Patch -> Patch
patch1to2))

        doChildren :: Map NameSegment (V1.Branch.Branch m) -> Map NameSegment (V2.Branch.CausalBranch m)
        doChildren :: Map NameSegment (Branch m) -> Map NameSegment (CausalBranch m)
doChildren = (Branch m -> CausalBranch m)
-> Map NameSegment (Branch m) -> Map NameSegment (CausalBranch m)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Branch m -> CausalBranch m
forall (m :: * -> *). Monad m => Branch m -> CausalBranch m
causalbranch1to2

patch2to1 :: V2.Branch.Patch -> V1.Patch
patch2to1 :: Patch -> Patch
patch2to1 (V2.Branch.Patch Map (Referent' Reference Reference) (Set TermEdit)
v2termedits Map Reference (Set TypeEdit)
v2typeedits) =
  Relation Reference TermEdit -> Relation Reference TypeEdit -> Patch
V1.Patch (Map Reference (Set TermEdit) -> Relation Reference TermEdit
forall a b. (Ord a, Ord b) => Map a (Set b) -> Relation a b
Relation.fromMultimap Map Reference (Set TermEdit)
termEdits) (Map Reference (Set TypeEdit) -> Relation Reference TypeEdit
forall a b. (Ord a, Ord b) => Map a (Set b) -> Relation a b
Relation.fromMultimap Map Reference (Set TypeEdit)
typeEdits)
  where
    termEdits :: Map Reference (Set TermEdit)
termEdits = (Referent' Reference Reference -> Reference)
-> (Set TermEdit -> Set TermEdit)
-> Map (Referent' Reference Reference) (Set TermEdit)
-> Map Reference (Set TermEdit)
forall a' a b b'.
Ord a' =>
(a -> a') -> (b -> b') -> Map a b -> Map a' b'
Map.bimap Referent' Reference Reference -> Reference
referent2to1' ((TermEdit -> TermEdit) -> Set TermEdit -> Set TermEdit
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map TermEdit -> TermEdit
termedit2to1) Map (Referent' Reference Reference) (Set TermEdit)
v2termedits
    typeEdits :: Map Reference (Set TypeEdit)
typeEdits = (Reference -> Reference)
-> (Set TypeEdit -> Set TypeEdit)
-> Map Reference (Set TypeEdit)
-> Map Reference (Set TypeEdit)
forall a' a b b'.
Ord a' =>
(a -> a') -> (b -> b') -> Map a b -> Map a' b'
Map.bimap Reference -> Reference
reference2to1 ((TypeEdit -> TypeEdit) -> Set TypeEdit -> Set TypeEdit
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map TypeEdit -> TypeEdit
typeedit2to1) Map Reference (Set TypeEdit)
v2typeedits
    referent2to1' :: V2.Referent -> V1.Reference
    referent2to1' :: Referent' Reference Reference -> Reference
referent2to1' = \case
      V2.Referent.Ref Reference
r -> Reference -> Reference
reference2to1 Reference
r
      V2.Referent.Con {} -> [Char] -> Reference
forall a. HasCallStack => [Char] -> a
error [Char]
"found referent on LHS when converting patch2to1"
    termedit2to1 :: V2.TermEdit.TermEdit -> V1.TermEdit.TermEdit
    termedit2to1 :: TermEdit -> TermEdit
termedit2to1 = \case
      V2.TermEdit.Replace (V2.Referent.Ref Reference
r) Typing
t ->
        Reference -> Typing -> TermEdit
V1.TermEdit.Replace (Reference -> Reference
reference2to1 Reference
r) (Typing -> Typing
typing2to1 Typing
t)
      V2.TermEdit.Replace {} -> [Char] -> TermEdit
forall a. HasCallStack => [Char] -> a
error [Char]
"found referent on RHS when converting patch2to1"
      TermEdit
V2.TermEdit.Deprecate -> TermEdit
V1.TermEdit.Deprecate
    typeedit2to1 :: V2.TypeEdit.TypeEdit -> V1.TypeEdit.TypeEdit
    typeedit2to1 :: TypeEdit -> TypeEdit
typeedit2to1 = \case
      V2.TypeEdit.Replace Reference
r -> Reference -> TypeEdit
V1.TypeEdit.Replace (Reference -> Reference
reference2to1 Reference
r)
      TypeEdit
V2.TypeEdit.Deprecate -> TypeEdit
V1.TypeEdit.Deprecate
    typing2to1 :: Typing -> Typing
typing2to1 Typing
t = case Typing
t of
      Typing
V2.TermEdit.Same -> Typing
V1.TermEdit.Same
      Typing
V2.TermEdit.Subtype -> Typing
V1.TermEdit.Subtype
      Typing
V2.TermEdit.Different -> Typing
V1.TermEdit.Different

patch1to2 :: V1.Patch -> V2.Branch.Patch
patch1to2 :: Patch -> Patch
patch1to2 (V1.Patch Relation Reference TermEdit
v1termedits Relation Reference TypeEdit
v1typeedits) = Map (Referent' Reference Reference) (Set TermEdit)
-> Map Reference (Set TypeEdit) -> Patch
V2.Branch.Patch Map (Referent' Reference Reference) (Set TermEdit)
v2termedits Map Reference (Set TypeEdit)
v2typeedits
  where
    v2termedits :: Map (Referent' Reference Reference) (Set TermEdit)
v2termedits = (Reference -> Referent' Reference Reference)
-> (Set TermEdit -> Set TermEdit)
-> Map Reference (Set TermEdit)
-> Map (Referent' Reference Reference) (Set TermEdit)
forall a' a b b'.
Ord a' =>
(a -> a') -> (b -> b') -> Map a b -> Map a' b'
Map.bimap (Reference -> Referent' Reference Reference
forall termRef typeRef. termRef -> Referent' termRef typeRef
V2.Referent.Ref (Reference -> Referent' Reference Reference)
-> (Reference -> Reference)
-> Reference
-> Referent' Reference Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Reference
reference1to2) ((TermEdit -> TermEdit) -> Set TermEdit -> Set TermEdit
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map TermEdit -> TermEdit
termedit1to2) (Map Reference (Set TermEdit)
 -> Map (Referent' Reference Reference) (Set TermEdit))
-> Map Reference (Set TermEdit)
-> Map (Referent' Reference Reference) (Set TermEdit)
forall a b. (a -> b) -> a -> b
$ Relation Reference TermEdit -> Map Reference (Set TermEdit)
forall a b. Relation a b -> Map a (Set b)
Relation.domain Relation Reference TermEdit
v1termedits
    v2typeedits :: Map Reference (Set TypeEdit)
v2typeedits = (Reference -> Reference)
-> (Set TypeEdit -> Set TypeEdit)
-> Map Reference (Set TypeEdit)
-> Map Reference (Set TypeEdit)
forall a' a b b'.
Ord a' =>
(a -> a') -> (b -> b') -> Map a b -> Map a' b'
Map.bimap Reference -> Reference
reference1to2 ((TypeEdit -> TypeEdit) -> Set TypeEdit -> Set TypeEdit
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map TypeEdit -> TypeEdit
typeedit1to2) (Map Reference (Set TypeEdit) -> Map Reference (Set TypeEdit))
-> Map Reference (Set TypeEdit) -> Map Reference (Set TypeEdit)
forall a b. (a -> b) -> a -> b
$ Relation Reference TypeEdit -> Map Reference (Set TypeEdit)
forall a b. Relation a b -> Map a (Set b)
Relation.domain Relation Reference TypeEdit
v1typeedits
    termedit1to2 :: V1.TermEdit.TermEdit -> V2.TermEdit.TermEdit
    termedit1to2 :: TermEdit -> TermEdit
termedit1to2 = \case
      V1.TermEdit.Replace Reference
r Typing
t -> Referent' Reference Reference -> Typing -> TermEdit
V2.TermEdit.Replace (Reference -> Referent' Reference Reference
forall termRef typeRef. termRef -> Referent' termRef typeRef
V2.Referent.Ref (Reference -> Reference
reference1to2 Reference
r)) (Typing -> Typing
typing1to2 Typing
t)
      TermEdit
V1.TermEdit.Deprecate -> TermEdit
V2.TermEdit.Deprecate
    typeedit1to2 :: V1.TypeEdit.TypeEdit -> V2.TypeEdit.TypeEdit
    typeedit1to2 :: TypeEdit -> TypeEdit
typeedit1to2 = \case
      V1.TypeEdit.Replace Reference
r -> Reference -> TypeEdit
V2.TypeEdit.Replace (Reference -> Reference
reference1to2 Reference
r)
      TypeEdit
V1.TypeEdit.Deprecate -> TypeEdit
V2.TypeEdit.Deprecate
    typing1to2 :: Typing -> Typing
typing1to2 = \case
      Typing
V1.TermEdit.Same -> Typing
V2.TermEdit.Same
      Typing
V1.TermEdit.Subtype -> Typing
V2.TermEdit.Subtype
      Typing
V1.TermEdit.Different -> Typing
V2.TermEdit.Different

branch2to1 ::
  (Monad m) =>
  BranchCache m ->
  (V2.Reference -> m CT.ConstructorType) ->
  V2.Branch.Branch m ->
  m (V1.Branch.Branch0 m)
branch2to1 :: forall (m :: * -> *).
Monad m =>
BranchCache m
-> (Reference -> m ConstructorType) -> Branch m -> m (Branch0 m)
branch2to1 BranchCache m
branchCache Reference -> m ConstructorType
lookupCT (V2.Branch.Branch Map NameSegment (Map (Referent' Reference Reference) (m MdValues))
v2terms Map NameSegment (Map Reference (m MdValues))
v2types Map NameSegment (PatchHash, m Patch)
v2patches Map NameSegment (CausalBranch m)
v2children) = do
  Star Referent NameSegment
v1terms <- (Reference -> Reference)
-> Map NameSegment (Map Referent MdValues)
-> Star Referent NameSegment
forall name ref.
(Ord name, Ord ref) =>
(Reference -> Reference)
-> Map name (Map ref MdValues) -> Star ref name
toStar Reference -> Reference
reference2to1 (Map NameSegment (Map Referent MdValues)
 -> Star Referent NameSegment)
-> m (Map NameSegment (Map Referent MdValues))
-> m (Star Referent NameSegment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Map (Referent' Reference Reference) (m MdValues)
 -> m (Map Referent MdValues))
-> Map
     NameSegment (Map (Referent' Reference Reference) (m MdValues))
-> m (Map NameSegment (Map Referent MdValues))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map NameSegment a -> f (Map NameSegment b)
traverse ((Referent' Reference Reference -> m Referent)
-> (m MdValues -> m MdValues)
-> Map (Referent' Reference Reference) (m MdValues)
-> m (Map Referent MdValues)
forall (f :: * -> *) a' a b b'.
(Applicative f, Ord a') =>
(a -> f a') -> (b -> f b') -> Map a b -> f (Map a' b')
Map.bitraverse ((Reference -> m ConstructorType)
-> Referent' Reference Reference -> m Referent
forall (m :: * -> *).
Applicative m =>
(Reference -> m ConstructorType)
-> Referent' Reference Reference -> m Referent
referent2to1 Reference -> m ConstructorType
lookupCT) m MdValues -> m MdValues
forall a. a -> a
id) Map NameSegment (Map (Referent' Reference Reference) (m MdValues))
v2terms
  Star Reference NameSegment
v1types <- (Reference -> Reference)
-> Map NameSegment (Map Reference MdValues)
-> Star Reference NameSegment
forall name ref.
(Ord name, Ord ref) =>
(Reference -> Reference)
-> Map name (Map ref MdValues) -> Star ref name
toStar Reference -> Reference
reference2to1 (Map NameSegment (Map Reference MdValues)
 -> Star Reference NameSegment)
-> m (Map NameSegment (Map Reference MdValues))
-> m (Star Reference NameSegment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Map Reference (m MdValues) -> m (Map Reference MdValues))
-> Map NameSegment (Map Reference (m MdValues))
-> m (Map NameSegment (Map Reference MdValues))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map NameSegment a -> f (Map NameSegment b)
traverse ((Reference -> m Reference)
-> (m MdValues -> m MdValues)
-> Map Reference (m MdValues)
-> m (Map Reference MdValues)
forall (f :: * -> *) a' a b b'.
(Applicative f, Ord a') =>
(a -> f a') -> (b -> f b') -> Map a b -> f (Map a' b')
Map.bitraverse (Reference -> m Reference
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Reference -> m Reference)
-> (Reference -> Reference) -> Reference -> m Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Reference
reference2to1) m MdValues -> m MdValues
forall a. a -> a
id) Map NameSegment (Map Reference (m MdValues))
v2types
  Map NameSegment (Branch m)
v1children <- (CausalBranch m -> m (Branch m))
-> Map NameSegment (CausalBranch m)
-> m (Map NameSegment (Branch m))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map NameSegment a -> f (Map NameSegment b)
traverse (BranchCache m
-> (Reference -> m ConstructorType)
-> CausalBranch m
-> m (Branch m)
forall (m :: * -> *).
Monad m =>
BranchCache m
-> (Reference -> m ConstructorType)
-> CausalBranch m
-> m (Branch m)
causalbranch2to1 BranchCache m
branchCache Reference -> m ConstructorType
lookupCT) Map NameSegment (CausalBranch m)
v2children
  pure $ Star Referent NameSegment
-> Star Reference NameSegment
-> Map NameSegment (Branch m)
-> Map NameSegment (PatchHash, m Patch)
-> Branch0 m
forall (m :: * -> *).
Star Referent NameSegment
-> Star Reference NameSegment
-> Map NameSegment (Branch m)
-> Map NameSegment (PatchHash, m Patch)
-> Branch0 m
V1.Branch.branch0 Star Referent NameSegment
v1terms Star Reference NameSegment
v1types Map NameSegment (Branch m)
v1children Map NameSegment (PatchHash, m Patch)
v1patches
  where
    v1patches :: Map NameSegment (PatchHash, m Patch)
v1patches = ((PatchHash, m Patch) -> (PatchHash, m Patch))
-> Map NameSegment (PatchHash, m Patch)
-> Map NameSegment (PatchHash, m Patch)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((m Patch -> m Patch)
-> (PatchHash, m Patch) -> (PatchHash, m Patch)
forall a b. (a -> b) -> (PatchHash, a) -> (PatchHash, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Patch -> Patch) -> m Patch -> m Patch
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Patch -> Patch
patch2to1)) Map NameSegment (PatchHash, m Patch)
v2patches
    toStar :: forall name ref. (Ord name, Ord ref) => (V2.Reference -> V1.Reference) -> Map name (Map ref V2.Branch.MdValues) -> V1.Metadata.Star ref name
    toStar :: forall name ref.
(Ord name, Ord ref) =>
(Reference -> Reference)
-> Map name (Map ref MdValues) -> Star ref name
toStar Reference -> Reference
mdref2to1 Map name (Map ref MdValues)
m = (Star ref name -> (name, Map ref MdValues) -> Star ref name)
-> Star ref name -> [(name, Map ref MdValues)] -> Star ref name
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Star ref name -> (name, Map ref MdValues) -> Star ref name
insert Star ref name
forall a. Monoid a => a
mempty (Map name (Map ref MdValues) -> [(name, Map ref MdValues)]
forall k a. Map k a -> [(k, a)]
Map.toList Map name (Map ref MdValues)
m)
      where
        insert :: Star ref name -> (name, Map ref MdValues) -> Star ref name
insert Star ref name
star (name
name, Map ref MdValues
m) = (Star ref name -> (ref, MdValues) -> Star ref name)
-> Star ref name -> [(ref, MdValues)] -> Star ref name
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (name -> Star ref name -> (ref, MdValues) -> Star ref name
insert' name
name) Star ref name
star (Map ref MdValues -> [(ref, MdValues)]
forall k a. Map k a -> [(k, a)]
Map.toList Map ref MdValues
m)
        insert' :: name -> V1.Metadata.Star ref name -> (ref, V2.Branch.MdValues) -> V1.Metadata.Star ref name
        insert' :: name -> Star ref name -> (ref, MdValues) -> Star ref name
insert' name
name Star ref name
star (ref
ref, V2.Branch.MdValues Set Reference
mdvals) =
          let facts :: Set ref
facts = ref -> Set ref
forall a. a -> Set a
Set.singleton ref
ref
              names :: Relation ref name
names = ref -> name -> Relation ref name
forall a b. a -> b -> Relation a b
Relation.singleton ref
ref name
name
              Relation ref Reference
vals :: Relation.Relation ref V1.Metadata.Value =
                ref
-> [Reference] -> Relation ref Reference -> Relation ref Reference
forall (f :: * -> *) a b.
(Foldable f, Ord a, Ord b) =>
a -> f b -> Relation a b -> Relation a b
Relation.insertManyRan ref
ref ((Reference -> Reference) -> [Reference] -> [Reference]
forall a b. (a -> b) -> [a] -> [b]
map Reference -> Reference
mdref2to1 (Set Reference -> [Reference]
forall a. Set a -> [a]
Set.toList Set Reference
mdvals)) Relation ref Reference
forall a. Monoid a => a
mempty
           in Star ref name
star Star ref name -> Star ref name -> Star ref name
forall a. Semigroup a => a -> a -> a
<> Set ref
-> Relation ref name -> Relation ref Reference -> Star ref name
forall fact d1 d2.
Set fact
-> Relation fact d1 -> Relation fact d2 -> Star2 fact d1 d2
V1.Star2.Star2 Set ref
facts Relation ref name
names Relation ref Reference
vals

-- | Generates a v1 short hash from a v2 referent.
-- Also shortens the hash to the provided length. If 'Nothing', it will include the full
-- length hash.
referent2toshorthash1 :: Maybe Int -> V2.Referent -> ShortHash
referent2toshorthash1 :: Maybe Int -> Referent' Reference Reference -> ShortHash
referent2toshorthash1 Maybe Int
hashLength Referent' Reference Reference
ref =
  (ShortHash -> ShortHash)
-> (Int -> ShortHash -> ShortHash)
-> Maybe Int
-> ShortHash
-> ShortHash
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ShortHash -> ShortHash
forall a. a -> a
id Int -> ShortHash -> ShortHash
ShortHash.shortenTo Maybe Int
hashLength (ShortHash -> ShortHash) -> ShortHash -> ShortHash
forall a b. (a -> b) -> a -> b
$ case Referent' Reference Reference
ref of
    V2.Referent.Ref Reference
r -> Maybe Int -> Reference -> ShortHash
reference2toshorthash1 Maybe Int
hashLength Reference
r
    V2.Referent.Con Reference
r Pos
conId ->
      case Maybe Int -> Reference -> ShortHash
reference2toshorthash1 Maybe Int
hashLength Reference
r of
        ShortHash.ShortHash Text
h Maybe Pos
p Maybe Pos
_con -> Text -> Maybe Pos -> Maybe Pos -> ShortHash
ShortHash.ShortHash Text
h Maybe Pos
p (Pos -> Maybe Pos
forall a. a -> Maybe a
Just Pos
conId)
        sh :: ShortHash
sh@(ShortHash.Builtin {}) -> ShortHash
sh

-- | Generates a v1 short hash from a v2 reference.
-- Also shortens the hash to the provided length. If 'Nothing', it will include the full
-- length hash.
reference2toshorthash1 :: Maybe Int -> V2.Reference.Reference -> ShortHash
reference2toshorthash1 :: Maybe Int -> Reference -> ShortHash
reference2toshorthash1 Maybe Int
hashLength Reference
ref = (ShortHash -> ShortHash)
-> (Int -> ShortHash -> ShortHash)
-> Maybe Int
-> ShortHash
-> ShortHash
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ShortHash -> ShortHash
forall a. a -> a
id Int -> ShortHash -> ShortHash
ShortHash.shortenTo Maybe Int
hashLength (ShortHash -> ShortHash) -> ShortHash -> ShortHash
forall a b. (a -> b) -> a -> b
$ case Reference
ref of
  V2.Reference.ReferenceBuiltin Text
b -> Text -> ShortHash
ShortHash.Builtin Text
b
  V2.Reference.ReferenceDerived (V2.Reference.Id Hash
h Pos
i) -> Text -> Maybe Pos -> Maybe Pos -> ShortHash
ShortHash.ShortHash (Hash -> Text
Hash.toBase32HexText Hash
h) (Pos -> Maybe Pos
showComponentPos Pos
i) Maybe Pos
forall a. Maybe a
Nothing
  where
    showComponentPos :: V2.Reference.Pos -> Maybe Word64
    showComponentPos :: Pos -> Maybe Pos
showComponentPos Pos
0 = Maybe Pos
forall a. Maybe a
Nothing
    showComponentPos Pos
n = Pos -> Maybe Pos
forall a. a -> Maybe a
Just Pos
n