-- | This module provide tweaks to tamper with output datums in a typed
-- manner. There are many use cases where slight changes in datum can have a
-- drastic effect on the bahavior of a contract, and can be unchecked. Here is
-- the way to test those cases.
module Cooked.Tweak.TamperDatum
  ( 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 Optics.Core
import PlutusLedgerApi.V3 qualified as Api
import Type.Reflection

-- | A tweak that tries to change the datum on outputs carrying datums of a
-- certain type with a prescribed tampering function.
--
-- 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,
    Show a,
    PrettyCooked a,
    Api.ToData a,
    Api.FromData a,
    Typeable a
  ) =>
  -- | Use this function to return 'Just' the changed datum, if you want to
  -- perform a change, and 'Nothing', if you want to leave it as-is. All datums
  -- on outputs that are not of type @a@ are never touched.
  (a -> Maybe a) ->
  m [a]
tamperDatumTweak :: forall a (m :: * -> *).
(MonadTweak m, Show a, PrettyCooked a, ToData a, FromData a,
 Typeable a) =>
(a -> Maybe a) -> m [a]
tamperDatumTweak a -> Maybe a
change = do
  [a]
beforeModification <-
    Optic' A_Traversal '[] 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
      ( Lens' TxSkel [TxSkelOut]
txSkelOutsL
          Lens' TxSkel [TxSkelOut]
-> Optic
     A_Traversal '[] [TxSkelOut] [TxSkelOut] TxSkelOut TxSkelOut
-> Optic A_Traversal '[] 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 '[] [TxSkelOut] [TxSkelOut] TxSkelOut TxSkelOut
forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed
          Optic A_Traversal '[] TxSkel TxSkel TxSkelOut TxSkelOut
-> Optic An_AffineTraversal '[] TxSkelOut TxSkelOut a a
-> Optic' A_Traversal '[] 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
% forall a. (FromData a, Typeable a) => AffineTraversal' TxSkelOut a
txSkelOutputDatumTypeAT @a
      )
      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

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. There are two main
-- differences with 'tamperDatumTweak'. First, the tampering function returns
-- '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,
    Api.ToData a,
    Api.FromData a,
    Typeable a
  ) =>
  (a -> [Api.BuiltinData]) ->
  m ()
malformDatumTweak :: forall a (m :: * -> *).
(MonadTweak m, ToData a, FromData a, Typeable a) =>
(a -> [BuiltinData]) -> m ()
malformDatumTweak a -> [BuiltinData]
change = do
  [TxSkelOut]
outputs <- Optic A_Traversal '[] 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 (Lens' TxSkel [TxSkelOut]
txSkelOutsL Lens' TxSkel [TxSkelOut]
-> Optic
     A_Traversal '[] [TxSkelOut] [TxSkelOut] TxSkelOut TxSkelOut
-> Optic A_Traversal '[] 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 '[] [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 (Lens' TxSkel [TxSkelOut] -> [TxSkelOut] -> m ()
forall (m :: * -> *) k (is :: IxList) a.
(MonadTweak m, Is k A_Setter) =>
Optic' k is TxSkel a -> a -> m ()
setTweak Lens' 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) =
      let datums :: [TxSkelOutDatum]
datums = TxSkelOutDatum -> [TxSkelOutDatum]
changeTxSkelOutDatum (TxSkelOutDatum -> [TxSkelOutDatum])
-> TxSkelOutDatum -> [TxSkelOutDatum]
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens '[] 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 '[] o TxSkelOutDatum
forall o. IsAbstractOutput o => Lens' o (DatumType o)
outputDatumL o
out
       in (TxSkelOutDatum -> TxSkelOut) -> [TxSkelOutDatum] -> [TxSkelOut]
forall a b. (a -> b) -> [a] -> [b]
map
            ( \TxSkelOutDatum
datum ->
                ConcreteOutput
  (OwnerType o) TxSkelOutDatum Value (ReferenceScriptType o)
-> TxSkelOut
forall o.
(Show o, Typeable o, IsTxInfoOutput o,
 IsTxSkelOutAllowedOwner (OwnerType o), Typeable (OwnerType o),
 ToCredential (OwnerType o), DatumType o ~ TxSkelOutDatum,
 ValueType o ~ Value, ToVersionedScript (ReferenceScriptType o),
 Show (OwnerType o), Show (ReferenceScriptType o),
 Typeable (ReferenceScriptType o)) =>
o -> TxSkelOut
Pays (ConcreteOutput
   (OwnerType o) TxSkelOutDatum Value (ReferenceScriptType o)
 -> TxSkelOut)
-> ConcreteOutput
     (OwnerType o) TxSkelOutDatum Value (ReferenceScriptType o)
-> TxSkelOut
forall a b. (a -> b) -> a -> b
$
                  OwnerType o
-> Maybe StakingCredential
-> TxSkelOutDatum
-> Value
-> Maybe (ReferenceScriptType o)
-> ConcreteOutput
     (OwnerType o) TxSkelOutDatum Value (ReferenceScriptType o)
forall ownerType datumType valueType referenceScriptType.
ownerType
-> Maybe StakingCredential
-> datumType
-> valueType
-> Maybe referenceScriptType
-> ConcreteOutput ownerType datumType valueType referenceScriptType
ConcreteOutput
                    (o
out o -> Optic' A_Lens '[] o (OwnerType o) -> OwnerType o
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens '[] o (OwnerType o)
forall o. IsAbstractOutput o => Lens' o (OwnerType o)
outputOwnerL)
                    (o
out o
-> Optic' A_Lens '[] o (Maybe StakingCredential)
-> Maybe StakingCredential
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens '[] o (Maybe StakingCredential)
forall o. IsAbstractOutput o => Lens' o (Maybe StakingCredential)
outputStakingCredentialL)
                    TxSkelOutDatum
datum
                    (o
out o -> Optic' A_Lens '[] o Value -> Value
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens '[] o Value
Lens' o (ValueType o)
forall o. IsAbstractOutput o => Lens' o (ValueType o)
outputValueL)
                    (o
out o
-> Optic' A_Lens '[] o (Maybe (ReferenceScriptType o))
-> Maybe (ReferenceScriptType o)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens '[] o (Maybe (ReferenceScriptType o))
forall o.
IsAbstractOutput o =>
Lens' o (Maybe (ReferenceScriptType o))
outputReferenceScriptL)
            )
            [TxSkelOutDatum]
datums

    changeTxSkelOutDatum :: TxSkelOutDatum -> [TxSkelOutDatum]
    changeTxSkelOutDatum :: TxSkelOutDatum -> [TxSkelOutDatum]
changeTxSkelOutDatum TxSkelOutDatum
TxSkelOutNoDatum = []
    changeTxSkelOutDatum (TxSkelOutDatum a
datum) = (BuiltinData -> TxSkelOutDatum)
-> [BuiltinData] -> [TxSkelOutDatum]
forall a b. (a -> b) -> [a] -> [b]
map BuiltinData -> TxSkelOutDatum
forall a. TxSkelOutDatumConstrs a => a -> TxSkelOutDatum
TxSkelOutDatum ([BuiltinData] -> [TxSkelOutDatum])
-> [BuiltinData] -> [TxSkelOutDatum]
forall a b. (a -> b) -> a -> b
$ a -> [BuiltinData]
forall b. Typeable b => b -> [BuiltinData]
changeOnCorrectType a
datum
    changeTxSkelOutDatum (TxSkelOutDatumHash a
datum) = (BuiltinData -> TxSkelOutDatum)
-> [BuiltinData] -> [TxSkelOutDatum]
forall a b. (a -> b) -> [a] -> [b]
map BuiltinData -> TxSkelOutDatum
forall a. TxSkelOutDatumConstrs a => a -> TxSkelOutDatum
TxSkelOutDatumHash ([BuiltinData] -> [TxSkelOutDatum])
-> [BuiltinData] -> [TxSkelOutDatum]
forall a b. (a -> b) -> a -> b
$ a -> [BuiltinData]
forall b. Typeable b => b -> [BuiltinData]
changeOnCorrectType a
datum
    changeTxSkelOutDatum (TxSkelOutInlineDatum a
datum) = (BuiltinData -> TxSkelOutDatum)
-> [BuiltinData] -> [TxSkelOutDatum]
forall a b. (a -> b) -> [a] -> [b]
map BuiltinData -> TxSkelOutDatum
forall a. TxSkelOutDatumConstrs a => a -> TxSkelOutDatum
TxSkelOutInlineDatum ([BuiltinData] -> [TxSkelOutDatum])
-> [BuiltinData] -> [TxSkelOutDatum]
forall a b. (a -> b) -> a -> b
$ a -> [BuiltinData]
forall b. Typeable b => b -> [BuiltinData]
changeOnCorrectType a
datum

    changeOnCorrectType :: (Typeable b) => b -> [Api.BuiltinData]
    changeOnCorrectType :: forall b. Typeable b => b -> [BuiltinData]
changeOnCorrectType b
datum = case b -> TypeRep b
forall a. Typeable a => a -> TypeRep a
typeOf b
datum TypeRep b -> TypeRep a -> Maybe (b :~~: a)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) of
      Just b :~~: a
HRefl -> a -> [BuiltinData]
change a
b
datum
      Maybe (b :~~: a)
Nothing -> []

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]