git.iko.soy/roboservant
on master help sign in
some extra instances & readme
commitb9c1349ed0c34b30ca1eec5e41a919f865f52fb3 authorMark Wotton <mwotton@gmail.com> dateThu 7 Jan 2021, 11:53 (6 years ago) parent2631bb7
4 files changed+24−11
compare with master
unifiedsplit
README.md+6 src/Roboservant/Types/Breakdown.hs+9 src/Roboservant/Types/BuildFrom.hs+4−2 src/Roboservant/Types/FlattenServer.hs+5−9
README.md+6
@@ -102,6 +102,12 @@ we would want to show that distinction in a visible way: it's possible
102102that other calls that don't have direct data dependencies were
103103important, but we definitely know we need the direct data dependencies.
104104
105+The provenance stuff is a bit underbaked. It should at least pull a
106+representation of the route chosen rather than just an integer index.
107+
105108It would also be nice to have a robust strategy for deriving recursive
106109datatypes, or at least rejecting attempts to generate them that don't
107110end in an infinite loop.
111+
112+Currently the `FlattenServer` instance for `:>` is quadratic. It would
113+be nice to fix this but I lack the art.
src/Roboservant/Types/Breakdown.hs+9
@@ -41,6 +41,12 @@ deriving via (Atom Int) instance Breakdown Int
4141
4242deriving via (Atom [Char]) instance Breakdown [Char]
4343
44+deriving via (Compound (Maybe x)) instance (Typeable x, Hashable x, Breakdown x) => Breakdown (Maybe x)
45+
46+instance (Hashable x, Typeable x, Breakdown x) => Breakdown [x] where
47+ breakdownExtras stash = concatMap (NEL.toList . breakdown) stash
48+
49+
4450class GBreakdown (f :: k -> *) where
4551 gBreakdownExtras :: f a -> [(Dynamic, Int)]
4652
@@ -66,3 +72,6 @@ instance (GBreakdown a, GBreakdown b) => GBreakdown (a :+: b) where
6672
6773instance (Hashable a, Typeable a, Breakdown a) => GBreakdown (K1 R a) where
6874 gBreakdownExtras (K1 c) = NEL.toList $ breakdown c
75+
76+instance GBreakdown U1 where
77+ gBreakdownExtras U1 = []
src/Roboservant/Types/BuildFrom.hs+4−2
@@ -61,9 +61,11 @@ deriving via (Compound (Maybe x)) instance (Typeable x, Hashable x, BuildFrom x)
6161-- this isn't wonderful, but we need a hand-rolled instance for recursive datatypes right now.
6262-- with an arbitrary-ish interface, we could use a size parameter, rng access etc.
6363instance (BuildFrom x) => BuildFrom [x] where
64− extras stash = map (\xs -> (concatMap fst xs, map snd xs)) $ powerset $ extras @x stash
64+ extras stash = map (\xs -> (concatMap fst xs, map snd xs)) $ notpowerset $ extras @x stash
6565 where
66− powerset xs = filterM (const [True, False]) xs
66+ -- powerset creates way too much stuff. something better here eventually.
67+ notpowerset xs = xs:map pure xs
68+
6769
6870instance (Hashable x, Typeable x, Generic x, GBuildFrom (Rep x)) => BuildFrom (Compound (x :: Type)) where
6971 extras stash = fmap (Compound . to) <$> gExtras stash
src/Roboservant/Types/FlattenServer.hs+5−9
@@ -26,19 +26,15 @@ instance
2626 FlattenServer (endpoint :<|> api)
2727 where
2828 flattenServer (endpoint :<|> server) = endpoint `AnEndpoint` flattenServer @api server
29−
29+
3030instance
31− ( HasServer (x :> api) '[],
32− Endpoints (x :> api) ~ '[x :> api]
33− ) =>
31+ (
32+ Endpoints api ~ '[api]
33+ ) =>
3434 FlattenServer (x :> api)
3535 where
3636 flattenServer server = server `AnEndpoint` NoEndpoints
3737
38−instance
39− ( Endpoints (Verb method statusCode contentTypes responseType) ~ '[Verb method statusCode contentTypes responseType],
40− HasServer (Verb method statusCode contentTypes responseType) '[]
41− ) =>
42− FlattenServer (Verb method statusCode contentTypes responseType)
38+instance FlattenServer (Verb method statusCode contentTypes responseType)
4339 where
4440 flattenServer server = server `AnEndpoint` NoEndpoints