@@ -0,0 +1,71 @@
1+{-# LANGUAGE AllowAmbiguousTypes #-}
2+{-# LANGUAGE DataKinds #-}
3+{-# LANGUAGE FlexibleContexts #-}
4+{-# LANGUAGE FlexibleInstances #-}
5+{-# LANGUAGE GADTs #-}
6+{-# LANGUAGE KindSignatures #-}
7+{-# LANGUAGE MultiParamTypeClasses #-}
8+{-# LANGUAGE PolyKinds #-}
9+{-# LANGUAGE QuantifiedConstraints #-}
10+{-# LANGUAGE RankNTypes #-}
11+{-# LANGUAGE ScopedTypeVariables #-}
12+{-# LANGUAGE TypeApplications #-}
13+{-# LANGUAGE TypeFamilies #-}
14+{-# LANGUAGE TypeOperators #-}
15+{-# LANGUAGE UndecidableInstances #-}
16+
17+module Roboservant where
18+
19+import Control.Applicative
20+import GHC.TypeLits
21+import Servant.API
22+
23+type family ExtractRespType (path :: *) :: * where
24+ ExtractRespType (_ :> b) = ExtractRespType b
25+ ExtractRespType (Verb (method :: StdMethod) (responseCode :: Nat) (contentTypes :: [*]) (respType :: *)) = respType
26+
27+type family ExtractRespTypes (paths :: *) :: [*] where
28+ ExtractRespTypes (a :<|> b) = ExtractRespTypes a <> ExtractRespTypes b
29+ ExtractRespTypes a = '[ExtractRespType a]
30+
31+type family (<>) (xs :: [k]) (ys :: [k]) :: [k] where
32+ (x ': xs) <> ys = x ': (xs <> ys)
33+ '[] <> ys = ys
34+
35+data List :: (* -> *) -> [*] -> * where
36+ Cons :: f a -> List f as -> List f (a ': as)
37+ Nil :: List f '[]
38+
39+class Insert f a as where
40+ insert :: a -> List f as -> List f as
41+
42+class Lookup f a as where
43+ lookup :: List f as -> f a
44+
45+instance Show (List f '[]) where
46+ show Nil = "Nil"
47+
48+instance (Show (List f as), forall a. Show a => Show (f a), Show a) => Show (List f (a ': as)) where
49+ show (Cons fa fas) = "(Cons " <> show fa <> " " <> show fas <> ")"
50+
51+storeOfApi :: forall api xs. (ExtractRespTypes api ~ xs, BuildStore [] xs) => List [] (ExtractRespTypes api)
52+storeOfApi = buildStore
53+
54+class BuildStore f (xs :: [*]) where
55+ buildStore :: List f xs
56+
57+instance BuildStore f '[] where
58+ buildStore = Nil
59+
60+instance (BuildStore f xs, Alternative f) => BuildStore f (x ': xs) where
61+ buildStore = Cons empty (buildStore @_ @xs)
62+-- 1.
63+-- Instead of just the resptype, let's return a tuple of (resptype, '[]::[ ? respType])
64+
65+-- 2.
66+-- break down respType into "useful" components
67+-- data Baz = Baz { key1 :: Key Foo, key2 :: Key Bar }
68+-- should insert into type-indexed list three elements
69+-- 'Baz -> whole value
70+-- '(Key Bar) -> key2
71+-- '(Key Foo) -> key1