{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Roboservant.Direct
  ( fuzz',
    Config (..),
    -- TODO come up with something smarter than exporting all this, we should
    -- have some nice error-display functions
    RoboservantException (..),
    FuzzState (..),
    FuzzOp (..),
    FailureType (..),
    Report (..),
  )
where

import Control.Exception.Lifted
  ( Exception,
    Handler (Handler),
    SomeAsyncException,
    SomeException,
    catch,
    catches,
    handle,
    throw,
  )
import Control.Monad.State.Strict
  ( MonadIO (..),
    MonadState (get),
    StateT (runStateT),
    modify',
  )
import Control.Monad.Trans.Control (MonadBaseControl)
import qualified Data.Dependent.Map as DM
import Data.Dynamic (Dynamic (..))
import qualified Data.IntSet as IntSet
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NEL
import Data.Maybe (mapMaybe)
import qualified Data.Set as Set
import Data.Time.Clock (UTCTime, addUTCTime, getCurrentTime)
import qualified Data.Vinyl as V
import qualified Data.Vinyl.Curry as V
import qualified Data.Vinyl.Functor as V
import GHC.Generics ((:*:) (..))
import Roboservant.Types
  ( ApiOffset (..),
    Argument (..),
    InteractionError(..),
    Provenance (..),
    ReifiedApi,
    ReifiedEndpoint (..),
    Stash (..),
    StashValue (..),
    TypedF,
  )
import Roboservant.Types.Config

import System.Random (Random (randomR), StdGen, mkStdGen)
import qualified Type.Reflection as R

data RoboservantException
  = RoboservantException
      { RoboservantException -> FailureType
failureReason :: FailureType,
        RoboservantException -> Maybe SomeException
serverException :: Maybe SomeException,
        RoboservantException -> FuzzState
fuzzState :: FuzzState
      }
  deriving (Int -> RoboservantException -> ShowS
[RoboservantException] -> ShowS
RoboservantException -> String
(Int -> RoboservantException -> ShowS)
-> (RoboservantException -> String)
-> ([RoboservantException] -> ShowS)
-> Show RoboservantException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RoboservantException -> ShowS
showsPrec :: Int -> RoboservantException -> ShowS
$cshow :: RoboservantException -> String
show :: RoboservantException -> String
$cshowList :: [RoboservantException] -> ShowS
showList :: [RoboservantException] -> ShowS
Show)

instance Exception RoboservantException

data FailureType
  = ServerCrashed
  | CheckerFailed
  | NoPossibleMoves
  | InsufficientCoverage Double
  deriving (Int -> FailureType -> ShowS
[FailureType] -> ShowS
FailureType -> String
(Int -> FailureType -> ShowS)
-> (FailureType -> String)
-> ([FailureType] -> ShowS)
-> Show FailureType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FailureType -> ShowS
showsPrec :: Int -> FailureType -> ShowS
$cshow :: FailureType -> String
show :: FailureType -> String
$cshowList :: [FailureType] -> ShowS
showList :: [FailureType] -> ShowS
Show, FailureType -> FailureType -> Bool
(FailureType -> FailureType -> Bool)
-> (FailureType -> FailureType -> Bool) -> Eq FailureType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FailureType -> FailureType -> Bool
== :: FailureType -> FailureType -> Bool
$c/= :: FailureType -> FailureType -> Bool
/= :: FailureType -> FailureType -> Bool
Eq)

data FuzzOp
  = FuzzOp
      { FuzzOp -> ApiOffset
apiOffset :: ApiOffset,
        FuzzOp -> [Provenance]
provenance :: [Provenance]
      }
  deriving (Int -> FuzzOp -> ShowS
[FuzzOp] -> ShowS
FuzzOp -> String
(Int -> FuzzOp -> ShowS)
-> (FuzzOp -> String) -> ([FuzzOp] -> ShowS) -> Show FuzzOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FuzzOp -> ShowS
showsPrec :: Int -> FuzzOp -> ShowS
$cshow :: FuzzOp -> String
show :: FuzzOp -> String
$cshowList :: [FuzzOp] -> ShowS
showList :: [FuzzOp] -> ShowS
Show, FuzzOp -> FuzzOp -> Bool
(FuzzOp -> FuzzOp -> Bool)
-> (FuzzOp -> FuzzOp -> Bool) -> Eq FuzzOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FuzzOp -> FuzzOp -> Bool
== :: FuzzOp -> FuzzOp -> Bool
$c/= :: FuzzOp -> FuzzOp -> Bool
/= :: FuzzOp -> FuzzOp -> Bool
Eq)

data FuzzState
  = FuzzState
      { FuzzState -> [FuzzOp]
path :: [FuzzOp],
        FuzzState -> Stash
stash :: Stash,
        FuzzState -> StdGen
currentRng :: StdGen
      }
  deriving (Int -> FuzzState -> ShowS
[FuzzState] -> ShowS
FuzzState -> String
(Int -> FuzzState -> ShowS)
-> (FuzzState -> String)
-> ([FuzzState] -> ShowS)
-> Show FuzzState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FuzzState -> ShowS
showsPrec :: Int -> FuzzState -> ShowS
$cshow :: FuzzState -> String
show :: FuzzState -> String
$cshowList :: [FuzzState] -> ShowS
showList :: [FuzzState] -> ShowS
Show)

data EndpointOption
  = forall as.
    (V.RecordToList as, V.RMap as) =>
    EndpointOption
      { ()
eoCall :: V.Curried as (IO (Either InteractionError (NonEmpty (Dynamic, Int)))),
        ()
eoArgs :: V.Rec (TypedF StashValue) as
      }

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

data Report
  = Report
      { Report -> String
textual :: String,
        Report -> RoboservantException
rsException :: RoboservantException
      }
  deriving (Int -> Report -> ShowS
[Report] -> ShowS
Report -> String
(Int -> Report -> ShowS)
-> (Report -> String) -> ([Report] -> ShowS) -> Show Report
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Report -> ShowS
showsPrec :: Int -> Report -> ShowS
$cshow :: Report -> String
show :: Report -> String
$cshowList :: [Report] -> ShowS
showList :: [Report] -> ShowS
Show)



-- fuzzClient :: Client api -> Config -> IO (Maybe Report)
-- fuzzClient = undefined



fuzz' ::
  ReifiedApi ->
  Config ->
  IO (Maybe Report)
fuzz' :: ReifiedApi -> Config -> IO (Maybe Report)
fuzz' ReifiedApi
reifiedApi Config {Double
Int
Integer
[(Dynamic, Int)]
IO ()
String -> IO ()
seed :: [(Dynamic, Int)]
maxRuntime :: Double
maxReps :: Integer
rngSeed :: Int
coverageThreshold :: Double
logInfo :: String -> IO ()
healthCheck :: IO ()
healthCheck :: Config -> IO ()
logInfo :: Config -> String -> IO ()
coverageThreshold :: Config -> Double
rngSeed :: Config -> Int
maxReps :: Config -> Integer
maxRuntime :: Config -> Double
seed :: Config -> [(Dynamic, Int)]
..} = (RoboservantException -> IO (Maybe Report))
-> IO (Maybe Report) -> IO (Maybe Report)
forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
(e -> m a) -> m a -> m a
handle (Maybe Report -> IO (Maybe Report)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Report -> IO (Maybe Report))
-> (RoboservantException -> Maybe Report)
-> RoboservantException
-> IO (Maybe Report)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Report -> Maybe Report
forall a. a -> Maybe a
Just (Report -> Maybe Report)
-> (RoboservantException -> Report)
-> RoboservantException
-> Maybe Report
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoboservantException -> Report
formatException) (IO (Maybe Report) -> IO (Maybe Report))
-> IO (Maybe Report) -> IO (Maybe Report)
forall a b. (a -> b) -> a -> b
$ do
  let path :: [a]
path = []
      stash :: Stash
stash = [(Dynamic, Int)] -> Stash -> Stash
addToStash [(Dynamic, Int)]
seed Stash
forall a. Monoid a => a
mempty
      currentRng :: StdGen
currentRng = Int -> StdGen
mkStdGen Int
rngSeed
  UTCTime
deadline :: UTCTime <- NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (Double -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> NominalDiffTime) -> Double -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Double
maxRuntime Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000000) (UTCTime -> UTCTime) -> IO UTCTime -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime
  (StopReason
stopreason, FuzzState
_fs) <-
    StateT FuzzState IO StopReason
-> FuzzState -> IO (StopReason, FuzzState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT
      ((Integer, UTCTime)
-> StateT FuzzState IO () -> StateT FuzzState IO StopReason
forall (m :: * -> *) a.
MonadIO m =>
(Integer, UTCTime) -> m a -> m StopReason
untilDone (Integer
maxReps, UTCTime
deadline) StateT FuzzState IO ()
forall (m :: * -> *).
(MonadState FuzzState m, MonadIO m, MonadBaseControl IO m) =>
m ()
go StateT FuzzState IO StopReason
-> StateT FuzzState IO () -> StateT FuzzState IO StopReason
forall a b.
StateT FuzzState IO a
-> StateT FuzzState IO b -> StateT FuzzState IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (FuzzState -> StateT FuzzState IO ()
evaluateCoverage (FuzzState -> StateT FuzzState IO ())
-> StateT FuzzState IO FuzzState -> StateT FuzzState IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StateT FuzzState IO FuzzState
forall s (m :: * -> *). MonadState s m => m s
get))
      FuzzState {[FuzzOp]
StdGen
Stash
forall a. [a]
path :: [FuzzOp]
stash :: Stash
currentRng :: StdGen
path :: forall a. [a]
stash :: Stash
currentRng :: StdGen
..}
  String -> IO ()
logInfo (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ StopReason -> String
forall a. Show a => a -> String
show StopReason
stopreason
  Maybe Report -> IO (Maybe Report)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Report
forall a. Maybe a
Nothing
  where
    -- something less terrible later
    formatException :: RoboservantException -> Report
    formatException :: RoboservantException -> Report
formatException r :: RoboservantException
r@(RoboservantException FailureType
failureType Maybe SomeException
exception FuzzState
_state) =
      String -> RoboservantException -> Report
Report
        ([String] -> String
unlines [FailureType -> String
forall a. Show a => a -> String
show FailureType
failureType, Maybe SomeException -> String
forall a. Show a => a -> String
show Maybe SomeException
exception])
        RoboservantException
r
    displayDiagnostics :: FuzzState -> StateT FuzzState IO ()
displayDiagnostics FuzzState {[FuzzOp]
StdGen
Stash
path :: FuzzState -> [FuzzOp]
stash :: FuzzState -> Stash
currentRng :: FuzzState -> StdGen
path :: [FuzzOp]
stash :: Stash
currentRng :: StdGen
..} = IO () -> StateT FuzzState IO ()
forall a. IO a -> StateT FuzzState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT FuzzState IO ())
-> IO () -> StateT FuzzState IO ()
forall a b. (a -> b) -> a -> b
$
      String -> IO ()
logInfo (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
      [String
"api endpoints covered"]
        [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> ((ApiOffset -> String) -> [ApiOffset] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ApiOffset -> String
forall a. Show a => a -> String
show ([ApiOffset] -> [String])
-> ([ApiOffset] -> [ApiOffset]) -> [ApiOffset] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set ApiOffset -> [ApiOffset]
forall a. Set a -> [a]
Set.toList (Set ApiOffset -> [ApiOffset])
-> ([ApiOffset] -> Set ApiOffset) -> [ApiOffset] -> [ApiOffset]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ApiOffset] -> Set ApiOffset
forall a. Ord a => [a] -> Set a
Set.fromList ([ApiOffset] -> [String]) -> [ApiOffset] -> [String]
forall a b. (a -> b) -> a -> b
$ (FuzzOp -> ApiOffset) -> [FuzzOp] -> [ApiOffset]
forall a b. (a -> b) -> [a] -> [b]
map FuzzOp -> ApiOffset
apiOffset [FuzzOp]
path)
        [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"", String
"types in stash"]
        [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> (forall v. TypeRep v -> StashValue v -> [String] -> [String])
-> [String] -> DMap TypeRep StashValue -> [String]
forall {k1} (k2 :: k1 -> *) (f :: k1 -> *) b.
(forall (v :: k1). k2 v -> f v -> b -> b) -> b -> DMap k2 f -> b
DM.foldrWithKey (\TypeRep v
_ StashValue v
v [String]
r -> (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (StashValue v -> Int) -> StashValue v -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty ([Provenance], v) -> Int
forall a. NonEmpty a -> Int
NEL.length (NonEmpty ([Provenance], v) -> Int)
-> (StashValue v -> NonEmpty ([Provenance], v))
-> StashValue v
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StashValue v -> NonEmpty ([Provenance], v)
forall a. StashValue a -> NonEmpty ([Provenance], a)
getStashValue (StashValue v -> String) -> StashValue v -> String
forall a b. (a -> b) -> a -> b
$ StashValue v
v) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
r) [] (Stash -> DMap TypeRep StashValue
getStash Stash
stash)
    --        <> (map (show . NEL.length . getStashValue ) $ DM.assocs (getStash stash))
    --        $ \_k v ->
    --               (show . NEL.length $ getStashValue v))

    evaluateCoverage :: FuzzState -> StateT FuzzState IO ()
evaluateCoverage f :: FuzzState
f@FuzzState {[FuzzOp]
StdGen
Stash
path :: FuzzState -> [FuzzOp]
stash :: FuzzState -> Stash
currentRng :: FuzzState -> StdGen
path :: [FuzzOp]
stash :: Stash
currentRng :: StdGen
..}
      | Double
coverage Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
coverageThreshold = () -> StateT FuzzState IO ()
forall a. a -> StateT FuzzState IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      | Bool
otherwise = do
        FuzzState -> StateT FuzzState IO ()
displayDiagnostics FuzzState
f
        RoboservantException -> StateT FuzzState IO ()
forall a e. Exception e => e -> a
throw (RoboservantException -> StateT FuzzState IO ())
-> RoboservantException -> StateT FuzzState IO ()
forall a b. (a -> b) -> a -> b
$ FailureType
-> Maybe SomeException -> FuzzState -> RoboservantException
RoboservantException (Double -> FailureType
InsufficientCoverage Double
coverage) Maybe SomeException
forall a. Maybe a
Nothing FuzzState
f
      where
        hitRoutes :: Double
hitRoutes = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> ([ApiOffset] -> Int) -> [ApiOffset] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set ApiOffset -> Int
forall a. Set a -> Int
Set.size (Set ApiOffset -> Int)
-> ([ApiOffset] -> Set ApiOffset) -> [ApiOffset] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ApiOffset] -> Set ApiOffset
forall a. Ord a => [a] -> Set a
Set.fromList ([ApiOffset] -> Double) -> [ApiOffset] -> Double
forall a b. (a -> b) -> a -> b
$ (FuzzOp -> ApiOffset) -> [FuzzOp] -> [ApiOffset]
forall a b. (a -> b) -> [a] -> [b]
map FuzzOp -> ApiOffset
apiOffset [FuzzOp]
path
        totalRoutes :: Double
totalRoutes = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
routeCount
        coverage :: Double
coverage = Double
hitRoutes Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
totalRoutes
    untilDone :: MonadIO m => (Integer, UTCTime) -> m a -> m StopReason
    untilDone :: forall (m :: * -> *) a.
MonadIO m =>
(Integer, UTCTime) -> m a -> m StopReason
untilDone (Integer
0, UTCTime
_) m a
_ = StopReason -> m StopReason
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StopReason
HitMaxIterations
    untilDone (Integer
n, UTCTime
deadline) m a
action = do
      UTCTime
now <- IO UTCTime -> m UTCTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
      if UTCTime
now UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
> UTCTime
deadline
        then StopReason -> m StopReason
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StopReason
TimedOut
        else do
          a
_ <- m a
action
          (Integer, UTCTime) -> m a -> m StopReason
forall (m :: * -> *) a.
MonadIO m =>
(Integer, UTCTime) -> m a -> m StopReason
untilDone (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1, UTCTime
deadline) m a
action

    routeCount :: Int
routeCount = ReifiedApi -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ReifiedApi
reifiedApi
    elementOrFail ::
      (MonadState FuzzState m, MonadIO m) =>
      [a] ->
      m a
    elementOrFail :: forall (m :: * -> *) a.
(MonadState FuzzState m, MonadIO m) =>
[a] -> m a
elementOrFail [] = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (FuzzState -> IO a) -> FuzzState -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoboservantException -> IO a
forall a e. Exception e => e -> a
throw (RoboservantException -> IO a)
-> (FuzzState -> RoboservantException) -> FuzzState -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FailureType
-> Maybe SomeException -> FuzzState -> RoboservantException
RoboservantException FailureType
NoPossibleMoves Maybe SomeException
forall a. Maybe a
Nothing (FuzzState -> m a) -> m FuzzState -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m FuzzState
forall s (m :: * -> *). MonadState s m => m s
get
    elementOrFail [a]
l = do
      FuzzState
st <- m FuzzState
forall s (m :: * -> *). MonadState s m => m s
get
      let (Int
index, StdGen
newGen) = (Int, Int) -> StdGen -> (Int, StdGen)
forall g. RandomGen g => (Int, Int) -> g -> (Int, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Int
0, [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (FuzzState -> StdGen
currentRng FuzzState
st)
      (FuzzState -> FuzzState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((FuzzState -> FuzzState) -> m ())
-> (FuzzState -> FuzzState) -> m ()
forall a b. (a -> b) -> a -> b
$ \FuzzState
st' -> FuzzState
st' {currentRng = newGen}
      a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a]
l [a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!! Int
index)
    withOp ::
      (MonadState FuzzState m, MonadIO m) =>
      ( forall as.
        (V.RecordToList as, V.RMap as) =>
        FuzzOp ->
        V.Curried as (IO (Either InteractionError (NonEmpty (Dynamic, Int)))) ->
        V.Rec (TypedF V.Identity) as ->
        m r
      ) ->
      m r
    withOp :: forall (m :: * -> *) r.
(MonadState FuzzState m, MonadIO m) =>
(forall (as :: [*]).
 (RecordToList as, RMap as) =>
 FuzzOp
 -> Curried
      as (IO (Either InteractionError (NonEmpty (Dynamic, Int))))
 -> Rec (TypedF Identity) as
 -> m r)
-> m r
withOp forall (as :: [*]).
(RecordToList as, RMap as) =>
FuzzOp
-> Curried
     as (IO (Either InteractionError (NonEmpty (Dynamic, Int))))
-> Rec (TypedF Identity) as
-> m r
callback = do
      -- choose a call to make, from the endpoints with fillable arguments.
      (ApiOffset
offset, EndpointOption {Rec (TypedF StashValue) as
Curried as (IO (Either InteractionError (NonEmpty (Dynamic, Int))))
eoCall :: ()
eoArgs :: ()
eoCall :: Curried as (IO (Either InteractionError (NonEmpty (Dynamic, Int))))
eoArgs :: Rec (TypedF StashValue) as
..}) <- [(ApiOffset, EndpointOption)] -> m (ApiOffset, EndpointOption)
forall (m :: * -> *) a.
(MonadState FuzzState m, MonadIO m) =>
[a] -> m a
elementOrFail ([(ApiOffset, EndpointOption)] -> m (ApiOffset, EndpointOption))
-> (FuzzState -> [(ApiOffset, EndpointOption)])
-> FuzzState
-> m (ApiOffset, EndpointOption)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FuzzState -> [(ApiOffset, EndpointOption)]
options (FuzzState -> m (ApiOffset, EndpointOption))
-> m FuzzState -> m (ApiOffset, EndpointOption)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m FuzzState
forall s (m :: * -> *). MonadState s m => m s
get
      Rec (Const Int :*: (TypeRep :*: (,) [Provenance])) as
r <-
        (forall x.
 TypedF StashValue x
 -> m ((:*:) (Const Int) (TypeRep :*: (,) [Provenance]) x))
-> Rec (TypedF StashValue) as
-> m (Rec (Const Int :*: (TypeRep :*: (,) [Provenance])) as)
forall {u} (h :: * -> *) (f :: u -> *) (g :: u -> *) (rs :: [u]).
Applicative h =>
(forall (x :: u). f x -> h (g x)) -> Rec f rs -> h (Rec g rs)
V.rtraverse
          ( \(TypeRep x
tr :*: StashValue NonEmpty ([Provenance], x)
svs IntSet
_) ->
              [(:*:) (Const Int) (TypeRep :*: (,) [Provenance]) x]
-> m ((:*:) (Const Int) (TypeRep :*: (,) [Provenance]) x)
forall (m :: * -> *) a.
(MonadState FuzzState m, MonadIO m) =>
[a] -> m a
elementOrFail ([(:*:) (Const Int) (TypeRep :*: (,) [Provenance]) x]
 -> m ((:*:) (Const Int) (TypeRep :*: (,) [Provenance]) x))
-> [(:*:) (Const Int) (TypeRep :*: (,) [Provenance]) x]
-> m ((:*:) (Const Int) (TypeRep :*: (,) [Provenance]) x)
forall a b. (a -> b) -> a -> b
$
                (Int
 -> ([Provenance], x)
 -> (:*:) (Const Int) (TypeRep :*: (,) [Provenance]) x)
-> [Int]
-> [([Provenance], x)]
-> [(:*:) (Const Int) (TypeRep :*: (,) [Provenance]) x]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
                  (\Int
i ([Provenance], x)
xy -> Int -> Const Int x
forall k a (b :: k). a -> Const a b
V.Const Int
i Const Int x
-> (:*:) TypeRep ((,) [Provenance]) x
-> (:*:) (Const Int) (TypeRep :*: (,) [Provenance]) x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: TypeRep x
tr TypeRep x
-> ([Provenance], x) -> (:*:) TypeRep ((,) [Provenance]) x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: ([Provenance], x)
xy)
                  [Int
0 ..]
                  (NonEmpty ([Provenance], x) -> [([Provenance], x)]
forall a. NonEmpty a -> [a]
NEL.toList NonEmpty ([Provenance], x)
svs)
          )
          Rec (TypedF StashValue) as
eoArgs
      let pathSegment :: FuzzOp
pathSegment =
            ApiOffset -> [Provenance] -> FuzzOp
FuzzOp ApiOffset
offset ([Provenance] -> FuzzOp) -> [Provenance] -> FuzzOp
forall a b. (a -> b) -> a -> b
$
              (forall x.
 (:*:) (Const Int) (TypeRep :*: (,) [Provenance]) x -> Provenance)
-> Rec (Const Int :*: (TypeRep :*: (,) [Provenance])) as
-> [Provenance]
forall {u} (as :: [u]) (f :: u -> *) a.
(RecordToList as, RMap as) =>
(forall (x :: u). f x -> a) -> Rec f as -> [a]
recordToList'
                (\(V.Const Int
index :*: TypeRep x
tr :*: ([Provenance], x)
_) -> SomeTypeRep -> Int -> Provenance
Provenance (TypeRep x -> SomeTypeRep
forall k (a :: k). TypeRep a -> SomeTypeRep
R.SomeTypeRep TypeRep x
tr) Int
index)
                Rec (Const Int :*: (TypeRep :*: (,) [Provenance])) as
r
          argValues :: Rec (TypedF Identity) as
argValues =
            (forall x.
 (:*:) (Const Int) (TypeRep :*: (,) [Provenance]) x
 -> TypedF Identity x)
-> Rec (Const Int :*: (TypeRep :*: (,) [Provenance])) as
-> Rec (TypedF Identity) as
forall {u} (rs :: [u]) (f :: u -> *) (g :: u -> *).
RMap rs =>
(forall (x :: u). f x -> g x) -> Rec f rs -> Rec g rs
forall (f :: * -> *) (g :: * -> *).
(forall x. f x -> g x) -> Rec f as -> Rec g as
V.rmap
              (\(Const Int x
_ :*: TypeRep x
tr :*: ([Provenance]
_, x
x)) -> TypeRep x
tr TypeRep x -> Identity x -> TypedF Identity x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: x -> Identity x
forall a. a -> Identity a
V.Identity x
x)
              Rec (Const Int :*: (TypeRep :*: (,) [Provenance])) as
r
      (FuzzState -> FuzzState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\FuzzState
f -> FuzzState
f {path = path f <> [pathSegment]})
      FuzzOp
-> Curried
     as (IO (Either InteractionError (NonEmpty (Dynamic, Int))))
-> Rec (TypedF Identity) as
-> m r
forall (as :: [*]).
(RecordToList as, RMap as) =>
FuzzOp
-> Curried
     as (IO (Either InteractionError (NonEmpty (Dynamic, Int))))
-> Rec (TypedF Identity) as
-> m r
callback FuzzOp
pathSegment Curried as (IO (Either InteractionError (NonEmpty (Dynamic, Int))))
eoCall Rec (TypedF Identity) as
argValues
      where
        options :: FuzzState -> [(ApiOffset, EndpointOption)]
        options :: FuzzState -> [(ApiOffset, EndpointOption)]
options FuzzState {[FuzzOp]
StdGen
Stash
path :: FuzzState -> [FuzzOp]
stash :: FuzzState -> Stash
currentRng :: FuzzState -> StdGen
path :: [FuzzOp]
stash :: Stash
currentRng :: StdGen
..} =
          ((ApiOffset, ReifiedEndpoint) -> Maybe (ApiOffset, EndpointOption))
-> ReifiedApi -> [(ApiOffset, EndpointOption)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
            ( \(ApiOffset
offset, ReifiedEndpoint {Rec (TypedF Argument) as
Curried as (IO (Either InteractionError (NonEmpty (Dynamic, Int))))
reArguments :: Rec (TypedF Argument) as
reEndpointFunc :: Curried as (IO (Either InteractionError (NonEmpty (Dynamic, Int))))
reEndpointFunc :: ()
reArguments :: ()
..}) -> do
                Rec (TypedF StashValue) as
args <- (forall x. TypedF Argument x -> Maybe (TypedF StashValue x))
-> Rec (TypedF Argument) as -> Maybe (Rec (TypedF StashValue) as)
forall {u} (h :: * -> *) (f :: u -> *) (g :: u -> *) (rs :: [u]).
Applicative h =>
(forall (x :: u). f x -> h (g x)) -> Rec f rs -> h (Rec g rs)
V.rtraverse (\(TypeRep x
tr :*: Argument Stash -> Maybe (StashValue x)
bf) -> (TypeRep x
tr TypeRep x -> StashValue x -> TypedF StashValue x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*:) (StashValue x -> TypedF StashValue x)
-> Maybe (StashValue x) -> Maybe (TypedF StashValue x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stash -> Maybe (StashValue x)
bf Stash
stash) Rec (TypedF Argument) as
reArguments
                (ApiOffset, EndpointOption) -> Maybe (ApiOffset, EndpointOption)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiOffset
offset, Curried as (IO (Either InteractionError (NonEmpty (Dynamic, Int))))
-> Rec (TypedF StashValue) as -> EndpointOption
forall (as :: [*]).
(RecordToList as, RMap as) =>
Curried as (IO (Either InteractionError (NonEmpty (Dynamic, Int))))
-> Rec (TypedF StashValue) as -> EndpointOption
EndpointOption Curried as (IO (Either InteractionError (NonEmpty (Dynamic, Int))))
reEndpointFunc Rec (TypedF StashValue) as
args)
            )
            ReifiedApi
reifiedApi
    execute ::
      (MonadState FuzzState m, MonadIO m, V.RecordToList as, V.RMap as) =>
      FuzzOp ->
      V.Curried as (IO (Either InteractionError (NonEmpty (Dynamic, Int)))) ->
      V.Rec (TypedF V.Identity) as ->
      m ()
    execute :: forall (m :: * -> *) (as :: [*]).
(MonadState FuzzState m, MonadIO m, RecordToList as, RMap as) =>
FuzzOp
-> Curried
     as (IO (Either InteractionError (NonEmpty (Dynamic, Int))))
-> Rec (TypedF Identity) as
-> m ()
execute FuzzOp
fuzzop Curried as (IO (Either InteractionError (NonEmpty (Dynamic, Int))))
func Rec (TypedF Identity) as
args = do
      (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (FuzzState -> IO ()) -> FuzzState -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
logInfo (String -> IO ()) -> (FuzzState -> String) -> FuzzState -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FuzzOp, Stash) -> String
forall a. Show a => a -> String
show ((FuzzOp, Stash) -> String)
-> (FuzzState -> (FuzzOp, Stash)) -> FuzzState -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FuzzOp
fuzzop,) (Stash -> (FuzzOp, Stash))
-> (FuzzState -> Stash) -> FuzzState -> (FuzzOp, Stash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FuzzState -> Stash
stash) (FuzzState -> m ()) -> m FuzzState -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m FuzzState
forall s (m :: * -> *). MonadState s m => m s
get
      IO (Either InteractionError (NonEmpty (Dynamic, Int)))
-> m (Either InteractionError (NonEmpty (Dynamic, Int)))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Curried as (IO (Either InteractionError (NonEmpty (Dynamic, Int))))
-> Rec Identity as
-> IO (Either InteractionError (NonEmpty (Dynamic, Int)))
forall (ts :: [*]) a. Curried ts a -> Rec Identity ts -> a
V.runcurry' Curried as (IO (Either InteractionError (NonEmpty (Dynamic, Int))))
func Rec Identity as
argVals) m (Either InteractionError (NonEmpty (Dynamic, Int)))
-> (Either InteractionError (NonEmpty (Dynamic, Int)) -> m ())
-> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left (InteractionError
e::InteractionError) ->
          if InteractionError -> Bool
fatalError InteractionError
e
          then InteractionError -> m ()
forall a e. Exception e => e -> a
throw InteractionError
e
          else () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Right (NonEmpty (Dynamic, Int)
dyn :: NEL.NonEmpty (Dynamic, Int)) ->
          (FuzzState -> FuzzState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify'
          ( \fs :: FuzzState
fs@FuzzState {[FuzzOp]
StdGen
Stash
path :: FuzzState -> [FuzzOp]
stash :: FuzzState -> Stash
currentRng :: FuzzState -> StdGen
path :: [FuzzOp]
stash :: Stash
currentRng :: StdGen
..} ->
              FuzzState
fs {stash = addToStash (NEL.toList dyn) stash}
          )
      where
        argVals :: Rec Identity as
argVals = (forall x. TypedF Identity x -> Identity x)
-> Rec (TypedF Identity) as -> Rec Identity as
forall {u} (rs :: [u]) (f :: u -> *) (g :: u -> *).
RMap rs =>
(forall (x :: u). f x -> g x) -> Rec f rs -> Rec g rs
forall (f :: * -> *) (g :: * -> *).
(forall x. f x -> g x) -> Rec f as -> Rec g as
V.rmap (\(TypeRep x
_ :*: V.Identity x
x) -> x -> Identity x
forall a. a -> Identity a
V.Identity x
x) Rec (TypedF Identity) as
args
    -- argTypes = recordToList' (\(tr :*: _) -> R.SomeTypeRep tr) args
    go ::
      (MonadState FuzzState m, MonadIO m, MonadBaseControl IO m) =>
      m ()
    go :: forall (m :: * -> *).
(MonadState FuzzState m, MonadIO m, MonadBaseControl IO m) =>
m ()
go = (forall (as :: [*]).
 (RecordToList as, RMap as) =>
 FuzzOp
 -> Curried
      as (IO (Either InteractionError (NonEmpty (Dynamic, Int))))
 -> Rec (TypedF Identity) as
 -> m ())
-> m ()
forall (m :: * -> *) r.
(MonadState FuzzState m, MonadIO m) =>
(forall (as :: [*]).
 (RecordToList as, RMap as) =>
 FuzzOp
 -> Curried
      as (IO (Either InteractionError (NonEmpty (Dynamic, Int))))
 -> Rec (TypedF Identity) as
 -> m r)
-> m r
withOp ((forall (as :: [*]).
  (RecordToList as, RMap as) =>
  FuzzOp
  -> Curried
       as (IO (Either InteractionError (NonEmpty (Dynamic, Int))))
  -> Rec (TypedF Identity) as
  -> m ())
 -> m ())
-> (forall (as :: [*]).
    (RecordToList as, RMap as) =>
    FuzzOp
    -> Curried
         as (IO (Either InteractionError (NonEmpty (Dynamic, Int))))
    -> Rec (TypedF Identity) as
    -> m ())
-> m ()
forall a b. (a -> b) -> a -> b
$ \FuzzOp
op Curried as (IO (Either InteractionError (NonEmpty (Dynamic, Int))))
func Rec (TypedF Identity) as
args -> do
      m () -> [Handler m ()] -> m ()
forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> [Handler m a] -> m a
catches
        (FuzzOp
-> Curried
     as (IO (Either InteractionError (NonEmpty (Dynamic, Int))))
-> Rec (TypedF Identity) as
-> m ()
forall (m :: * -> *) (as :: [*]).
(MonadState FuzzState m, MonadIO m, RecordToList as, RMap as) =>
FuzzOp
-> Curried
     as (IO (Either InteractionError (NonEmpty (Dynamic, Int))))
-> Rec (TypedF Identity) as
-> m ()
execute FuzzOp
op Curried as (IO (Either InteractionError (NonEmpty (Dynamic, Int))))
func Rec (TypedF Identity) as
args)
        [ (SomeAsyncException -> m ()) -> Handler m ()
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler (\(SomeAsyncException
e :: SomeAsyncException) -> SomeAsyncException -> m ()
forall a e. Exception e => e -> a
throw SomeAsyncException
e),
          (SomeException -> m ()) -> Handler m ()
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler
            ( \(SomeException
e :: SomeException) -> 
                RoboservantException -> m ()
forall a e. Exception e => e -> a
throw (RoboservantException -> m ())
-> (FuzzState -> RoboservantException) -> FuzzState -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FailureType
-> Maybe SomeException -> FuzzState -> RoboservantException
RoboservantException FailureType
ServerCrashed (SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
e) (FuzzState -> m ()) -> m FuzzState -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m FuzzState
forall s (m :: * -> *). MonadState s m => m s
get
            )
        ]
      m () -> (SomeException -> m ()) -> m ()
forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> (e -> m a) -> m a
catch
        (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
healthCheck)
        (\(SomeException
e :: SomeException) -> RoboservantException -> m ()
forall a e. Exception e => e -> a
throw (RoboservantException -> m ())
-> (FuzzState -> RoboservantException) -> FuzzState -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FailureType
-> Maybe SomeException -> FuzzState -> RoboservantException
RoboservantException FailureType
CheckerFailed (SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
e) (FuzzState -> m ()) -> m FuzzState -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m FuzzState
forall s (m :: * -> *). MonadState s m => m s
get)

addToStash ::
  [(Dynamic, Int)] ->
  Stash ->
  Stash
addToStash :: [(Dynamic, Int)] -> Stash -> Stash
addToStash [(Dynamic, Int)]
result Stash
stash =
  ((Dynamic, Int) -> Stash -> Stash)
-> Stash -> [(Dynamic, Int)] -> Stash
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
    ( \(Dynamic TypeRep a
tr a
x, Int
hashed) (Stash DMap TypeRep StashValue
dict) ->
        DMap TypeRep StashValue -> Stash
Stash (DMap TypeRep StashValue -> Stash)
-> DMap TypeRep StashValue -> Stash
forall a b. (a -> b) -> a -> b
$
          (StashValue a -> StashValue a -> StashValue a)
-> TypeRep a
-> StashValue a
-> DMap TypeRep StashValue
-> DMap TypeRep StashValue
forall {k1} (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
(f v -> f v -> f v) -> k2 v -> f v -> DMap k2 f -> DMap k2 f
DM.insertWith
            StashValue a -> StashValue a -> StashValue a
forall a. StashValue a -> StashValue a -> StashValue a
renumber
            TypeRep a
tr
            (NonEmpty ([Provenance], a) -> IntSet -> StashValue a
forall a. NonEmpty ([Provenance], a) -> IntSet -> StashValue a
StashValue (([SomeTypeRep -> Int -> Provenance
Provenance (TypeRep a -> SomeTypeRep
forall k (a :: k). TypeRep a -> SomeTypeRep
R.SomeTypeRep TypeRep a
tr) Int
0], a
x) ([Provenance], a)
-> [([Provenance], a)] -> NonEmpty ([Provenance], a)
forall a. a -> [a] -> NonEmpty a
:| []) (Int -> IntSet
IntSet.singleton Int
hashed))
            DMap TypeRep StashValue
dict
    )
    Stash
stash
    [(Dynamic, Int)]
result
  where
    renumber ::
      StashValue a ->
      StashValue a ->
      StashValue a
    renumber :: forall a. StashValue a -> StashValue a -> StashValue a
renumber (StashValue NonEmpty ([Provenance], a)
singleDyn IntSet
singleHash) orig :: StashValue a
orig@(StashValue NonEmpty ([Provenance], a)
l IntSet
intSet)
      | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ IntSet -> Bool
IntSet.null (IntSet
singleHash IntSet -> IntSet -> IntSet
`IntSet.intersection` IntSet
intSet) = StashValue a
orig
      | Bool
otherwise =
        NonEmpty ([Provenance], a) -> IntSet -> StashValue a
forall a. NonEmpty ([Provenance], a) -> IntSet -> StashValue a
StashValue
          ( case NonEmpty ([Provenance], a) -> [([Provenance], a)]
forall a. NonEmpty a -> [a]
NEL.toList NonEmpty ([Provenance], a)
singleDyn of
              [([Provenance SomeTypeRep
tr Int
_], a
dyn)] ->
                NonEmpty ([Provenance], a)
l NonEmpty ([Provenance], a)
-> NonEmpty ([Provenance], a) -> NonEmpty ([Provenance], a)
forall a. Semigroup a => a -> a -> a
<> ([Provenance], a) -> NonEmpty ([Provenance], a)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([SomeTypeRep -> Int -> Provenance
Provenance SomeTypeRep
tr (([Provenance], a) -> Int
forall a. ([Provenance], a) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (NonEmpty ([Provenance], a) -> ([Provenance], a)
forall a. NonEmpty a -> a
NEL.last NonEmpty ([Provenance], a)
l) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)], a
dyn)
              [([Provenance], a)]
_ -> String -> NonEmpty ([Provenance], a)
forall a. HasCallStack => String -> a
error String
"should be impossible"
          )
          (IntSet -> IntSet -> IntSet
IntSet.union IntSet
singleHash IntSet
intSet)

-- why isn't this in vinyl?
recordToList' ::
  (V.RecordToList as, V.RMap as) =>
  (forall x. f x -> a) ->
  V.Rec f as ->
  [a]
recordToList' :: forall {u} (as :: [u]) (f :: u -> *) a.
(RecordToList as, RMap as) =>
(forall (x :: u). f x -> a) -> Rec f as -> [a]
recordToList' forall (x :: u). f x -> a
f = Rec (Const a) as -> [a]
forall a. Rec (Const a) as -> [a]
forall {u} (rs :: [u]) a.
RecordToList rs =>
Rec (Const a) rs -> [a]
V.recordToList (Rec (Const a) as -> [a])
-> (Rec f as -> Rec (Const a) as) -> Rec f as -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (x :: u). f x -> Const a x) -> Rec f as -> Rec (Const a) as
forall {u} (rs :: [u]) (f :: u -> *) (g :: u -> *).
RMap rs =>
(forall (x :: u). f x -> g x) -> Rec f rs -> Rec g rs
forall (f :: u -> *) (g :: u -> *).
(forall (x :: u). f x -> g x) -> Rec f as -> Rec g as
V.rmap (a -> Const a x
forall k a (b :: k). a -> Const a b
V.Const (a -> Const a x) -> (f x -> a) -> f x -> Const a x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f x -> a
forall (x :: u). f x -> a
f)