module Unison.Util.Defns
  ( Defns (..),
    DefnsF,
    DefnsF2,
    DefnsF3,
    DefnsF4,
    alignDefnsWith,
    defnsAreEmpty,
    hoistDefnsF,
    mapDefns,
    unzipDefns,
    unzipDefnsWith,
    zipDefns,
    zipDefnsWith,
    zipDefnsWith3,
    zipDefnsWith4,
  )
where

import Data.Align (Semialign, alignWith)
import Data.Bifoldable (Bifoldable, bifoldMap)
import Data.Bitraversable (Bitraversable, bitraverse)
import Data.Semigroup.Generic (GenericSemigroupMonoid (..))
import Data.These (These)
import Unison.Prelude

-- | Definitions (terms and types) in a namespace.
data Defns terms types = Defns
  { forall terms types. Defns terms types -> terms
terms :: terms,
    forall terms types. Defns terms types -> types
types :: types
  }
  deriving stock ((forall x. Defns terms types -> Rep (Defns terms types) x)
-> (forall x. Rep (Defns terms types) x -> Defns terms types)
-> Generic (Defns terms types)
forall x. Rep (Defns terms types) x -> Defns terms types
forall x. Defns terms types -> Rep (Defns terms types) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall terms types x.
Rep (Defns terms types) x -> Defns terms types
forall terms types x.
Defns terms types -> Rep (Defns terms types) x
$cfrom :: forall terms types x.
Defns terms types -> Rep (Defns terms types) x
from :: forall x. Defns terms types -> Rep (Defns terms types) x
$cto :: forall terms types x.
Rep (Defns terms types) x -> Defns terms types
to :: forall x. Rep (Defns terms types) x -> Defns terms types
Generic, (forall a b. (a -> b) -> Defns terms a -> Defns terms b)
-> (forall a b. a -> Defns terms b -> Defns terms a)
-> Functor (Defns terms)
forall a b. a -> Defns terms b -> Defns terms a
forall a b. (a -> b) -> Defns terms a -> Defns terms b
forall terms a b. a -> Defns terms b -> Defns terms a
forall terms a b. (a -> b) -> Defns terms a -> Defns terms b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall terms a b. (a -> b) -> Defns terms a -> Defns terms b
fmap :: forall a b. (a -> b) -> Defns terms a -> Defns terms b
$c<$ :: forall terms a b. a -> Defns terms b -> Defns terms a
<$ :: forall a b. a -> Defns terms b -> Defns terms a
Functor, Int -> Defns terms types -> ShowS
[Defns terms types] -> ShowS
Defns terms types -> String
(Int -> Defns terms types -> ShowS)
-> (Defns terms types -> String)
-> ([Defns terms types] -> ShowS)
-> Show (Defns terms types)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall terms types.
(Show terms, Show types) =>
Int -> Defns terms types -> ShowS
forall terms types.
(Show terms, Show types) =>
[Defns terms types] -> ShowS
forall terms types.
(Show terms, Show types) =>
Defns terms types -> String
$cshowsPrec :: forall terms types.
(Show terms, Show types) =>
Int -> Defns terms types -> ShowS
showsPrec :: Int -> Defns terms types -> ShowS
$cshow :: forall terms types.
(Show terms, Show types) =>
Defns terms types -> String
show :: Defns terms types -> String
$cshowList :: forall terms types.
(Show terms, Show types) =>
[Defns terms types] -> ShowS
showList :: [Defns terms types] -> ShowS
Show)
  deriving (Semigroup (Defns terms types)
Defns terms types
Semigroup (Defns terms types) =>
Defns terms types
-> (Defns terms types -> Defns terms types -> Defns terms types)
-> ([Defns terms types] -> Defns terms types)
-> Monoid (Defns terms types)
[Defns terms types] -> Defns terms types
Defns terms types -> Defns terms types -> Defns terms types
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall terms types.
(Monoid terms, Monoid types) =>
Semigroup (Defns terms types)
forall terms types.
(Monoid terms, Monoid types) =>
Defns terms types
forall terms types.
(Monoid terms, Monoid types) =>
[Defns terms types] -> Defns terms types
forall terms types.
(Monoid terms, Monoid types) =>
Defns terms types -> Defns terms types -> Defns terms types
$cmempty :: forall terms types.
(Monoid terms, Monoid types) =>
Defns terms types
mempty :: Defns terms types
$cmappend :: forall terms types.
(Monoid terms, Monoid types) =>
Defns terms types -> Defns terms types -> Defns terms types
mappend :: Defns terms types -> Defns terms types -> Defns terms types
$cmconcat :: forall terms types.
(Monoid terms, Monoid types) =>
[Defns terms types] -> Defns terms types
mconcat :: [Defns terms types] -> Defns terms types
Monoid, NonEmpty (Defns terms types) -> Defns terms types
Defns terms types -> Defns terms types -> Defns terms types
(Defns terms types -> Defns terms types -> Defns terms types)
-> (NonEmpty (Defns terms types) -> Defns terms types)
-> (forall b.
    Integral b =>
    b -> Defns terms types -> Defns terms types)
-> Semigroup (Defns terms types)
forall b. Integral b => b -> Defns terms types -> Defns terms types
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall terms types.
(Semigroup terms, Semigroup types) =>
NonEmpty (Defns terms types) -> Defns terms types
forall terms types.
(Semigroup terms, Semigroup types) =>
Defns terms types -> Defns terms types -> Defns terms types
forall terms types b.
(Semigroup terms, Semigroup types, Integral b) =>
b -> Defns terms types -> Defns terms types
$c<> :: forall terms types.
(Semigroup terms, Semigroup types) =>
Defns terms types -> Defns terms types -> Defns terms types
<> :: Defns terms types -> Defns terms types -> Defns terms types
$csconcat :: forall terms types.
(Semigroup terms, Semigroup types) =>
NonEmpty (Defns terms types) -> Defns terms types
sconcat :: NonEmpty (Defns terms types) -> Defns terms types
$cstimes :: forall terms types b.
(Semigroup terms, Semigroup types, Integral b) =>
b -> Defns terms types -> Defns terms types
stimes :: forall b. Integral b => b -> Defns terms types -> Defns terms types
Semigroup) via GenericSemigroupMonoid (Defns terms types)

instance Bifoldable Defns where
  bifoldMap :: forall m a b. Monoid m => (a -> m) -> (b -> m) -> Defns a b -> m
bifoldMap a -> m
f b -> m
g (Defns a
x b
y) =
    a -> m
f a
x m -> m -> m
forall a. Semigroup a => a -> a -> a
<> b -> m
g b
y

instance Bifunctor Defns where
  bimap :: forall a b c d. (a -> b) -> (c -> d) -> Defns a c -> Defns b d
bimap a -> b
f c -> d
g (Defns a
x c
y) =
    b -> d -> Defns b d
forall terms types. terms -> types -> Defns terms types
Defns (a -> b
f a
x) (c -> d
g c
y)

instance Bitraversable Defns where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Defns a b -> f (Defns c d)
bitraverse a -> f c
f b -> f d
g (Defns a
x b
y) =
    c -> d -> Defns c d
forall terms types. terms -> types -> Defns terms types
Defns (c -> d -> Defns c d) -> f c -> f (d -> Defns c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
x f (d -> Defns c d) -> f d -> f (Defns c d)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> f d
g b
y

-- | A common shape of definitions - terms and types are stored in the same structure.
type DefnsF f terms types =
  Defns (f terms) (f types)

type DefnsF2 f g terms types =
  Defns (f (g terms)) (f (g types))

type DefnsF3 f g h terms types =
  Defns (f (g (h terms))) (f (g (h types)))

type DefnsF4 f g h i terms types =
  Defns (f (g (h (i terms)))) (f (g (h (i types))))

alignDefnsWith :: (Semialign f) => (These a b -> c) -> Defns (f a) (f b) -> f c
alignDefnsWith :: forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> Defns (f a) (f b) -> f c
alignDefnsWith These a b -> c
f Defns (f a) (f b)
defns =
  (These a b -> c) -> f a -> f b -> f c
forall a b c. (These a b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith These a b -> c
f Defns (f a) (f b)
defns.terms Defns (f a) (f b)
defns.types

defnsAreEmpty :: (Foldable f, Foldable g) => Defns (f a) (g b) -> Bool
defnsAreEmpty :: forall (f :: * -> *) (g :: * -> *) a b.
(Foldable f, Foldable g) =>
Defns (f a) (g b) -> Bool
defnsAreEmpty Defns (f a) (g b)
defns =
  f a -> Bool
forall a. f a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Defns (f a) (g b)
defns.terms Bool -> Bool -> Bool
&& g b -> Bool
forall a. g a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Defns (f a) (g b)
defns.types

hoistDefnsF :: (forall x. f x -> g x) -> DefnsF f a b -> DefnsF g a b
hoistDefnsF :: forall (f :: * -> *) (g :: * -> *) a b.
(forall x. f x -> g x) -> DefnsF f a b -> DefnsF g a b
hoistDefnsF forall x. f x -> g x
f (Defns f a
x f b
y) =
  g a -> g b -> Defns (g a) (g b)
forall terms types. terms -> types -> Defns terms types
Defns (f a -> g a
forall x. f x -> g x
f f a
x) (f b -> g b
forall x. f x -> g x
f f b
y)

mapDefns :: (a -> b) -> Defns a a -> Defns b b
mapDefns :: forall a b. (a -> b) -> Defns a a -> Defns b b
mapDefns a -> b
f =
  (a -> b) -> (a -> b) -> Defns a a -> Defns b b
forall a b c d. (a -> b) -> (c -> d) -> Defns a c -> Defns b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f a -> b
f

unzipDefns :: Defns (tm1, tm2) (ty1, ty2) -> (Defns tm1 ty1, Defns tm2 ty2)
unzipDefns :: forall tm1 tm2 ty1 ty2.
Defns (tm1, tm2) (ty1, ty2) -> (Defns tm1 ty1, Defns tm2 ty2)
unzipDefns =
  ((tm1, tm2) -> (tm1, tm2))
-> ((ty1, ty2) -> (ty1, ty2))
-> Defns (tm1, tm2) (ty1, ty2)
-> (Defns tm1 ty1, Defns tm2 ty2)
forall tm1 tm2 tm3 ty1 ty2 ty3.
(tm1 -> (tm2, tm3))
-> (ty1 -> (ty2, ty3))
-> Defns tm1 ty1
-> (Defns tm2 ty2, Defns tm3 ty3)
unzipDefnsWith (tm1, tm2) -> (tm1, tm2)
forall a. a -> a
id (ty1, ty2) -> (ty1, ty2)
forall a. a -> a
id

unzipDefnsWith :: (tm1 -> (tm2, tm3)) -> (ty1 -> (ty2, ty3)) -> Defns tm1 ty1 -> (Defns tm2 ty2, Defns tm3 ty3)
unzipDefnsWith :: forall tm1 tm2 tm3 ty1 ty2 ty3.
(tm1 -> (tm2, tm3))
-> (ty1 -> (ty2, ty3))
-> Defns tm1 ty1
-> (Defns tm2 ty2, Defns tm3 ty3)
unzipDefnsWith tm1 -> (tm2, tm3)
f ty1 -> (ty2, ty3)
g (Defns tm1
terms1 ty1
types1) =
  let (tm2
terms2, tm3
terms3) = tm1 -> (tm2, tm3)
f tm1
terms1
      (ty2
types2, ty3
types3) = ty1 -> (ty2, ty3)
g ty1
types1
   in (tm2 -> ty2 -> Defns tm2 ty2
forall terms types. terms -> types -> Defns terms types
Defns tm2
terms2 ty2
types2, tm3 -> ty3 -> Defns tm3 ty3
forall terms types. terms -> types -> Defns terms types
Defns tm3
terms3 ty3
types3)

zipDefns :: Defns tm1 ty1 -> Defns tm2 ty2 -> Defns (tm1, tm2) (ty1, ty2)
zipDefns :: forall tm1 ty1 tm2 ty2.
Defns tm1 ty1 -> Defns tm2 ty2 -> Defns (tm1, tm2) (ty1, ty2)
zipDefns =
  (tm1 -> tm2 -> (tm1, tm2))
-> (ty1 -> ty2 -> (ty1, ty2))
-> Defns tm1 ty1
-> Defns tm2 ty2
-> Defns (tm1, tm2) (ty1, ty2)
forall tm1 tm2 tm3 ty1 ty2 ty3.
(tm1 -> tm2 -> tm3)
-> (ty1 -> ty2 -> ty3)
-> Defns tm1 ty1
-> Defns tm2 ty2
-> Defns tm3 ty3
zipDefnsWith (,) (,)

zipDefnsWith :: (tm1 -> tm2 -> tm3) -> (ty1 -> ty2 -> ty3) -> Defns tm1 ty1 -> Defns tm2 ty2 -> Defns tm3 ty3
zipDefnsWith :: forall tm1 tm2 tm3 ty1 ty2 ty3.
(tm1 -> tm2 -> tm3)
-> (ty1 -> ty2 -> ty3)
-> Defns tm1 ty1
-> Defns tm2 ty2
-> Defns tm3 ty3
zipDefnsWith tm1 -> tm2 -> tm3
f ty1 -> ty2 -> ty3
g (Defns tm1
terms1 ty1
types1) (Defns tm2
terms2 ty2
types2) =
  tm3 -> ty3 -> Defns tm3 ty3
forall terms types. terms -> types -> Defns terms types
Defns (tm1 -> tm2 -> tm3
f tm1
terms1 tm2
terms2) (ty1 -> ty2 -> ty3
g ty1
types1 ty2
types2)

zipDefnsWith3 ::
  (tm1 -> tm2 -> tm3 -> tm4) ->
  (ty1 -> ty2 -> ty3 -> ty4) ->
  Defns tm1 ty1 ->
  Defns tm2 ty2 ->
  Defns tm3 ty3 ->
  Defns tm4 ty4
zipDefnsWith3 :: forall tm1 tm2 tm3 tm4 ty1 ty2 ty3 ty4.
(tm1 -> tm2 -> tm3 -> tm4)
-> (ty1 -> ty2 -> ty3 -> ty4)
-> Defns tm1 ty1
-> Defns tm2 ty2
-> Defns tm3 ty3
-> Defns tm4 ty4
zipDefnsWith3 tm1 -> tm2 -> tm3 -> tm4
f ty1 -> ty2 -> ty3 -> ty4
g (Defns tm1
terms1 ty1
types1) (Defns tm2
terms2 ty2
types2) (Defns tm3
terms3 ty3
types3) =
  tm4 -> ty4 -> Defns tm4 ty4
forall terms types. terms -> types -> Defns terms types
Defns (tm1 -> tm2 -> tm3 -> tm4
f tm1
terms1 tm2
terms2 tm3
terms3) (ty1 -> ty2 -> ty3 -> ty4
g ty1
types1 ty2
types2 ty3
types3)

zipDefnsWith4 ::
  (tm1 -> tm2 -> tm3 -> tm4 -> tm5) ->
  (ty1 -> ty2 -> ty3 -> ty4 -> ty5) ->
  Defns tm1 ty1 ->
  Defns tm2 ty2 ->
  Defns tm3 ty3 ->
  Defns tm4 ty4 ->
  Defns tm5 ty5
zipDefnsWith4 :: forall tm1 tm2 tm3 tm4 tm5 ty1 ty2 ty3 ty4 ty5.
(tm1 -> tm2 -> tm3 -> tm4 -> tm5)
-> (ty1 -> ty2 -> ty3 -> ty4 -> ty5)
-> Defns tm1 ty1
-> Defns tm2 ty2
-> Defns tm3 ty3
-> Defns tm4 ty4
-> Defns tm5 ty5
zipDefnsWith4 tm1 -> tm2 -> tm3 -> tm4 -> tm5
f ty1 -> ty2 -> ty3 -> ty4 -> ty5
g (Defns tm1
terms1 ty1
types1) (Defns tm2
terms2 ty2
types2) (Defns tm3
terms3 ty3
types3) (Defns tm4
terms4 ty4
types4) =
  tm5 -> ty5 -> Defns tm5 ty5
forall terms types. terms -> types -> Defns terms types
Defns (tm1 -> tm2 -> tm3 -> tm4 -> tm5
f tm1
terms1 tm2
terms2 tm3
terms3 tm4
terms4) (ty1 -> ty2 -> ty3 -> ty4 -> ty5
g ty1
types1 ty2
types2 ty3
types3 ty4
types4)