repos / handle-examples.hs.git

commit

c557355

parent

938c4b8

author

Evgenii Akentev

date

2021-01-09 15:31:33 +0400 +04

Improve vinyl-handle example with multiple providers.

1@@ -9,3 +9,5 @@ This repository contains examples of [the Handle pattern](https://jaspervdj.be/p
2 - `backpack-handle` does the same thing as `records-handle` but using Backpack instead. It allows us to specialize function calls.
3 
4 - `backpack-handles` goes further and makes `WeatherProvider` and `WeatherReporter` signatures.
5+
6+- `vinyl-handle` explores the design space using `vinyl` instead of records as Handle. It supports the extension of the interfaces since `vinyl` allows to add fields to the records.

1@@ -0,0 +1,4 @@
2+module QueryTypes where
3+
4+type Location = String
5+type Day = String

 1@@ -0,0 +1,13 @@
 2+{-# LANGUAGE DataKinds #-}
 3+{-# LANGUAGE OverloadedStrings #-}
 4+
 5+module TemperatureProvider where
 6+
 7+import HandleRec
 8+import QueryTypes
 9+
10+type Temperature = Int
11+
12+type Methods = '[ '("getTemperatureData", (Location -> Day -> IO Temperature)) ]
13+
14+type Handle = HandleRec Methods

 1@@ -1,16 +1,20 @@
 2 {-# LANGUAGE DataKinds #-}
 3 {-# LANGUAGE OverloadedStrings #-}
 4+{-# LANGUAGE TypeOperators #-}
 5 
 6 module WeatherProvider where
 7 
 8+import Data.Vinyl.TypeLevel
 9 import HandleRec
10+import qualified WindProvider as W
11+import qualified TemperatureProvider as T
12+import QueryTypes
13 
14-type Temperature = Int
15-data WeatherData = WeatherData { temperature :: Temperature }
16+data WeatherData = WeatherData { temperature :: T.Temperature, wind :: W.WindSpeed }
17 
18-type Location = String
19-type Day = String
20+-- We union the methods of providers and extend it with a common method.
21+type Methods = '[ '("getWeatherData", (Location -> Day -> IO WeatherData))
22+  ] ++ W.Methods ++ T.Methods
23+
24+type Handle = HandleRec Methods
25 
26-type Handle = HandleRec
27-  '[ '("getWeatherData", (Location -> Day -> IO WeatherData))
28-  ]

 1@@ -20,8 +20,9 @@ new = Handle
 2 
 3 -- | Domain logic. Usually some pure code that might use mtl, free monads, etc.
 4 createWeatherReport :: WeatherProvider.WeatherData -> WeatherReport
 5-createWeatherReport (WeatherProvider.WeatherData temp) =
 6+createWeatherReport (WeatherProvider.WeatherData temp wind) =
 7   "The current temperature in London is " ++ (show temp)
 8+  ++ " and wind speed is " ++ (show wind)
 9 
10 -- | Domain logic that uses external dependency to get data and process it.
11 getCurrentWeatherReportInLondon :: Handle -> IO WeatherReport

 1@@ -0,0 +1,14 @@
 2+{-# LANGUAGE DataKinds #-}
 3+{-# LANGUAGE OverloadedStrings #-}
 4+
 5+module WindProvider where
 6+
 7+import HandleRec
 8+import QueryTypes
 9+
10+type WindSpeed = Int
11+
12+type Methods = '[ '("getWindData", (Location -> Day -> IO WindSpeed)) ]
13+
14+type Handle = HandleRec Methods
15+

 1@@ -2,11 +2,22 @@ module SuperWeatherProvider where
 2 
 3 import Data.Vinyl
 4 import WeatherProvider
 5+import TemperatureProvider (Temperature)
 6+import WindProvider (WindSpeed)
 7+import QueryTypes
 8 
 9 new :: Handle
10 new = Field getSuperWeatherData
11+  :& Field getWindData
12+  :& Field getTemperatureData
13   :& RNil
14 
15 -- | This is some concrete implementation `WeatherProvider` interface
16 getSuperWeatherData :: Location -> Day -> IO WeatherData
17-getSuperWeatherData _ _ = return $ WeatherData 30
18+getSuperWeatherData _ _ = return $ WeatherData 30 10
19+
20+getTemperatureData :: Location -> Day -> IO Temperature
21+getTemperatureData _ _ = return 30
22+
23+getWindData :: Location -> Day -> IO WindSpeed
24+getWindData _ _ = return 5

 1@@ -2,16 +2,29 @@ module TestWeatherProvider where
 2 
 3 import Data.Vinyl
 4 import WeatherProvider
 5+import qualified TemperatureProvider as T
 6+import qualified WindProvider as W
 7+import QueryTypes
 8 
 9 -- | This is a configuration that allows to setup the provider for tests.
10 data Config = Config
11-  { initTemperature :: Temperature
12+  { initTemperature :: T.Temperature
13+  , initWindSpeed :: W.WindSpeed
14   }
15 
16 new :: Config -> Handle
17-new config = Field (getTestWeatherData $ initTemperature config)
18+new config = Field (getTestWeatherData (initTemperature config) (initWindSpeed config))
19+  :& Field (getWindData (initWindSpeed config))
20+  :& Field (getTemperatureData (initTemperature config))
21   :& RNil
22 
23 -- | This is an implementation `WeatherProvider` interface for tests
24-getTestWeatherData :: Int -> Location -> Day -> IO WeatherData
25-getTestWeatherData temp _ _ = return $ WeatherData temp
26+-- We can configure it independently from other providers or reuse them.
27+getTestWeatherData :: T.Temperature -> W.WindSpeed -> Location -> Day -> IO WeatherData
28+getTestWeatherData temp wind _ _ = return $ WeatherData temp wind
29+
30+getTemperatureData :: T.Temperature -> Location -> Day -> IO T.Temperature
31+getTemperatureData t _ _ = return t
32+
33+getWindData :: W.WindSpeed -> Location -> Day -> IO W.WindSpeed
34+getWindData w _ _ = return w

 1@@ -2,23 +2,28 @@ import Test.Hspec
 2 
 3 import qualified TestWeatherProvider
 4 import qualified WeatherProvider
 5+import qualified TemperatureProvider
 6+import qualified WindProvider
 7 import qualified WeatherReporter
 8 
 9 main :: IO ()
10 main = hspec spec
11 
12-weatherWithTemp :: WeatherProvider.Temperature -> WeatherReporter.Handle
13-weatherWithTemp = WeatherReporter.new
14-  . TestWeatherProvider.new
15-  . TestWeatherProvider.Config
16+weatherWithTempAndWind
17+  :: TemperatureProvider.Temperature
18+  -> WindProvider.WindSpeed
19+  -> WeatherReporter.Handle
20+weatherWithTempAndWind t w = WeatherReporter.new
21+  $ TestWeatherProvider.new
22+  $ TestWeatherProvider.Config t w
23 
24 spec :: Spec
25 spec = describe "WeatherReporter" $ do
26-  it "weather in London is 0" $ do
27+  it "weather in London is 0 and wind is 5" $ do
28     weatherReportInLondon <- WeatherReporter.getCurrentWeatherReportInLondon $
29-      weatherWithTemp 0
30-    weatherReportInLondon `shouldBe` "The current temperature in London is 0"
31-  it "weather in London is -5" $ do
32+      weatherWithTempAndWind 0 5
33+    weatherReportInLondon `shouldBe` "The current temperature in London is 0 and wind speed is 5"
34+  it "weather in London is -5 and wind is 10" $ do
35     weatherReportInLondon <- WeatherReporter.getCurrentWeatherReportInLondon $
36-      weatherWithTemp (-5)
37-    weatherReportInLondon `shouldBe` "The current temperature in London is -5"
38+      weatherWithTempAndWind (-5) 10
39+    weatherReportInLondon `shouldBe` "The current temperature in London is -5 and wind speed is 10"

 1@@ -11,7 +11,10 @@ library domain
 2   hs-source-dirs: domain
 3   exposed-modules: WeatherProvider
 4                  , WeatherReporter
 5+                 , WindProvider
 6+                 , TemperatureProvider
 7                  , HandleRec
 8+                 , QueryTypes
 9   default-language: Haskell2010
10   build-depends:    base, vinyl
11