-- | 'Tweak's working on the outputs of a 'TxSkel'
module Cooked.Tweak.Outputs
  ( ensureOutputTweak,
    addOutputTweak,
    removeOutputTweak,
    tamperDatumTweak,
    TamperDatumLbl (..),
    malformDatumTweak,
    MalformDatumLbl (..),
  )
where

import Control.Monad
import Cooked.Output
import Cooked.Pretty.Class
import Cooked.Skeleton
import Cooked.Tweak.Common
import Cooked.Tweak.Labels
import Data.List (partition)
import Data.Maybe
import Data.Typeable
import Optics.Core
import PlutusLedgerApi.V3 qualified as Api

-- | Ensures that a certain output is produced by a transaction. The return
-- value will be @Just@ the added output, when applicable.
ensureOutputTweak :: (MonadTweak m) => TxSkelOut -> m (Maybe TxSkelOut)
ensureOutputTweak :: forall (m :: * -> *).
MonadTweak m =>
TxSkelOut -> m (Maybe TxSkelOut)
ensureOutputTweak TxSkelOut
txSkelOut = do
  [TxSkelOut]
presentOutputs <- Optic' A_Lens NoIx TxSkel [TxSkelOut] -> m [TxSkelOut]
forall (m :: * -> *) k (is :: IxList) a.
(MonadTweak m, Is k A_Getter) =>
Optic' k is TxSkel a -> m a
viewTweak Optic' A_Lens NoIx TxSkel [TxSkelOut]
txSkelOutsL
  if TxSkelOut
txSkelOut TxSkelOut -> [TxSkelOut] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TxSkelOut]
presentOutputs
    then Maybe TxSkelOut -> m (Maybe TxSkelOut)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TxSkelOut
forall a. Maybe a
Nothing
    else do
      TxSkelOut -> m ()
forall (m :: * -> *). MonadTweak m => TxSkelOut -> m ()
addOutputTweak TxSkelOut
txSkelOut
      Maybe TxSkelOut -> m (Maybe TxSkelOut)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TxSkelOut -> m (Maybe TxSkelOut))
-> Maybe TxSkelOut -> m (Maybe TxSkelOut)
forall a b. (a -> b) -> a -> b
$ TxSkelOut -> Maybe TxSkelOut
forall a. a -> Maybe a
Just TxSkelOut
txSkelOut

-- | Adds a transaction output, at the end of the current list of outputs, thus
-- retaining the initial outputs order.
addOutputTweak :: (MonadTweak m) => TxSkelOut -> m ()
addOutputTweak :: forall (m :: * -> *). MonadTweak m => TxSkelOut -> m ()
addOutputTweak TxSkelOut
txSkelOut = Optic' A_Lens NoIx TxSkel [TxSkelOut]
-> ([TxSkelOut] -> [TxSkelOut]) -> m ()
forall (m :: * -> *) k (is :: IxList) a.
(MonadTweak m, Is k A_Setter) =>
Optic' k is TxSkel a -> (a -> a) -> m ()
overTweak Optic' A_Lens NoIx TxSkel [TxSkelOut]
txSkelOutsL ([TxSkelOut] -> [TxSkelOut] -> [TxSkelOut]
forall a. [a] -> [a] -> [a]
++ [TxSkelOut
txSkelOut])

-- | Removes transaction outputs according to some predicate. The returned list
-- contains all the removed outputs.
removeOutputTweak :: (MonadTweak m) => (TxSkelOut -> Bool) -> m [TxSkelOut]
removeOutputTweak :: forall (m :: * -> *).
MonadTweak m =>
(TxSkelOut -> Bool) -> m [TxSkelOut]
removeOutputTweak TxSkelOut -> Bool
removePred = do
  [TxSkelOut]
presentOutputs <- Optic' A_Lens NoIx TxSkel [TxSkelOut] -> m [TxSkelOut]
forall (m :: * -> *) k (is :: IxList) a.
(MonadTweak m, Is k A_Getter) =>
Optic' k is TxSkel a -> m a
viewTweak Optic' A_Lens NoIx TxSkel [TxSkelOut]
txSkelOutsL
  let ([TxSkelOut]
removed, [TxSkelOut]
kept) = (TxSkelOut -> Bool) -> [TxSkelOut] -> ([TxSkelOut], [TxSkelOut])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition TxSkelOut -> Bool
removePred [TxSkelOut]
presentOutputs
  Optic' A_Lens NoIx TxSkel [TxSkelOut] -> [TxSkelOut] -> m ()
forall (m :: * -> *) k (is :: IxList) a.
(MonadTweak m, Is k A_Setter) =>
Optic' k is TxSkel a -> a -> m ()
setTweak Optic' A_Lens NoIx TxSkel [TxSkelOut]
txSkelOutsL [TxSkelOut]
kept
  [TxSkelOut] -> m [TxSkelOut]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [TxSkelOut]
removed

-- | A label added to a 'TxSkel' on which the 'tamperDatumTweak' has been
-- successfully applied
data TamperDatumLbl = TamperDatumLbl deriving (Int -> TamperDatumLbl -> ShowS
[TamperDatumLbl] -> ShowS
TamperDatumLbl -> String
(Int -> TamperDatumLbl -> ShowS)
-> (TamperDatumLbl -> String)
-> ([TamperDatumLbl] -> ShowS)
-> Show TamperDatumLbl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TamperDatumLbl -> ShowS
showsPrec :: Int -> TamperDatumLbl -> ShowS
$cshow :: TamperDatumLbl -> String
show :: TamperDatumLbl -> String
$cshowList :: [TamperDatumLbl] -> ShowS
showList :: [TamperDatumLbl] -> ShowS
Show, TamperDatumLbl -> TamperDatumLbl -> Bool
(TamperDatumLbl -> TamperDatumLbl -> Bool)
-> (TamperDatumLbl -> TamperDatumLbl -> Bool) -> Eq TamperDatumLbl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TamperDatumLbl -> TamperDatumLbl -> Bool
== :: TamperDatumLbl -> TamperDatumLbl -> Bool
$c/= :: TamperDatumLbl -> TamperDatumLbl -> Bool
/= :: TamperDatumLbl -> TamperDatumLbl -> Bool
Eq, Eq TamperDatumLbl
Eq TamperDatumLbl =>
(TamperDatumLbl -> TamperDatumLbl -> Ordering)
-> (TamperDatumLbl -> TamperDatumLbl -> Bool)
-> (TamperDatumLbl -> TamperDatumLbl -> Bool)
-> (TamperDatumLbl -> TamperDatumLbl -> Bool)
-> (TamperDatumLbl -> TamperDatumLbl -> Bool)
-> (TamperDatumLbl -> TamperDatumLbl -> TamperDatumLbl)
-> (TamperDatumLbl -> TamperDatumLbl -> TamperDatumLbl)
-> Ord TamperDatumLbl
TamperDatumLbl -> TamperDatumLbl -> Bool
TamperDatumLbl -> TamperDatumLbl -> Ordering
TamperDatumLbl -> TamperDatumLbl -> TamperDatumLbl
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TamperDatumLbl -> TamperDatumLbl -> Ordering
compare :: TamperDatumLbl -> TamperDatumLbl -> Ordering
$c< :: TamperDatumLbl -> TamperDatumLbl -> Bool
< :: TamperDatumLbl -> TamperDatumLbl -> Bool
$c<= :: TamperDatumLbl -> TamperDatumLbl -> Bool
<= :: TamperDatumLbl -> TamperDatumLbl -> Bool
$c> :: TamperDatumLbl -> TamperDatumLbl -> Bool
> :: TamperDatumLbl -> TamperDatumLbl -> Bool
$c>= :: TamperDatumLbl -> TamperDatumLbl -> Bool
>= :: TamperDatumLbl -> TamperDatumLbl -> Bool
$cmax :: TamperDatumLbl -> TamperDatumLbl -> TamperDatumLbl
max :: TamperDatumLbl -> TamperDatumLbl -> TamperDatumLbl
$cmin :: TamperDatumLbl -> TamperDatumLbl -> TamperDatumLbl
min :: TamperDatumLbl -> TamperDatumLbl -> TamperDatumLbl
Ord)

instance PrettyCooked TamperDatumLbl where
  prettyCooked :: TamperDatumLbl -> DocCooked
prettyCooked TamperDatumLbl
_ = DocCooked
"TamperDatum"

-- | A tweak that tries to change the datum on outputs carrying datums of a
-- certain type with a prescribed tampering function. The tampering function
-- ignores datums of other types and those for which it returns @Nothing@.
--
-- The tweak returns a list of the modified datums, as they were *before* the
-- modification was applied to them.
tamperDatumTweak :: forall a m. (MonadTweak m, Api.FromData a, Typeable a) => (a -> Maybe a) -> m [a]
tamperDatumTweak :: forall a (m :: * -> *).
(MonadTweak m, FromData a, Typeable a) =>
(a -> Maybe a) -> m [a]
tamperDatumTweak a -> Maybe a
change = do
  [a]
beforeModification <- Optic' A_Traversal NoIx TxSkel a -> (a -> Maybe a) -> m [a]
forall (m :: * -> *) k (is :: IxList) a.
(MonadTweak m, Is k A_Traversal) =>
Optic' k is TxSkel a -> (a -> Maybe a) -> m [a]
overMaybeTweak (Optic' A_Lens NoIx TxSkel [TxSkelOut]
txSkelOutsL Optic' A_Lens NoIx TxSkel [TxSkelOut]
-> Optic
     A_Traversal NoIx [TxSkelOut] [TxSkelOut] TxSkelOut TxSkelOut
-> Optic A_Traversal NoIx TxSkel TxSkel TxSkelOut TxSkelOut
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Traversal NoIx [TxSkelOut] [TxSkelOut] TxSkelOut TxSkelOut
forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed Optic A_Traversal NoIx TxSkel TxSkel TxSkelOut TxSkelOut
-> Optic An_AffineTraversal NoIx TxSkelOut TxSkelOut a a
-> Optic' A_Traversal NoIx TxSkel a
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic An_AffineTraversal NoIx TxSkelOut TxSkelOut a a
forall a. (FromData a, Typeable a) => AffineTraversal' TxSkelOut a
txSkelOutputDatumTypeAT) a -> Maybe a
change
  Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> ([a] -> Bool) -> [a] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([a] -> m ()) -> [a] -> m ()
forall a b. (a -> b) -> a -> b
$ [a]
beforeModification
  TamperDatumLbl -> m ()
forall (m :: * -> *) x. (MonadTweak m, LabelConstrs x) => x -> m ()
addLabelTweak TamperDatumLbl
TamperDatumLbl
  [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
beforeModification

-- | A tweak that tries to change the datum on outputs carrying datums of a
-- certain type with a prescribed tampering function. There are two main
-- differences with 'tamperDatumTweak'. First, the tampering function returns
-- 'Api.BuiltinData', allowing it to do pretty much anything with the
-- datums. Second, for every output datum there are zero or more options for how
-- to modify it, and all combinations of these modifications are tried.
--
-- That is, if there are @n@ output datums, for which there are @k_1,...,k_n@
-- possible modifications, this tweak will try
--
-- >   k_1 + ... + k_n
-- > + k_1 * k_2 + ... + k_{n-1} * k_n
-- > + k_1 * k_2 * k_3 + ... + k_{n-2} * k_{n-1} * k_n
-- > + ...
-- > + k_1 * k_2 * ... * k_{n-1} * k_n
-- > == (k_1 + 1) * ... * (k_n + 1) - 1
--
-- modified transactions.
malformDatumTweak :: forall a m. (MonadTweak m, Typeable a) => (a -> [Api.BuiltinData]) -> m ()
malformDatumTweak :: forall a (m :: * -> *).
(MonadTweak m, Typeable a) =>
(a -> [BuiltinData]) -> m ()
malformDatumTweak a -> [BuiltinData]
change = do
  [TxSkelOut]
outputs <- Optic A_Traversal NoIx TxSkel TxSkel TxSkelOut TxSkelOut
-> m [TxSkelOut]
forall (m :: * -> *) k (is :: IxList) a.
(MonadTweak m, Is k A_Fold) =>
Optic' k is TxSkel a -> m [a]
viewAllTweak (Optic' A_Lens NoIx TxSkel [TxSkelOut]
txSkelOutsL Optic' A_Lens NoIx TxSkel [TxSkelOut]
-> Optic
     A_Traversal NoIx [TxSkelOut] [TxSkelOut] TxSkelOut TxSkelOut
-> Optic A_Traversal NoIx TxSkel TxSkel TxSkelOut TxSkelOut
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Traversal NoIx [TxSkelOut] [TxSkelOut] TxSkelOut TxSkelOut
forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed)
  let modifiedOutputs :: [[TxSkelOut]]
modifiedOutputs = (TxSkelOut -> [TxSkelOut]) -> [TxSkelOut] -> [[TxSkelOut]]
forall a b. (a -> b) -> [a] -> [b]
map (\TxSkelOut
output -> TxSkelOut
output TxSkelOut -> [TxSkelOut] -> [TxSkelOut]
forall a. a -> [a] -> [a]
: TxSkelOut -> [TxSkelOut]
changeOutput TxSkelOut
output) [TxSkelOut]
outputs
      -- We remove the first combination because it consists of all the heads
      -- and therefore it is the combination consisting of no changes at all.
      modifiedOutputGroups :: [[TxSkelOut]]
modifiedOutputGroups = [[TxSkelOut]] -> [[TxSkelOut]]
forall a. HasCallStack => [a] -> [a]
tail ([[TxSkelOut]] -> [[TxSkelOut]]) -> [[TxSkelOut]] -> [[TxSkelOut]]
forall a b. (a -> b) -> a -> b
$ [[TxSkelOut]] -> [[TxSkelOut]]
forall a. [[a]] -> [[a]]
allCombinations [[TxSkelOut]]
modifiedOutputs
  [m ()] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([m ()] -> m ()) -> [m ()] -> m ()
forall a b. (a -> b) -> a -> b
$ ([TxSkelOut] -> m ()) -> [[TxSkelOut]] -> [m ()]
forall a b. (a -> b) -> [a] -> [b]
map (Optic' A_Lens NoIx TxSkel [TxSkelOut] -> [TxSkelOut] -> m ()
forall (m :: * -> *) k (is :: IxList) a.
(MonadTweak m, Is k A_Setter) =>
Optic' k is TxSkel a -> a -> m ()
setTweak Optic' A_Lens NoIx TxSkel [TxSkelOut]
txSkelOutsL) [[TxSkelOut]]
modifiedOutputGroups
  MalformDatumLbl -> m ()
forall (m :: * -> *) x. (MonadTweak m, LabelConstrs x) => x -> m ()
addLabelTweak MalformDatumLbl
MalformDatumLbl
  where
    changeOutput :: TxSkelOut -> [TxSkelOut]
    changeOutput :: TxSkelOut -> [TxSkelOut]
changeOutput (Pays o
out) =
      do
        let dat :: TxSkelOutDatum
dat = Optic' A_Lens NoIx o TxSkelOutDatum -> o -> TxSkelOutDatum
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Lens' o (DatumType o)
Optic' A_Lens NoIx o TxSkelOutDatum
forall o. IsAbstractOutput o => Lens' o (DatumType o)
outputDatumL o
out
        a
typedDat <- Maybe a -> [a]
forall a. Maybe a -> [a]
maybeToList (Maybe a -> [a]) -> Maybe a -> [a]
forall a b. (a -> b) -> a -> b
$ forall a. Typeable a => TxSkelOutDatum -> Maybe a
txSkelOutTypedDatum @a TxSkelOutDatum
dat
        BuiltinData
modifiedDat <- a -> [BuiltinData]
change a
typedDat
        TxSkelOut -> [TxSkelOut]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (TxSkelOut -> [TxSkelOut]) -> TxSkelOut -> [TxSkelOut]
forall a b. (a -> b) -> a -> b
$ ConcreteOutput
  (OwnerType o) TxSkelOutDatum TxSkelOutValue (ReferenceScriptType o)
-> TxSkelOut
forall o.
(Show o, Typeable o, IsTxInfoOutput o,
 OwnerConstraints (OwnerType o), DatumType o ~ TxSkelOutDatum,
 ValueType o ~ TxSkelOutValue,
 ReferenceScriptConstraints (ReferenceScriptType o)) =>
o -> TxSkelOut
Pays (ConcreteOutput
   (OwnerType o) TxSkelOutDatum TxSkelOutValue (ReferenceScriptType o)
 -> TxSkelOut)
-> ConcreteOutput
     (OwnerType o) TxSkelOutDatum TxSkelOutValue (ReferenceScriptType o)
-> TxSkelOut
forall a b. (a -> b) -> a -> b
$ o
-> TxSkelOutDatum
-> ConcreteOutput
     (OwnerType o) TxSkelOutDatum (ValueType o) (ReferenceScriptType o)
forall out dat.
IsAbstractOutput out =>
out
-> dat
-> ConcreteOutput
     (OwnerType out) dat (ValueType out) (ReferenceScriptType out)
setDatum o
out (TxSkelOutDatum
 -> ConcreteOutput
      (OwnerType o) TxSkelOutDatum (ValueType o) (ReferenceScriptType o))
-> TxSkelOutDatum
-> ConcreteOutput
     (OwnerType o) TxSkelOutDatum (ValueType o) (ReferenceScriptType o)
forall a b. (a -> b) -> a -> b
$ case TxSkelOutDatum
dat of
          TxSkelOutDatum
TxSkelOutNoDatum -> TxSkelOutDatum
TxSkelOutNoDatum
          TxSkelOutDatum a
_ -> BuiltinData -> TxSkelOutDatum
forall a. TxSkelOutDatumConstrs a => a -> TxSkelOutDatum
TxSkelOutDatum BuiltinData
modifiedDat
          TxSkelOutDatumHash a
_ -> BuiltinData -> TxSkelOutDatum
forall a. TxSkelOutDatumConstrs a => a -> TxSkelOutDatum
TxSkelOutDatumHash BuiltinData
modifiedDat
          TxSkelOutInlineDatum a
_ -> BuiltinData -> TxSkelOutDatum
forall a. TxSkelOutDatumConstrs a => a -> TxSkelOutDatum
TxSkelOutInlineDatum BuiltinData
modifiedDat

-- | A label added to a 'TxSkel' on which the 'malformDatumTweak' has been
-- successfully applied
data MalformDatumLbl = MalformDatumLbl deriving (Int -> MalformDatumLbl -> ShowS
[MalformDatumLbl] -> ShowS
MalformDatumLbl -> String
(Int -> MalformDatumLbl -> ShowS)
-> (MalformDatumLbl -> String)
-> ([MalformDatumLbl] -> ShowS)
-> Show MalformDatumLbl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MalformDatumLbl -> ShowS
showsPrec :: Int -> MalformDatumLbl -> ShowS
$cshow :: MalformDatumLbl -> String
show :: MalformDatumLbl -> String
$cshowList :: [MalformDatumLbl] -> ShowS
showList :: [MalformDatumLbl] -> ShowS
Show, MalformDatumLbl -> MalformDatumLbl -> Bool
(MalformDatumLbl -> MalformDatumLbl -> Bool)
-> (MalformDatumLbl -> MalformDatumLbl -> Bool)
-> Eq MalformDatumLbl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MalformDatumLbl -> MalformDatumLbl -> Bool
== :: MalformDatumLbl -> MalformDatumLbl -> Bool
$c/= :: MalformDatumLbl -> MalformDatumLbl -> Bool
/= :: MalformDatumLbl -> MalformDatumLbl -> Bool
Eq, Eq MalformDatumLbl
Eq MalformDatumLbl =>
(MalformDatumLbl -> MalformDatumLbl -> Ordering)
-> (MalformDatumLbl -> MalformDatumLbl -> Bool)
-> (MalformDatumLbl -> MalformDatumLbl -> Bool)
-> (MalformDatumLbl -> MalformDatumLbl -> Bool)
-> (MalformDatumLbl -> MalformDatumLbl -> Bool)
-> (MalformDatumLbl -> MalformDatumLbl -> MalformDatumLbl)
-> (MalformDatumLbl -> MalformDatumLbl -> MalformDatumLbl)
-> Ord MalformDatumLbl
MalformDatumLbl -> MalformDatumLbl -> Bool
MalformDatumLbl -> MalformDatumLbl -> Ordering
MalformDatumLbl -> MalformDatumLbl -> MalformDatumLbl
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MalformDatumLbl -> MalformDatumLbl -> Ordering
compare :: MalformDatumLbl -> MalformDatumLbl -> Ordering
$c< :: MalformDatumLbl -> MalformDatumLbl -> Bool
< :: MalformDatumLbl -> MalformDatumLbl -> Bool
$c<= :: MalformDatumLbl -> MalformDatumLbl -> Bool
<= :: MalformDatumLbl -> MalformDatumLbl -> Bool
$c> :: MalformDatumLbl -> MalformDatumLbl -> Bool
> :: MalformDatumLbl -> MalformDatumLbl -> Bool
$c>= :: MalformDatumLbl -> MalformDatumLbl -> Bool
>= :: MalformDatumLbl -> MalformDatumLbl -> Bool
$cmax :: MalformDatumLbl -> MalformDatumLbl -> MalformDatumLbl
max :: MalformDatumLbl -> MalformDatumLbl -> MalformDatumLbl
$cmin :: MalformDatumLbl -> MalformDatumLbl -> MalformDatumLbl
min :: MalformDatumLbl -> MalformDatumLbl -> MalformDatumLbl
Ord)

instance PrettyCooked MalformDatumLbl where
  prettyCooked :: MalformDatumLbl -> DocCooked
prettyCooked MalformDatumLbl
_ = DocCooked
"MalformDatum"

-- | Given a list of lists @l@, we call “combination” of @l@ a list @c@ such
-- that - @length c == length l@, and - for all @0 <= i < length c@, @elem (c !!
-- i) (l !! i)@.
--
-- 'allCombinations', as the name suggests, returns all the possible
-- combinations of a given list of lists. For instance:
--
-- @allCombinations [[1,2,3], [4,5], [6]] == [[1,4,6], [1,5,6], [2,4,6], [2,5,6], [3,4,6], [3,5,6]]@
--
-- It is guaranteed that combinations are returned in such an order that a
-- combination @c1@ comes before a combination @c2@ in the result list if and
-- only if for some prefix list @p@, some elements @a1@ and @a2@ and for some
-- rest lists @r1@ and @r2@:
-- > c1 == p ++ (a1 : r1)
-- > c2 == p ++ (a2 : r2)
-- and @a1@ comes before @a2@ in the list @l !! length p@. In particular, the
-- first element of the result list is the combination consisting of all the
-- first elements of the input lists.
allCombinations :: [[a]] -> [[a]]
allCombinations :: forall a. [[a]] -> [[a]]
allCombinations [] = [[]]
allCombinations [[]] = [] -- included in the next one
allCombinations ([a]
first : [[a]]
rest) = [a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs | a
x <- [a]
first, [a]
xs <- [[a]] -> [[a]]
forall a. [[a]] -> [[a]]
allCombinations [[a]]
rest]