{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}

{-# OPTIONS_GHC -Wno-missing-signatures #-}

module Nix.Utils (module Nix.Utils, module X) where

import           Control.Monad.Fix              ( MonadFix(..) )
import           Control.Monad.Free             ( Free(..) )
import           Control.Monad.Trans.Control    ( MonadTransControl(..) )
import qualified Data.Aeson                    as A
import qualified Data.Aeson.Encoding           as A
import           Data.Fix                       ( Fix(..) )
import qualified Data.HashMap.Lazy             as M
import qualified Data.Text                     as Text
import qualified Data.Vector                   as V
import           Lens.Family2                  as X hiding ((&))
import           Lens.Family2.Stock             ( _1
                                                , _2
                                                )
import           Lens.Family2.TH                ( makeLensesBy )

#if ENABLE_TRACING
import           Debug.Trace as X
#else
-- Well, since it is currently CPP intermingled with Debug.Trace, required to use String here.
trace :: String -> a -> a
trace :: String -> a -> a
trace = (a -> a) -> String -> a -> a
forall a b. a -> b -> a
const a -> a
forall a. a -> a
id
traceM :: Monad m => String -> m ()
traceM :: String -> m ()
traceM = m () -> String -> m ()
forall a b. a -> b -> a
const m ()
forall (f :: * -> *). Applicative f => f ()
pass
#endif

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

type AttrSet = HashMap Text

-- | F-algebra defines how to reduce the fixed-point of a functor to a
--   value.
type Alg f a = f a -> a

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

-- | "Transform" here means a modification of a catamorphism.
type Transform f a = (Fix f -> a) -> Fix f -> a

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

loebM :: (MonadFix m, Traversable t) => t (t a -> m a) -> m (t a)
-- Sectioning here insures optimization happening.
loebM :: t (t a -> m a) -> m (t a)
loebM t (t a -> m a)
f = (t a -> m (t a)) -> m (t a)
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix ((t a -> m (t a)) -> m (t a)) -> (t a -> m (t a)) -> m (t a)
forall a b. (a -> b) -> a -> b
$ \t a
a -> (((t a -> m a) -> m a) -> t (t a -> m a) -> m (t a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
`traverse` t (t a -> m a)
f) ((t a -> m a) -> t a -> m a
forall a b. (a -> b) -> a -> b
$ t a
a)
{-# inline loebM #-}

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

lifted
  :: (MonadTransControl u, Monad (u m), Monad m)
  => ((a -> m (StT u b)) -> m (StT u b))
  -> (a -> u m b)
  -> u m b
lifted :: ((a -> m (StT u b)) -> m (StT u b)) -> (a -> u m b) -> u m b
lifted (a -> m (StT u b)) -> m (StT u b)
f a -> u m b
k =
  do
    StT u b
lftd <- (Run u -> m (StT u b)) -> u m (StT u b)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith (\Run u
run -> (a -> m (StT u b)) -> m (StT u b)
f (u m b -> m (StT u b)
Run u
run (u m b -> m (StT u b)) -> (a -> u m b) -> a -> m (StT u b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> u m b
k))
    m (StT u b) -> u m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT (m (StT u b) -> u m b) -> m (StT u b) -> u m b
forall a b. (a -> b) -> a -> b
$ StT u b -> m (StT u b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure StT u b
lftd

-- | 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
<$>)

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

-- | adi is Abstracting Definitional Interpreters:
--
--     https://arxiv.org/abs/1707.04755
--
--   Essentially, it does for evaluation what recursion schemes do for
--   representation: allows threading layers through existing structure, only
--   in this case through behavior.
adi :: Functor f => (f a -> a) -> ((Fix f -> a) -> Fix f -> a) -> Fix f -> a
adi :: (f a -> a) -> ((Fix f -> a) -> Fix f -> a) -> Fix f -> a
adi f a -> a
f (Fix f -> a) -> Fix f -> a
g = (Fix f -> a) -> Fix f -> a
g ((Fix f -> a) -> Fix f -> a) -> (Fix f -> a) -> Fix f -> a
forall a b. (a -> b) -> a -> b
$ f a -> a
f (f a -> a) -> (Fix f -> f a) -> Fix f -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((f a -> a) -> ((Fix f -> a) -> Fix f -> a) -> Fix f -> a
forall (f :: * -> *) a.
Functor f =>
(f a -> a) -> ((Fix f -> a) -> Fix f -> a) -> Fix f -> a
adi f a -> a
f (Fix f -> a) -> Fix f -> a
g (Fix f -> a) -> f (Fix f) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (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

adiM
  :: (Traversable t, Monad m)
  => (t a -> m a)
  -> ((Fix t -> m a) -> Fix t -> m a)
  -> Fix t
  -> m a
adiM :: (t a -> m a) -> ((Fix t -> m a) -> Fix t -> m a) -> Fix t -> m a
adiM t a -> m a
f (Fix t -> m a) -> Fix t -> m a
g = (Fix t -> m a) -> Fix t -> m a
g ((Fix t -> m a) -> Fix t -> m a) -> (Fix t -> m a) -> Fix t -> m a
forall a b. (a -> b) -> a -> b
$ t a -> m a
f (t a -> 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 ((t a -> m a) -> ((Fix t -> m a) -> Fix t -> m a) -> Fix t -> m a
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
(t a -> m a) -> ((Fix t -> m a) -> Fix t -> m a) -> Fix t -> m a
adiM t a -> m a
f (Fix t -> m a) -> Fix t -> m a
g) (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

class Has a b where
  hasLens :: Lens' a b

instance Has a a where
  hasLens :: LensLike' f a a
hasLens a -> f a
f = a -> f a
f

instance Has (a, b) a where
  hasLens :: LensLike' f (a, b) a
hasLens = LensLike' f (a, b) a
forall a r b. Lens (a, r) (b, r) a b
_1

instance Has (a, b) b where
  hasLens :: LensLike' f (a, b) b
hasLens = LensLike' f (a, b) b
forall r a b. Lens (r, a) (r, b) a b
_2

toEncodingSorted :: A.Value -> A.Encoding
toEncodingSorted :: Value -> Encoding
toEncodingSorted = \case
  A.Object Object
m ->
    Series -> Encoding
A.pairs
      (Series -> Encoding)
-> ([(Text, Value)] -> Series) -> [(Text, Value)] -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
      ([Series] -> Series)
-> ([(Text, Value)] -> [Series]) -> [(Text, Value)] -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((\(Text
k, Value
v) -> Text -> Encoding -> Series
A.pair Text
k (Encoding -> Series) -> Encoding -> Series
forall a b. (a -> b) -> a -> b
$ Value -> Encoding
toEncodingSorted Value
v) ((Text, Value) -> Series) -> [(Text, Value)] -> [Series]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
      ([(Text, Value)] -> [Series])
-> ([(Text, Value)] -> [(Text, Value)])
-> [(Text, Value)]
-> [Series]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Value) -> Text) -> [(Text, Value)] -> [(Text, Value)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortWith (Text, Value) -> Text
forall a b. (a, b) -> a
fst
      ([(Text, Value)] -> Encoding) -> [(Text, Value)] -> Encoding
forall a b. (a -> b) -> a -> b
$ Object -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
M.toList Object
m
  A.Array Array
l -> (Value -> Encoding) -> [Value] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
A.list Value -> Encoding
toEncodingSorted ([Value] -> Encoding) -> [Value] -> Encoding
forall a b. (a -> b) -> a -> b
$ Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
l
  Value
v         -> Value -> Encoding
forall a. ToJSON a => a -> Encoding
A.toEncoding Value
v

data NixPathEntryType = PathEntryPath | PathEntryURI deriving (Int -> NixPathEntryType -> ShowS
[NixPathEntryType] -> ShowS
NixPathEntryType -> String
(Int -> NixPathEntryType -> ShowS)
-> (NixPathEntryType -> String)
-> ([NixPathEntryType] -> ShowS)
-> Show NixPathEntryType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NixPathEntryType] -> ShowS
$cshowList :: [NixPathEntryType] -> ShowS
show :: NixPathEntryType -> String
$cshow :: NixPathEntryType -> String
showsPrec :: Int -> NixPathEntryType -> ShowS
$cshowsPrec :: Int -> NixPathEntryType -> ShowS
Show, NixPathEntryType -> NixPathEntryType -> Bool
(NixPathEntryType -> NixPathEntryType -> Bool)
-> (NixPathEntryType -> NixPathEntryType -> Bool)
-> Eq NixPathEntryType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NixPathEntryType -> NixPathEntryType -> Bool
$c/= :: NixPathEntryType -> NixPathEntryType -> Bool
== :: NixPathEntryType -> NixPathEntryType -> Bool
$c== :: NixPathEntryType -> NixPathEntryType -> Bool
Eq)

-- | @NIX_PATH@ is colon-separated, but can also contain URLs, which have a colon
-- (i.e. @https://...@)
uriAwareSplit :: Text -> [(Text, NixPathEntryType)]
uriAwareSplit :: Text -> [(Text, NixPathEntryType)]
uriAwareSplit Text
txt =
  case (Char -> Bool) -> Text -> (Text, Text)
Text.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') Text
txt of
    (Text
e1, Text
e2)
      | Text -> Bool
Text.null Text
e2                              -> [(Text
e1, NixPathEntryType
PathEntryPath)]
      | Text
"://" Text -> Text -> Bool
`Text.isPrefixOf` Text
e2      ->
        let ((Text
suffix, NixPathEntryType
_) : [(Text, NixPathEntryType)]
path) = Text -> [(Text, NixPathEntryType)]
uriAwareSplit (Int -> Text -> Text
Text.drop Int
3 Text
e2) in
        (Text
e1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"://" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suffix, NixPathEntryType
PathEntryURI) (Text, NixPathEntryType)
-> [(Text, NixPathEntryType)] -> [(Text, NixPathEntryType)]
forall a. a -> [a] -> [a]
: [(Text, NixPathEntryType)]
path
      | Bool
otherwise                                 -> (Text
e1, NixPathEntryType
PathEntryPath) (Text, NixPathEntryType)
-> [(Text, NixPathEntryType)] -> [(Text, NixPathEntryType)]
forall a. a -> [a] -> [a]
: Text -> [(Text, NixPathEntryType)]
uriAwareSplit (Int -> Text -> Text
Text.drop Int
1 Text
e2)

alterF
  :: (Eq k, Hashable k, Functor f)
  => (Maybe v -> f (Maybe v))
  -> k
  -> HashMap k v
  -> f (HashMap k v)
alterF :: (Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v)
alterF Maybe v -> f (Maybe v)
f k
k HashMap k v
m =
  HashMap k v -> (v -> HashMap k v) -> Maybe v -> HashMap k v
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (k -> HashMap k v -> HashMap k v
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
M.delete k
k HashMap k v
m)
    (\ v
v -> k -> v -> HashMap k v -> HashMap k v
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert k
k v
v HashMap k v
m)
    (Maybe v -> HashMap k v) -> f (Maybe v) -> f (HashMap k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe v -> f (Maybe v)
f (k -> HashMap k v -> Maybe v
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup k
k HashMap k v
m)


-- | Analog for @bool@ or @maybe@, for list-like cons structures.
list
  :: Foldable t
  => b -> (t a -> b) -> t a -> b
list :: b -> (t a -> b) -> t a -> b
list b
e t a -> b
f t a
l =
  b -> b -> Bool -> b
forall a. a -> a -> Bool -> a
bool
    (t a -> b
f t a
l)
    b
e
    (t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
l)
{-# inline list #-}

-- | Lambda analog of @maybe@ or @either@ for Free monad.
free :: (a -> b) -> (f (Free f a) -> b) -> Free f a -> b
free :: (a -> b) -> (f (Free f a) -> b) -> Free f a -> b
free a -> b
fP f (Free f a) -> b
fF Free f a
fr =
  case Free f a
fr of
    Pure a
a -> a -> b
fP a
a
    Free f (Free f a)
fa -> f (Free f a) -> b
fF f (Free f a)
fa
{-# inline free #-}


whenTrue :: (Monoid a)
  => a -> Bool -> a
whenTrue :: a -> Bool -> a
whenTrue =
  a -> a -> Bool -> a
forall a. a -> a -> Bool -> a
bool
    a
forall a. Monoid a => a
mempty
{-# inline whenTrue #-}

whenFalse :: (Monoid a)
  => a  -> Bool  -> a
whenFalse :: a -> Bool -> a
whenFalse a
f =
  a -> a -> Bool -> a
forall a. a -> a -> Bool -> a
bool
    a
f
    a
forall a. Monoid a => a
mempty
{-# inline whenFalse #-}

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 #-}


-- | Apply a single function to both components of a pair.
--
-- > both succ (1,2) == (2,3)
--
-- Taken From package @extra@
both :: (a -> b) -> (a, a) -> (b, b)
both :: (a -> b) -> (a, a) -> (b, b)
both a -> b
f (a
x,a
y) = (a -> b
f a
x, a -> b
f a
y)
{-# inline both #-}


-- | Duplicates object into a tuple.
dup :: a -> (a, a)
dup :: a -> (a, a)
dup a
x = (a
x, a
x)
{-# inline dup #-}

-- | From @utility-ht@ for tuple laziness.
mapPair :: (a -> c, b -> d) -> (a,b) -> (c,d)
mapPair :: (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair ~(a -> c
f,b -> d
g) ~(a
a,b
b) = (a -> c
f a
a, b -> d
g b
b)
{-# inline mapPair #-}

-- After migration from the @relude@ - @relude: pass -> stub@
-- | @pure mempty@: Short-curcuit, stub.
stub :: (Applicative f, Monoid a) => f a
stub :: f a
stub = a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
{-# inline stub #-}