{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ViewPatterns #-}

module U.Util.Term where

import Control.Monad.Writer (execWriter, tell)
import Data.Foldable (for_, traverse_)
import U.Codebase.Term (F' (..), MatchCase (..), Pattern (..))
import qualified U.Codebase.Term as Term
import qualified U.Core.ABT as ABT

text :: (Ord v) => ABT.Term (Term.F' text termRef typeRef termLink typeLink vt) v a -> [text]
text :: forall v text termRef typeRef termLink typeLink vt a.
Ord v =>
Term (F' text termRef typeRef termLink typeLink vt) v a -> [text]
text =
  Writer
  [text] (Term (F' text termRef typeRef termLink typeLink vt) v a)
-> [text]
forall w a. Writer w a -> w
execWriter (Writer
   [text] (Term (F' text termRef typeRef termLink typeLink vt) v a)
 -> [text])
-> (Term (F' text termRef typeRef termLink typeLink vt) v a
    -> Writer
         [text] (Term (F' text termRef typeRef termLink typeLink vt) v a))
-> Term (F' text termRef typeRef termLink typeLink vt) v a
-> [text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (F'
   text
   termRef
   typeRef
   termLink
   typeLink
   vt
   (Term (F' text termRef typeRef termLink typeLink vt) v a)
 -> WriterT [text] Identity ())
-> Term (F' text termRef typeRef termLink typeLink vt) v a
-> Writer
     [text] (Term (F' text termRef typeRef termLink typeLink vt) v a)
forall (f :: * -> *) (g :: * -> *) v a.
(Traversable f, Applicative g, Ord v) =>
(f (Term f v a) -> g ()) -> Term f v a -> g (Term f v a)
ABT.visit_ \case
    Text text
t -> [text] -> WriterT [text] Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [text
t]
    F'
  text
  termRef
  typeRef
  termLink
  typeLink
  vt
  (Term (F' text termRef typeRef termLink typeLink vt) v a)
_ -> () -> WriterT [text] Identity ()
forall a. a -> WriterT [text] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

dependencies ::
  (Ord v) =>
  ABT.Term (Term.F' text termRef typeRef termLink typeLink vt) v a ->
  ([termRef], [typeRef], [termLink], [typeLink])
dependencies :: forall v text termRef typeRef termLink typeLink vt a.
Ord v =>
Term (F' text termRef typeRef termLink typeLink vt) v a
-> ([termRef], [typeRef], [termLink], [typeLink])
dependencies =
  Writer
  ([termRef], [typeRef], [termLink], [typeLink])
  (Term (F' text termRef typeRef termLink typeLink vt) v a)
-> ([termRef], [typeRef], [termLink], [typeLink])
forall w a. Writer w a -> w
execWriter (Writer
   ([termRef], [typeRef], [termLink], [typeLink])
   (Term (F' text termRef typeRef termLink typeLink vt) v a)
 -> ([termRef], [typeRef], [termLink], [typeLink]))
-> (Term (F' text termRef typeRef termLink typeLink vt) v a
    -> Writer
         ([termRef], [typeRef], [termLink], [typeLink])
         (Term (F' text termRef typeRef termLink typeLink vt) v a))
-> Term (F' text termRef typeRef termLink typeLink vt) v a
-> ([termRef], [typeRef], [termLink], [typeLink])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (F'
   text
   termRef
   typeRef
   termLink
   typeLink
   vt
   (Term (F' text termRef typeRef termLink typeLink vt) v a)
 -> WriterT
      ([termRef], [typeRef], [termLink], [typeLink]) Identity ())
-> Term (F' text termRef typeRef termLink typeLink vt) v a
-> Writer
     ([termRef], [typeRef], [termLink], [typeLink])
     (Term (F' text termRef typeRef termLink typeLink vt) v a)
forall (f :: * -> *) (g :: * -> *) v a.
(Traversable f, Applicative g, Ord v) =>
(f (Term f v a) -> g ()) -> Term f v a -> g (Term f v a)
ABT.visit_ \case
    Ref termRef
r -> termRef
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
forall {f :: * -> *} {a} {b} {c} {d} {m :: * -> *}.
(MonadWriter (f a, b, c, d) m, Monoid b, Monoid c, Monoid d,
 Monoid (f a), Applicative f) =>
a -> m ()
termRef termRef
r
    Constructor typeRef
r ConstructorId
_ -> typeRef
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
forall {a} {f :: * -> *} {a} {c} {d} {m :: * -> *}.
(MonadWriter (a, f a, c, d) m, Monoid a, Monoid c, Monoid d,
 Monoid (f a), Applicative f) =>
a -> m ()
typeRef typeRef
r
    Request typeRef
r ConstructorId
_ -> typeRef
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
forall {a} {f :: * -> *} {a} {c} {d} {m :: * -> *}.
(MonadWriter (a, f a, c, d) m, Monoid a, Monoid c, Monoid d,
 Monoid (f a), Applicative f) =>
a -> m ()
typeRef typeRef
r
    Match Term (F' text termRef typeRef termLink typeLink vt) v a
_ [MatchCase
   text
   typeRef
   (Term (F' text termRef typeRef termLink typeLink vt) v a)]
cases -> [MatchCase
   text
   typeRef
   (Term (F' text termRef typeRef termLink typeLink vt) v a)]
-> (MatchCase
      text
      typeRef
      (Term (F' text termRef typeRef termLink typeLink vt) v a)
    -> WriterT
         ([termRef], [typeRef], [termLink], [typeLink]) Identity ())
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [MatchCase
   text
   typeRef
   (Term (F' text termRef typeRef termLink typeLink vt) v a)]
cases \case
      MatchCase Pattern text typeRef
pat Maybe (Term (F' text termRef typeRef termLink typeLink vt) v a)
_guard Term (F' text termRef typeRef termLink typeLink vt) v a
_body -> Pattern text typeRef
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
forall {t}.
Pattern t typeRef
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
go Pattern text typeRef
pat
        where
          go :: Pattern t typeRef
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
go = \case
            PConstructor typeRef
r ConstructorId
_i [Pattern t typeRef]
args -> typeRef
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
forall {a} {f :: * -> *} {a} {c} {d} {m :: * -> *}.
(MonadWriter (a, f a, c, d) m, Monoid a, Monoid c, Monoid d,
 Monoid (f a), Applicative f) =>
a -> m ()
typeRef typeRef
r WriterT ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
forall a b.
WriterT ([termRef], [typeRef], [termLink], [typeLink]) Identity a
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity b
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Pattern t typeRef
 -> WriterT
      ([termRef], [typeRef], [termLink], [typeLink]) Identity ())
-> [Pattern t typeRef]
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Pattern t typeRef
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
go [Pattern t typeRef]
args
            PAs Pattern t typeRef
pat -> Pattern t typeRef
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
go Pattern t typeRef
pat
            PEffectPure Pattern t typeRef
pat -> Pattern t typeRef
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
go Pattern t typeRef
pat
            PEffectBind typeRef
r ConstructorId
_i [Pattern t typeRef]
args Pattern t typeRef
k -> typeRef
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
forall {a} {f :: * -> *} {a} {c} {d} {m :: * -> *}.
(MonadWriter (a, f a, c, d) m, Monoid a, Monoid c, Monoid d,
 Monoid (f a), Applicative f) =>
a -> m ()
typeRef typeRef
r WriterT ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
forall a b.
WriterT ([termRef], [typeRef], [termLink], [typeLink]) Identity a
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity b
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Pattern t typeRef
 -> WriterT
      ([termRef], [typeRef], [termLink], [typeLink]) Identity ())
-> [Pattern t typeRef]
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Pattern t typeRef
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
go [Pattern t typeRef]
args WriterT ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
forall a b.
WriterT ([termRef], [typeRef], [termLink], [typeLink]) Identity a
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity b
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Pattern t typeRef
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
go Pattern t typeRef
k
            PSequenceLiteral [Pattern t typeRef]
pats -> (Pattern t typeRef
 -> WriterT
      ([termRef], [typeRef], [termLink], [typeLink]) Identity ())
-> [Pattern t typeRef]
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Pattern t typeRef
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
go [Pattern t typeRef]
pats
            PSequenceOp Pattern t typeRef
l SeqOp
_op Pattern t typeRef
r -> Pattern t typeRef
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
go Pattern t typeRef
l WriterT ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
forall a b.
WriterT ([termRef], [typeRef], [termLink], [typeLink]) Identity a
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity b
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Pattern t typeRef
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
go Pattern t typeRef
r
            Pattern t typeRef
_ -> ()
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
forall a.
a
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    TermLink termLink
r -> termLink
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
forall {a} {b} {f :: * -> *} {a} {d} {m :: * -> *}.
(MonadWriter (a, b, f a, d) m, Monoid a, Monoid b, Monoid d,
 Monoid (f a), Applicative f) =>
a -> m ()
termLink termLink
r
    TypeLink typeLink
r -> typeLink
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
forall {a} {b} {c} {f :: * -> *} {a} {m :: * -> *}.
(MonadWriter (a, b, c, f a) m, Monoid a, Monoid b, Monoid c,
 Monoid (f a), Applicative f) =>
a -> m ()
typeLink typeLink
r
    F'
  text
  termRef
  typeRef
  termLink
  typeLink
  vt
  (Term (F' text termRef typeRef termLink typeLink vt) v a)
_ -> ()
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity ()
forall a.
a
-> WriterT
     ([termRef], [typeRef], [termLink], [typeLink]) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  where
    termRef :: a -> m ()
termRef a
r = (f a, b, c, d) -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (a -> f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r, b
forall a. Monoid a => a
mempty, c
forall a. Monoid a => a
mempty, d
forall a. Monoid a => a
mempty)
    typeRef :: a -> m ()
typeRef a
r = (a, f a, c, d) -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (a
forall a. Monoid a => a
mempty, a -> f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r, c
forall a. Monoid a => a
mempty, d
forall a. Monoid a => a
mempty)
    termLink :: a -> m ()
termLink a
r = (a, b, f a, d) -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (a
forall a. Monoid a => a
mempty, b
forall a. Monoid a => a
mempty, a -> f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r, d
forall a. Monoid a => a
mempty)
    typeLink :: a -> m ()
typeLink a
r = (a, b, c, f a) -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (a
forall a. Monoid a => a
mempty, b
forall a. Monoid a => a
mempty, c
forall a. Monoid a => a
mempty, a -> f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r)