780fb79 · roboservant · git.iko.soy

git.iko.soy/roboservant

Merge branch 'derivingvia' into morecoverage

commit780fb790cf8236e21cd9a2629ad7b9e3bc1db830 authorMark Wotton <mwotton@gmail.com> dateFri 27 Nov 2020, 18:26 (6 years ago) parent3e30687 a74abfd

9 files changed+227−178

compare with master

unifiedsplit

roboservant.cabal+3−1 src/Roboservant.hs+2−2 src/Roboservant/Direct.hs+129−105 src/Roboservant/Types.hs+5 src/Roboservant/Types/Breakdown.hs+11−69 src/Roboservant/Types/BuildFrom.hs+39 src/Roboservant/Types/Internal.hs+33 src/Roboservant/Types/ReifiedApi.hs+2 test/Spec.hs+3−1

roboservant.cabal+3−1

@@ -4,7 +4,7 @@ cabal-version: 1.12

44--

55-- see: https://github.com/sol/hpack

66--

7−-- hash: 134cfee817f86824342ecabc02ca2b48ec67539b75581c1954b95a9f9128e5a4

7+-- hash: 6420e658218cfbfe27ae6037534f3e63a37fb1c9dfbd1a48c5f5e435d959a5af

99name: roboservant

1010version: 0.1.0.2

@@ -31,7 +31,9 @@ library

3131 Roboservant.Direct

3232 Roboservant.Types

3333 Roboservant.Types.Breakdown

34+ Roboservant.Types.BuildFrom

3435 Roboservant.Types.FlattenServer

36+ Roboservant.Types.Internal

3537 Roboservant.Types.ReifiedApi

3638 other-modules:

3739 Paths_roboservant

src/Roboservant.hs+2−2

@@ -1,5 +1,5 @@

11module Roboservant (module Roboservant.Direct

2− ,module Roboservant.Types.Breakdown) where

2+ ,module Roboservant.Types) where

44import Roboservant.Direct

5−import Roboservant.Types.Breakdown

5+import Roboservant.Types

src/Roboservant/Direct.hs+129−105

@@ -1,11 +1,7 @@

11{-# LANGUAGE AllowAmbiguousTypes #-}

2−{-# LANGUAGE DataKinds #-}

3−{-# LANGUAGE DerivingStrategies #-}

42{-# LANGUAGE FlexibleContexts #-}

5−{-# LANGUAGE FlexibleInstances #-}

63{-# LANGUAGE GADTs #-}

74{-# LANGUAGE LambdaCase #-}

8−{-# LANGUAGE PolyKinds #-}

95{-# LANGUAGE RankNTypes #-}

106{-# LANGUAGE RecordWildCards #-}

117{-# LANGUAGE ScopedTypeVariables #-}

@@ -48,25 +44,36 @@ import System.Timeout.Lifted(timeout)

4844import GHC.Generics ((:*:)(..))

4945import qualified Data.Vinyl.Functor as V

5046import qualified Data.Vinyl.Curry as V

47+

48+

49+import Control.Exception.Lifted (Exception, Handler (..), SomeAsyncException, SomeException, catch, catches, handle, throw)

50+import Control.Monad.State.Strict (MonadIO, MonadState, get, liftIO, modify', runStateT)

51+import Control.Monad.Trans.Control (MonadBaseControl)

5152import qualified Data.Dependent.Map as DM

52−import qualified Data.Vinyl as V

53+import Data.Dynamic (Dynamic (..), dynTypeRep)

54+import Data.List.NonEmpty (NonEmpty (..))

5355import qualified Data.List.NonEmpty as NEL

54−import qualified Data.Map.Strict as Map

56+import Data.Maybe (mapMaybe)

57+import qualified Data.Set as Set

5558import Data.Time.Clock

56−import qualified Type.Reflection as R

57−

58−import Roboservant.Types.Breakdown

59+import qualified Data.Vinyl as V

60+import qualified Data.Vinyl.Curry as V

61+import qualified Data.Vinyl.Functor as V

62+import GHC.Generics ((:*:) (..))

5963import Roboservant.Types

6064 ( ApiOffset (..),

65+ Argument (..),

6166 FlattenServer (..),

62−-- ReifiedApi,

67+ Provenance (..),

68+ ReifiedEndpoint (..),

69+ Stash (..),

70+ StashValue (..),

6371 ToReifiedApi (..),

64−

65− ReifiedEndpoint(..),

66− Argument(..),

6772 TypedF

68−

6973 )

74+import Servant (Endpoints, Proxy (Proxy), Server, ServerError (..))

75+import System.Random (StdGen, mkStdGen, randomR)

76+import qualified Type.Reflection as R

7077

7178

7279data RoboservantException

@@ -85,57 +92,64 @@ data FailureType

8592 | InsufficientCoverage Double

8693 deriving (Show,Eq)

8794

88−

89−data FuzzOp = FuzzOp

90− { apiOffset :: ApiOffset

91− , provenance :: [Provenance]

92− } deriving (Show,Eq)

95+data FuzzOp

96+ = FuzzOp

97+ { apiOffset :: ApiOffset,

98+ provenance :: [Provenance]

99+ }

100+ deriving (Show, Eq)

93101

94102data Config

95103 = Config

96− { seed :: [Dynamic]

97− , maxRuntime :: Integer -- seconds to test for

98− , maxReps :: Integer

99− , rngSeed :: Int

100− , coverageThreshold :: Double

101− }

102−

103−data FuzzState = FuzzState

104− { path :: [FuzzOp]

105− , stash :: Stash

106− , currentRng :: StdGen

107− }

108− deriving Show

104+ { seed :: [Dynamic],

105+ maxRuntime :: Integer, -- seconds to test for

106+ maxReps :: Integer,

107+ rngSeed :: Int,

108+ coverageThreshold :: Double

109+ }

110+

111+data FuzzState

112+ = FuzzState

113+ { path :: [FuzzOp],

114+ stash :: Stash,

115+ currentRng :: StdGen

116+ }

117+ deriving (Show)

109118

110−data EndpointOption = forall as. (V.RecordToList as, V.RMap as) => EndpointOption

111− { eoCall :: V.Curried as (IO (Either ServerError (NonEmpty Dynamic)))

112− , eoArgs :: V.Rec (TypedF StashValue) as

113− }

119+data EndpointOption

120+ = forall as.

121+ (V.RecordToList as, V.RMap as) =>

122+ EndpointOption

123+ { eoCall :: V.Curried as (IO (Either ServerError (NonEmpty Dynamic))),

124+ eoArgs :: V.Rec (TypedF StashValue) as

125+ }

114126

115127data StopReason

116128 = TimedOut

117129 | HitMaxIterations

118− deriving (Show,Eq)

130+ deriving (Show, Eq)

119131

120132data Report = Report

121133 { textual :: String

122134 , rsException :: RoboservantException}

123135 deriving (Show)

124136

125−fuzz :: forall api. (FlattenServer api, ToReifiedApi (Endpoints api))

126− => Server api

127− -> Config

128− -> IO ()

129− -> IO (Maybe Report)

130−fuzz server Config{..} checker = handle (pure . Just . formatException) $ do

137+fuzz ::

138+ forall api.

139+ (FlattenServer api, ToReifiedApi (Endpoints api)) =>

140+ Server api ->

141+ Config ->

142+ IO () ->

143+ IO (Maybe Report)

144+fuzz server Config {..} checker = handle (pure . Just . formatException) $ do

131145 let path = []

132146 stash = addToStash seed mempty

133147 currentRng = mkStdGen rngSeed

134−

135− print ("Initial seed", seed, stash)

136148 deadline :: UTCTime <- addUTCTime (fromInteger $ maxRuntime * 1000000) <$> getCurrentTime

137− (stopreason, fs ) <- runStateT

138− (untilDone (maxReps, deadline) go <* (evaluateCoverage =<< get)) FuzzState{..}

149+ (stopreason, _fs) <-

150+ runStateT

151+ (untilDone (maxReps, deadline) go <* (evaluateCoverage =<< get))

152+ FuzzState {..}

139153 print stopreason

140154 pure Nothing

141155 where

@@ -174,9 +188,8 @@ fuzz server Config{..} checker = handle (pure . Just . formatException) $ do

174188 if now > deadline

175189 then pure TimedOut

176190 else do

177− action

178− untilDone (n-1, deadline) action

179−

191+ _ <- action

192+ untilDone (n -1, deadline) action

180193 reifiedApi = toReifiedApi (flattenServer @api server) (Proxy @(Endpoints api))

181194 routeCount = length reifiedApi

182195

@@ -185,51 +198,58 @@ fuzz server Config{..} checker = handle (pure . Just . formatException) $ do

185198 elementOrFail [] = liftIO . throw . RoboservantException NoPossibleMoves Nothing =<< get

186199 elementOrFail l = do

187200 st <- get

188− let (index,newGen) = randomR (0, length l - 1) (currentRng st)

189− modify' $ \st' -> st' { currentRng = newGen }

201+ let (index, newGen) = randomR (0, length l - 1) (currentRng st)

202+ modify' $ \st' -> st' {currentRng = newGen}

190203 pure (l !! index)

191−

192− withOp :: (MonadState FuzzState m, MonadIO m)

193− => (forall as. (V.RecordToList as, V.RMap as)

194− => FuzzOp

195− -> V.Curried as (IO (Either ServerError (NonEmpty Dynamic)))

196− -> V.Rec (TypedF V.Identity) as -> m r

197− )

198− -> m r

204+ withOp ::

205+ (MonadState FuzzState m, MonadIO m) =>

206+ ( forall as.

207+ (V.RecordToList as, V.RMap as) =>

208+ FuzzOp ->

209+ V.Curried as (IO (Either ServerError (NonEmpty Dynamic))) ->

210+ V.Rec (TypedF V.Identity) as ->

211+ m r

212+ ) ->

213+ m r

199214 withOp callback = do

200215 -- choose a call to make, from the endpoints with fillable arguments.

201− (offset, EndpointOption{..}) <- elementOrFail . options =<< get

202− r <- V.rtraverse

203− (\(tr :*: StashValue svs) -> elementOrFail $

204− zipWith (\i xy -> V.Const i :*: tr :*: xy)

205− [0..]

206− (NEL.toList svs)

207− )

208− eoArgs

209− let pathSegment = FuzzOp offset $

210− recordToList'

211− (\(V.Const index :*: tr :*: _) -> Provenance (R.SomeTypeRep tr) index)

216+ (offset, EndpointOption {..}) <- elementOrFail . options =<< get

217+ r <-

218+ V.rtraverse

219+ ( \(tr :*: StashValue svs) ->

220+ elementOrFail $

221+ zipWith

222+ (\i xy -> V.Const i :*: tr :*: xy)

223+ [0 ..]

224+ (NEL.toList svs)

225+ )

226+ eoArgs

227+ let pathSegment =

228+ FuzzOp offset $

229+ recordToList'

230+ (\(V.Const index :*: tr :*: _) -> Provenance (R.SomeTypeRep tr) index)

231+ r

232+ argValues =

233+ V.rmap

234+ (\(_ :*: tr :*: (_, x)) -> tr :*: V.Identity x)

212235 r

213− argValues = V.rmap

214− (\(_ :*: tr :*: (_, x)) -> tr :*: V.Identity x)

215− r

216− modify' (\f -> f { path = path f <> [pathSegment] })

236+ modify' (\f -> f {path = path f <> [pathSegment]})

217237 callback pathSegment eoCall argValues

218238 where

219239 options :: FuzzState -> [(ApiOffset, EndpointOption)]

220− options FuzzState{..} =

240+ options FuzzState {..} =

221241 mapMaybe

222− ( \(offset, ReifiedEndpoint{..}) -> do

223− args <- V.rtraverse (\(tr :*: Argument bf) -> (tr :*:) <$> bf stash) reArguments

224− pure (offset, EndpointOption reEndpointFunc args)

242+ ( \(offset, ReifiedEndpoint {..}) -> do

243+ args <- V.rtraverse (\(tr :*: Argument bf) -> (tr :*:) <$> bf stash) reArguments

244+ pure (offset, EndpointOption reEndpointFunc args)

225245 )

226246 reifiedApi

227−

228− execute :: (MonadState FuzzState m, MonadIO m, V.RecordToList as, V.RMap as)

229− => FuzzOp

230− -> V.Curried as (IO (Either ServerError (NonEmpty Dynamic)))

231− -> V.Rec (TypedF V.Identity) as

232− -> m ()

247+ execute ::

248+ (MonadState FuzzState m, MonadIO m, V.RecordToList as, V.RMap as) =>

249+ FuzzOp ->

250+ V.Curried as (IO (Either ServerError (NonEmpty Dynamic))) ->

251+ V.Rec (TypedF V.Identity) as ->

252+ m ()

233253 execute fuzzop func args = do

234254 (liftIO . print . (fuzzop,) . stash ) =<< get

235255 st <- get

@@ -247,7 +267,7 @@ fuzz server Config{..} checker = handle (pure . Just . formatException) $ do

247267 case errHTTPCode serverError of

248268 500 -> throw serverError

249269 _ -> do

250− liftIO $ print ("ignoring non-500 error" , serverError)

270+ liftIO $ print ("ignoring non-500 error", serverError)

251271 Right (dyn :: NEL.NonEmpty Dynamic) -> do

252272 -- liftIO $ print ("storing", fmap dynTypeRep dyn)

253273 modify' (\fs@FuzzState{..} ->

@@ -255,9 +275,9 @@ fuzz server Config{..} checker = handle (pure . Just . formatException) $ do

255275 where

256276 argVals = V.rmap (\(_ :*: V.Identity x) -> V.Identity x) args

257277 argTypes = recordToList' (\(tr :*: _) -> R.SomeTypeRep tr) args

258−

259− go :: (MonadState FuzzState m, MonadIO m, MonadBaseControl IO m)

260− => m ()

278+ go ::

279+ (MonadState FuzzState m, MonadIO m, MonadBaseControl IO m) =>

280+ m ()

261281 go = withOp $ \op func args -> do

262282 catches (execute op func args)

263283 [ Handler (\(e :: SomeAsyncException) -> throw e)

@@ -268,29 +288,33 @@ fuzz server Config{..} checker = handle (pure . Just . formatException) $ do

268288 catch (liftIO checker)

269289 (\(e :: SomeException) -> throw . RoboservantException CheckerFailed (Just e) =<< get)

270290

271−addToStash :: [Dynamic]

272− -> Stash

273− -> Stash

291+addToStash ::

292+ [Dynamic] ->

293+ Stash ->

294+ Stash

274295addToStash result stash =

275− foldr (\(Dynamic tr x) (Stash dict) -> Stash $

276− DM.insertWith renumber tr (StashValue (([Provenance (R.SomeTypeRep tr) 0],x):|[])) dict

296+ foldr

297+ ( \(Dynamic tr x) (Stash dict) ->

298+ Stash $

299+ DM.insertWith renumber tr (StashValue (([Provenance (R.SomeTypeRep tr) 0], x) :| [])) dict

277300 )

278301 stash

279302 result

280303 where

281− renumber :: StashValue a

282− -> StashValue a

283− -> StashValue a

304+ renumber ::

305+ StashValue a ->

306+ StashValue a ->

307+ StashValue a

284308 renumber (StashValue singleDyn) (StashValue l) = StashValue $ case NEL.toList singleDyn of

285− [([Provenance tr _], dyn)] -> l

286− <> pure ([Provenance tr (length (NEL.last l) + 1)], dyn)

309+ [([Provenance tr _], dyn)] ->

310+ l

311+ <> pure ([Provenance tr (length (NEL.last l) + 1)], dyn)

287312 _ -> error "should be impossible"

288313

289−

290314-- why isn't this in vinyl?

291−recordToList'

292− :: (V.RecordToList as, V.RMap as)

293− => (forall x. f x -> a)

294− -> V.Rec f as

295− -> [a]

315+recordToList' ::

316+ (V.RecordToList as, V.RMap as) =>

317+ (forall x. f x -> a) ->

318+ V.Rec f as ->

319+ [a]

296320recordToList' f = V.recordToList . V.rmap (V.Const . f)

src/Roboservant/Types.hs+5

@@ -15,11 +15,16 @@

1515

1616module Roboservant.Types

1717 ( module Roboservant.Types.Breakdown

18+ , module Roboservant.Types.BuildFrom

1819 , module Roboservant.Types.FlattenServer

1920 , module Roboservant.Types.ReifiedApi

21+ , module Roboservant.Types.Internal

22+

2023 )

2124where

2225

2326import Roboservant.Types.Breakdown

27+import Roboservant.Types.BuildFrom

2428import Roboservant.Types.FlattenServer

2529import Roboservant.Types.ReifiedApi

30+import Roboservant.Types.Internal

src/Roboservant/Types/Breakdown.hs+11−69

@@ -5,7 +5,6 @@

55{-# LANGUAGE FlexibleInstances #-}

66{-# LANGUAGE GADTs #-}

77{-# LANGUAGE DefaultSignatures #-}

8−{-# LANGUAGE DeriveFunctor #-}

98{-# LANGUAGE DerivingStrategies #-}

109{-# LANGUAGE FlexibleInstances #-}

1110{-# LANGUAGE GADTs #-}

@@ -17,92 +16,35 @@

1716{-# LANGUAGE TypeApplications #-}

1817{-# LANGUAGE TypeFamilies #-}

1918{-# LANGUAGE UndecidableInstances #-}

19+{-# LANGUAGE StandaloneDeriving #-}

20+{-# LANGUAGE DerivingVia #-}

21+

2022

2123module Roboservant.Types.Breakdown where

2224

2325import Data.Dynamic (Dynamic, fromDynamic, toDyn)

24−import Data.List.NonEmpty (NonEmpty(..))

26+import Data.List.NonEmpty (NonEmpty (..))

2527import qualified Data.List.NonEmpty as NEL

26−import qualified Data.Map.Strict as Map

2728import Data.Maybe (fromMaybe)

2829import GHC.Generics(Generic)

2930import Data.Typeable (Typeable)

30−import qualified Data.Dependent.Map as DM

31−import Data.Dependent.Map (DMap)

32−import qualified Type.Reflection as R

33−import Data.Dependent.Sum

34−import Data.Kind

31+import Roboservant.Types.Internal

3532

36−data Provenance

37− = Provenance R.SomeTypeRep Int

38− deriving (Show,Eq)

33+-- | only use this when we are using the internal typerep map.

34+promisedDyn :: Typeable a => Dynamic -> a

35+promisedDyn = fromMaybe (error "internal error, typerep map misconstructed") . fromDynamic

3936

4037class Breakdown x where

4138 breakdown :: x -> NonEmpty Dynamic

39+-- default breakdown :: Typeable x => x -> NonEmpty Dynamic

40+-- breakdown = pure . toDyn

4241

43−-- | Can't be built up from parts

44−newtype Atom x = Atom { unAtom :: x }

45−

46−-- | can be broken down and built up from generic pieces

47−newtype Compound x = Compound { unCompound :: x }

48−

49−-- | so, this is quite tricky. we need to witness the structure of `x`, but

50−-- we don't have an example of it yet. not entirely sure where to go.

51−instance (Typeable x, Generic x) => BuildFrom (Compound x) where

52− buildFrom _stash = error "oops"

53−-- breakdown = Map.fromListWith (<>) . fmap ((dynTypeRep &&& (\x -> NEL.fromList [x])) . toDyn . Generics.to) . _ . Generics.from

54−

55−-- -- | this should be a bit more tractable.

56−-- instance (Typeable x, Generic x) => Breakdown (Compound x) where

57−-- breakdown x = _ . Generics.from . unCompound $ x

5842

5943instance Typeable x => Breakdown (Atom x) where

60− breakdown = pure . toDyn

61−

62−-- instance Typeable a => Breakdown (Atom a) where

63−-- breakdown = pure . toDyn . unAtom

64−

65−

66−instance Typeable x => BuildFrom (Atom x) where

67− buildFrom = DM.lookup R.typeRep . getStash

68−

69−newtype StashValue a = StashValue { getStashValue :: NonEmpty ([Provenance], a) }

70− deriving (Functor, Show)

71−

72−-- wrap in newtype to give a custom Show instance, since the normal

73−-- instance for DMap is not happy since StashValue needs Show a to show

74−newtype Stash = Stash { getStash :: DMap R.TypeRep StashValue }

75− deriving (Semigroup, Monoid)

76−

77−instance Show Stash where

78− showsPrec i (Stash x) = showsPrec i $

79− Map.fromList . map (\(tr :=> StashValue vs) -> (R.SomeTypeRep tr, fmap fst vs)) $ DM.toList x

80−

81−class Typeable x => BuildFrom (x :: Type) where

82− buildFrom :: Stash -> Maybe (StashValue x)

83−

84−-- | only use this when we are using the internal typerep map.

85−promisedDyn :: Typeable a => Dynamic -> a

86−promisedDyn = fromMaybe (error "internal error, typerep map misconstructed") . fromDynamic

87−

88−deriving via (Atom Bool) instance BuildFrom Bool

89−

90−instance (Typeable x, BuildFrom x) => BuildFrom (Maybe x) where

91− buildFrom dict = Just options

92− where options :: StashValue (Maybe x)

93− options = StashValue $

94− ([],Nothing) :|

95− (maybe [] (NEL.toList . getStashValue . fmap Just) $ buildFrom @x dict

96− )

44+ breakdown = pure . toDyn . unAtom

9745

9846deriving via (Atom ()) instance Breakdown ()

9947deriving via (Atom Int) instance Breakdown Int

10048

101−

102−

10349instance (Typeable a, Breakdown a) => Breakdown [a] where

10450 breakdown x = toDyn x :| mconcat (map (NEL.toList . breakdown) x)

105−

106−instance (BuildFrom a) => BuildFrom [a] where

107− buildFrom = error "fuuuck"

108−--- breakdown x = toDyn x :| mconcat (map (NEL.toList . breakdown) x)

src/Roboservant/Types/BuildFrom.hsnew file+39

@@ -0,0 +1,39 @@

1+{-# LANGUAGE DefaultSignatures #-}

2+{-# LANGUAGE DerivingStrategies #-}

3+{-# LANGUAGE ScopedTypeVariables #-}

4+{-# LANGUAGE TypeApplications #-}

5+{-# LANGUAGE TypeFamilies #-}

6+{-# LANGUAGE StandaloneDeriving #-}

7+{-# LANGUAGE DerivingVia #-}

10+

11+module Roboservant.Types.BuildFrom where

12+

13+import Data.List.NonEmpty (NonEmpty(..))

14+import qualified Data.List.NonEmpty as NEL

15+import Data.Typeable (Typeable)

16+import qualified Data.Dependent.Map as DM

17+import qualified Type.Reflection as R

18+import Data.Kind

19+import Roboservant.Types.Internal

20+

21+class Typeable x => BuildFrom (x :: Type) where

22+ buildFrom :: Stash -> Maybe (StashValue x)

23+

24+-- | this is a little esoteric: basically, we're always going to use this with

25+-- deriving-via, so we need to look up the underlying `x` and then wrap it in Atom.

26+instance Typeable x => BuildFrom (Atom x) where

27+ buildFrom = fmap (fmap Atom) <$> DM.lookup R.typeRep . getStash

28+

29+deriving via (Atom Bool) instance BuildFrom Bool

30+

31+instance (Typeable x, BuildFrom x) => BuildFrom (Maybe x) where

32+ buildFrom dict = Just options

33+ where options :: StashValue (Maybe x)

34+ options = StashValue $

35+ ([],Nothing) :|

36+ (maybe [] (NEL.toList . getStashValue . fmap Just) $ buildFrom @x dict

37+ )

38+-- instance (BuildFrom a) => BuildFrom [a] -- where

39+ --breakdown x = toDyn x :| mconcat (map (NEL.toList . breakdown) x)

src/Roboservant/Types/Internal.hsnew file+33

@@ -0,0 +1,33 @@

1+{-# LANGUAGE DeriveFunctor #-}

2+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4+module Roboservant.Types.Internal where

6+import Data.List.NonEmpty (NonEmpty(..))

7+import qualified Data.Map.Strict as Map

8+import qualified Data.Dependent.Map as DM

9+import Data.Dependent.Map (DMap)

10+import qualified Type.Reflection as R

11+import Data.Dependent.Sum

12+

13+data Provenance

14+ = Provenance R.SomeTypeRep Int

15+ deriving (Show,Eq)

16+

17+newtype StashValue a = StashValue { getStashValue :: NonEmpty ([Provenance], a) }

18+ deriving (Functor, Show)

19+

20+-- wrap in newtype to give a custom Show instance, since the normal

21+-- instance for DMap is not happy since StashValue needs Show a to show

22+newtype Stash = Stash { getStash :: DMap R.TypeRep StashValue }

23+ deriving (Semigroup, Monoid)

24+

25+instance Show Stash where

26+ showsPrec i (Stash x) = showsPrec i $

27+ Map.fromList . map (\(tr :=> StashValue vs) -> (R.SomeTypeRep tr, fmap fst vs)) $ DM.toList x

28+

29+-- | Can't be built up from parts, can't be broken down further.

30+newtype Atom x = Atom { unAtom :: x }

31+

32+-- | can be broken down and built up from generic pieces

33+newtype Compound x = Compound { unCompound :: x }

src/Roboservant/Types/ReifiedApi.hs+2

@@ -29,7 +29,9 @@ import Data.List.NonEmpty (NonEmpty)

2929import Data.Typeable (Typeable)

3030import GHC.Generics ((:*:)(..))

3131import GHC.TypeLits (Symbol)

32+import Roboservant.Types.Internal

3233import Roboservant.Types.Breakdown

34+import Roboservant.Types.BuildFrom

3335import Roboservant.Types.FlattenServer

3436import Servant

3537import Servant.API.Modifiers(FoldRequired,FoldLenient)

test/Spec.hs+3−1

@@ -3,6 +3,9 @@

33{-# LANGUAGE DerivingVia #-}

44{-# LANGUAGE TypeApplications #-}

55{-# LANGUAGE LambdaCase #-}

6+{-# LANGUAGE DerivingVia #-}

7+{-# LANGUAGE StandaloneDeriving #-}

69{-# OPTIONS_GHC -fno-warn-orphans #-}

710import qualified Foo

811import qualified Seeded

@@ -16,7 +19,6 @@ import Data.Dynamic(toDyn)

1619import qualified Roboservant as RS

1720import Roboservant(Breakdown, BuildFrom, Atom, Compound)

1821import Test.Hspec

19−import Test.Hspec.Core.Spec

2022import Data.Void

2123import Data.Maybe

2224