on develop help sign in
Re-enabling path/query generation
commit3ad8335996b93d7b00d7279910f352efe2c0c011 authorBrendan Hay <brendan.g.hay@gmail.com> dateSun 27 Sep 2015, 21:06 (11 years ago) parent8263baf
2 files changed+30−28
gen/src/Gen/AST.hs+3−2 gen/src/Gen/Syntax.hs+27−26
gen/src/Gen/AST.hs+3−2
@@ -185,8 +185,9 @@ flatten svc = do
185185 ms <- uses schemas (Map.lookup n)
186186 case ms of
187187 Just y | x /= y -> throwError $
188− format ("Schema exists: " % shown % "\nTried inserting: " % shown)
189− y x
188+ format ("Schema exists: " % fid %
189+ "\nCurrent: " % shown % "\nTried: " % shown)
190+ n y x
190191 _ -> schemas %= Map.insert n x
191192
192193 return n
gen/src/Gen/Syntax.hs+27−26
@@ -14,7 +14,7 @@ module Gen.Syntax where
1414
1515import Control.Lens hiding (iso, mapping, op, pre,
1616 strict)
17−import Data.Foldable (foldl', foldr')
17+import Data.Foldable (find, foldl', foldr')
1818import Data.Hashable
1919import qualified Data.HashMap.Strict as Map
2020import Data.Maybe
@@ -46,34 +46,35 @@ verbAlias s n m = TypeDecl noLoc n [] alias
4646 alias = foldr' (\l r -> TyInfix l (UnQual (sym ":>")) r) verb (path ++ qry)
4747
4848 path :: [Type]
49− path = [] -- map match
50− -- . filter (not . Text.null)
51− -- $ Text.split (== '/') (_svcServicePath s)
52− -- <> Text.split (== '/') (_mPath m)
53− -- where
54− -- match x
55− -- | Just (c, t) <- Text.uncons x
56− -- , c == '{'
57− -- , Just k <- Map.lookup (Local (Text.init t)) params
58− -- , _prmLocation k == Path
59− -- = TyApp (TyApp (tycon "Capture")
60− -- (sing (Text.init t)))
61− -- (literal (_prmLiteral k))
62− -- | otherwise = sing x
49+ path = map match
50+ . filter (not . Text.null)
51+ $ Text.split (== '/') (_svcServicePath s)
52+ <> Text.split (== '/') (_mPath m)
53+ where
54+ -- FIXME: should error if '{' '}' is found and cannot find the ref.
55+ match x
56+ | Just (c, t) <- Text.uncons x
57+ , c == '{'
58+ , Just k <- Map.lookup (Local (Text.init t)) params
59+ , _prmLocation k == Path
60+ = TyApp (TyApp (tycon "Capture")
61+ (sing (Text.init t)))
62+ (external (_type (_prmSchema k)))
63+ | otherwise = sing x
6364
6465 -- FIXME: order by _mParameterOrder
6566 qry :: [Type]
66− qry = [] -- mapMaybe f (Map.toList params)
67− -- where
68− -- f (k, p) =
69− -- -- FIXME: types, many/repeated
70− -- let t = literal (_prmLiteral p)
71− -- n = sing (local k)
72− -- in case _prmLocation p of
73− -- Query -> Just $ TyApp (TyApp (tycon "QueryParam") n) t
74− -- Path -> Nothing
75−
76−-- params = _svcParameters s <> _mParameters m
67+ qry = mapMaybe f (Map.toList params)
68+ where
69+ f (k, x) =
70+ -- FIXME: types, many/repeated
71+ let t = external (_type (_prmSchema x))
72+ n = sing (local k)
73+ in case _prmLocation x of
74+ Query -> Just $ TyApp (TyApp (tycon "QueryParam") n) t
75+ Path -> Nothing
76+
77+ params = _mParameters m
7778
7879 verb :: Type
7980 verb = TyApp (TyApp meth typ) res