repos / handle-examples.hs.git

commit

5403ccb

parent

c557355

author

Evgenii Akentev

date

2021-01-09 17:42:07 +0400 +04

[vinyl-handle]: hide implementation details

 1@@ -1,6 +1,7 @@
 2 {-# LANGUAGE DataKinds #-}
 3 {-# LANGUAGE OverloadedStrings #-}
 4 {-# LANGUAGE TypeOperators #-}
 5+{-# LANGUAGE TypeApplications #-}
 6 
 7 module WeatherProvider where
 8 
 9@@ -18,3 +19,11 @@ type Methods = '[ '("getWeatherData", (Location -> Day -> IO WeatherData))
10 
11 type Handle = HandleRec Methods
12 
13+getWeatherData :: Handle -> Location -> Day -> IO WeatherData
14+getWeatherData = getMethod @"getWeatherData"
15+
16+getTemperatureData :: Handle -> Location -> Day -> IO T.Temperature
17+getTemperatureData = getMethod @"getTemperatureData"
18+
19+getWindData :: Handle -> Location -> Day -> IO W.WindSpeed
20+getWindData = getMethod @"getWindData"

 1@@ -4,9 +4,6 @@
 2 
 3 module WeatherReporter where
 4 
 5-import HandleRec
 6-import Data.Vinyl as V
 7-
 8 import qualified WeatherProvider
 9 
10 type WeatherReport = String
11@@ -27,5 +24,5 @@ createWeatherReport (WeatherProvider.WeatherData temp wind) =
12 -- | Domain logic that uses external dependency to get data and process it.
13 getCurrentWeatherReportInLondon :: Handle -> IO WeatherReport
14 getCurrentWeatherReportInLondon (Handle wph) = do
15-  weatherData <- (getMethod @"getWeatherData" wph) "London" "now"
16+  weatherData <- WeatherProvider.getWeatherData wph "London" "now"
17   return $ createWeatherReport weatherData

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

 1@@ -14,8 +14,8 @@ data Config = Config
 2 
 3 new :: Config -> Handle
 4 new config = Field (getTestWeatherData (initTemperature config) (initWindSpeed config))
 5-  :& Field (getWindData (initWindSpeed config))
 6-  :& Field (getTemperatureData (initTemperature config))
 7+  :& Field (getTestWindData (initWindSpeed config))
 8+  :& Field (getTestTemperatureData (initTemperature config))
 9   :& RNil
10 
11 -- | This is an implementation `WeatherProvider` interface for tests
12@@ -23,8 +23,8 @@ new config = Field (getTestWeatherData (initTemperature config) (initWindSpeed c
13 getTestWeatherData :: T.Temperature -> W.WindSpeed -> Location -> Day -> IO WeatherData
14 getTestWeatherData temp wind _ _ = return $ WeatherData temp wind
15 
16-getTemperatureData :: T.Temperature -> Location -> Day -> IO T.Temperature
17-getTemperatureData t _ _ = return t
18+getTestTemperatureData :: T.Temperature -> Location -> Day -> IO T.Temperature
19+getTestTemperatureData t _ _ = return t
20 
21-getWindData :: W.WindSpeed -> Location -> Day -> IO W.WindSpeed
22-getWindData w _ _ = return w
23+getTestWindData :: W.WindSpeed -> Location -> Day -> IO W.WindSpeed
24+getTestWindData w _ _ = return w