git.iko.soy/typeable/servant
on master help sign in
WIP - Mappable
commit3375a33b4a2844172b2f42623e3ecc12ed41d298 authorAmar <amar@capital-match.com> dateThu 7 Apr 2016, 20:54 (11 years ago) parent56c13ee
3 files changed+48
compare with master
unifiedsplit
servant/servant.cabal+1 servant/src/Servant/Utils/Map.hs+20 servant/test/Servant/Utils/MapSpec.hs+27
servant/servant.cabal+1
@@ -96,6 +96,7 @@ test-suite spec
9696 Servant.API.ContentTypesSpec
9797 Servant.API.ResponseHeadersSpec
9898 Servant.Utils.LinksSpec
99+ Servant.Utils.MapSpec
99100 build-depends:
100101 base == 4.*
101102 , aeson
servant/src/Servant/Utils/Map.hsnew file+20
@@ -0,0 +1,20 @@
1+{-# LANGUAGE FlexibleInstances #-}
2+{-# LANGUAGE MultiParamTypeClasses #-}
3+{-# LANGUAGE RankNTypes #-}
4+{-# LANGUAGE TypeFamilies #-}
5+{-# LANGUAGE TypeOperators #-}
6+module Servant.Utils.Map (mapLeaves) where
7+
8+import Servant.API
9+
10+class Mappable s t a b where
11+ mapLeaves :: (forall x . a x -> b x) -> s -> t
12+
13+instance Mappable (a x) (b x) a b where
14+ mapLeaves f a = f a
15+
16+instance Mappable s t a b => Mappable (arg -> s) (arg -> t) a b where
17+ mapLeaves f s = mapLeaves f $ s
18+
19+instance (Mappable left left' a b, Mappable right right' a b) => Mappable (left :<|> right) (left' :<|> right') a b where
20+ mapLeaves f (left :<|> right) = mapLeaves f left :<|> mapLeaves f right
servant/test/Servant/Utils/MapSpec.hsnew file+27
@@ -0,0 +1,27 @@
1+module Servant.Utils.MapSpec where
2+
3+import Test.Hspec
4+
5+import Data.Functor.Identity
6+import Servant.API
7+import Servant.Utils.Map
8+spec :: Spec
9+spec = describe "Map" $ do
10+ it "maps " $ do
11+ let foo :: Bool -> Int -> String
12+ foo _ b = show b
13+
14+ bar :: () -> String -> Int -> Double
15+ bar _ _ i = fromIntegral i
16+
17+ foobar = foo :<|> bar
18+
19+ convert :: (Int -> a) -> Identity a
20+ convert f = Identity $ f 42
21+
22+ foo' :: Bool -> Identity String
23+ bar' :: () -> String -> Identity Double
24+ foo' :<|> bar' = mapLeaves convert foobar
25+
26+ foo' True `shouldBe` Identity "42"
27+ bar' () "" `shouldBe` Identity (42 :: Double)