{-# language FunctionalDependencies #-}
{-# language TemplateHaskell #-}

{-# options_ghc -Wno-missing-signatures #-}

-- | This module holds unused code.
-- So, if someone wants something - look here, use it & move to appropriate place.
module Nix.Unused
 where

import           Nix.Prelude
import           Control.Monad.Free             ( Free(..) )
import           Data.Fix                       ( Fix(..) )
import           Lens.Family2.TH                ( makeLensesBy )

-- * From "Nix.Utils"

-- | > type AlgM f m a = f a -> m a
type AlgM f m a = f a -> m a

whenFree :: (Monoid b)
  => (f (Free f a) -> b) -> Free f a -> b
whenFree :: (f (Free f a) -> b) -> Free f a -> b
whenFree =
  (a -> b) -> (f (Free f a) -> b) -> Free f a -> b
forall a b (f :: * -> *).
(a -> b) -> (f (Free f a) -> b) -> Free f a -> b
free
    a -> b
forall a. Monoid a => a
mempty
{-# inline whenFree #-}

whenPure :: (Monoid b)
  => (a -> b) -> Free f a -> b
whenPure :: (a -> b) -> Free f a -> b
whenPure a -> b
f =
  (a -> b) -> (f (Free f a) -> b) -> Free f a -> b
forall a b (f :: * -> *).
(a -> b) -> (f (Free f a) -> b) -> Free f a -> b
free
    a -> b
f
    f (Free f a) -> b
forall a. Monoid a => a
mempty
{-# inline whenPure #-}

-- | Replace:
--  @Pure a -> a@
--  @Free -> Fix@
freeToFix :: Functor f => (a -> Fix f) -> Free f a -> Fix f
freeToFix :: (a -> Fix f) -> Free f a -> Fix f
freeToFix a -> Fix f
f = Free f a -> Fix f
go
 where
  go :: Free f a -> Fix f
go =
    (a -> Fix f) -> (f (Free f a) -> Fix f) -> Free f a -> Fix f
forall a b (f :: * -> *).
(a -> b) -> (f (Free f a) -> b) -> Free f a -> b
free
      a -> Fix f
f
      ((f (Free f a) -> Fix f) -> Free f a -> Fix f)
-> (f (Free f a) -> Fix f) -> Free f a -> Fix f
forall a b. (a -> b) -> a -> b
$ f (Fix f) -> Fix f
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (f (Fix f) -> Fix f)
-> (f (Free f a) -> f (Fix f)) -> f (Free f a) -> Fix f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Free f a -> Fix f
go (Free f a -> Fix f) -> f (Free f a) -> f (Fix f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)

-- | Replace:
--  @a -> Pure a@
--  @Fix -> Free@
fixToFree :: Functor f => Fix f -> Free f a
fixToFree :: Fix f -> Free f a
fixToFree = f (Free f a) -> Free f a
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (f (Free f a) -> Free f a)
-> (Fix f -> f (Free f a)) -> Fix f -> Free f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fix f -> f (Free f a)
forall (f :: * -> *) a. Functor f => Fix f -> f (Free f a)
go
 where
  go :: Fix f -> f (Free f a)
go (Fix f (Fix f)
f) = f (Free f a) -> Free f a
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (f (Free f a) -> Free f a)
-> (Fix f -> f (Free f a)) -> Fix f -> Free f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fix f -> f (Free f a)
go (Fix f -> Free f a) -> f (Fix f) -> f (Free f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Fix f)
f


loeb :: Functor f => f (f a -> a) -> f a
loeb :: f (f a -> a) -> f a
loeb f (f a -> a)
x = f a
go
 where
  go :: f a
go = ((f a -> a) -> f a -> a
forall a b. (a -> b) -> a -> b
$ f a
go) ((f a -> a) -> a) -> f (f a -> a) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (f a -> a)
x

adiM
  :: ( Traversable t
     , Monad m
     )
  => Transform t (m a)
  -> AlgM t m a
  -> Fix t
  -> m a
adiM :: Transform t (m a) -> AlgM t m a -> Fix t -> m a
adiM Transform t (m a)
g AlgM t m a
f = Transform t (m a)
g Transform t (m a) -> Transform t (m a)
forall a b. (a -> b) -> a -> b
$ AlgM t m a
f AlgM t m a -> (Fix t -> m (t a)) -> Fix t -> m a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (Fix t -> m a) -> t (Fix t) -> m (t a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Transform t (m a) -> AlgM t m a -> Fix t -> m a
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
Transform t (m a) -> AlgM t m a -> Fix t -> m a
adiM Transform t (m a)
g AlgM t m a
f) (t (Fix t) -> m (t a)) -> (Fix t -> t (Fix t)) -> Fix t -> m (t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fix t -> t (Fix t)
forall (f :: * -> *). Fix f -> f (Fix f)
unFix

para :: Functor f => (f (Fix f, a) -> a) -> Fix f -> a
para :: (f (Fix f, a) -> a) -> Fix f -> a
para f (Fix f, a) -> a
f = f (Fix f, a) -> a
f (f (Fix f, a) -> a) -> (Fix f -> f (Fix f, a)) -> Fix f -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Fix f -> (Fix f, a)) -> f (Fix f) -> f (Fix f, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Fix f -> Fix f
forall a. a -> a
id (Fix f -> Fix f) -> (Fix f -> a) -> Fix f -> (Fix f, a)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (f (Fix f, a) -> a) -> Fix f -> a
forall (f :: * -> *) a.
Functor f =>
(f (Fix f, a) -> a) -> Fix f -> a
para f (Fix f, a) -> a
f) (f (Fix f) -> f (Fix f, a))
-> (Fix f -> f (Fix f)) -> Fix f -> f (Fix f, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fix f -> f (Fix f)
forall (f :: * -> *). Fix f -> f (Fix f)
unFix

paraM :: (Traversable f, Monad m) => (f (Fix f, a) -> m a) -> Fix f -> m a
paraM :: (f (Fix f, a) -> m a) -> Fix f -> m a
paraM f (Fix f, a) -> m a
f = f (Fix f, a) -> m a
f (f (Fix f, a) -> m a)
-> (Fix f -> m (f (Fix f, a))) -> Fix f -> m a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (Fix f -> m (Fix f, a)) -> f (Fix f) -> m (f (Fix f, a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Fix f
x -> (Fix f
x, ) (a -> (Fix f, a)) -> m a -> m (Fix f, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (f (Fix f, a) -> m a) -> Fix f -> m a
forall (f :: * -> *) (m :: * -> *) a.
(Traversable f, Monad m) =>
(f (Fix f, a) -> m a) -> Fix f -> m a
paraM f (Fix f, a) -> m a
f Fix f
x) (f (Fix f) -> m (f (Fix f, a)))
-> (Fix f -> f (Fix f)) -> Fix f -> m (f (Fix f, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fix f -> f (Fix f)
forall (f :: * -> *). Fix f -> f (Fix f)
unFix

cataP :: Functor f => (Fix f -> f a -> a) -> Fix f -> a
cataP :: (Fix f -> f a -> a) -> Fix f -> a
cataP Fix f -> f a -> a
f Fix f
x = Fix f -> f a -> a
f Fix f
x (f a -> a) -> (Fix f -> f a) -> Fix f -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Fix f -> a) -> f (Fix f) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Fix f -> f a -> a) -> Fix f -> a
forall (f :: * -> *) a.
Functor f =>
(Fix f -> f a -> a) -> Fix f -> a
cataP Fix f -> f a -> a
f) (f (Fix f) -> f a) -> (Fix f -> f (Fix f)) -> Fix f -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fix f -> f (Fix f)
forall (f :: * -> *). Fix f -> f (Fix f)
unFix (Fix f -> a) -> Fix f -> a
forall a b. (a -> b) -> a -> b
$ Fix f
x

cataPM :: (Traversable f, Monad m) => (Fix f -> f a -> m a) -> Fix f -> m a
cataPM :: (Fix f -> f a -> m a) -> Fix f -> m a
cataPM Fix f -> f a -> m a
f Fix f
x = Fix f -> f a -> m a
f Fix f
x (f a -> m a) -> (Fix f -> m (f a)) -> Fix f -> m a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (Fix f -> m a) -> f (Fix f) -> m (f a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Fix f -> f a -> m a) -> Fix f -> m a
forall (f :: * -> *) (m :: * -> *) a.
(Traversable f, Monad m) =>
(Fix f -> f a -> m a) -> Fix f -> m a
cataPM Fix f -> f a -> m a
f) (f (Fix f) -> m (f a)) -> (Fix f -> f (Fix f)) -> Fix f -> m (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fix f -> f (Fix f)
forall (f :: * -> *). Fix f -> f (Fix f)
unFix (Fix f -> m a) -> Fix f -> m a
forall a b. (a -> b) -> a -> b
$ Fix f
x

$(makeLensesBy (\n -> pure $ "_" <> n) ''Fix)