- `backpack-handle` does the same thing as `records-handle` but using Backpack instead. It allows us to specialize function calls.
- `backpack-handles` goes further and makes `WeatherProvider` and `WeatherReporter` signatures.
+
+- `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.
--- /dev/null
+module QueryTypes where
+
+type Location = String
+type Day = String
--- /dev/null
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module TemperatureProvider where
+
+import HandleRec
+import QueryTypes
+
+type Temperature = Int
+
+type Methods = '[ '("getTemperatureData", (Location -> Day -> IO Temperature)) ]
+
+type Handle = HandleRec Methods
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeOperators #-}
module WeatherProvider where
+import Data.Vinyl.TypeLevel
import HandleRec
+import qualified WindProvider as W
+import qualified TemperatureProvider as T
+import QueryTypes
-type Temperature = Int
-data WeatherData = WeatherData { temperature :: Temperature }
+data WeatherData = WeatherData { temperature :: T.Temperature, wind :: W.WindSpeed }
-type Location = String
-type Day = String
+-- We union the methods of providers and extend it with a common method.
+type Methods = '[ '("getWeatherData", (Location -> Day -> IO WeatherData))
+ ] ++ W.Methods ++ T.Methods
+
+type Handle = HandleRec Methods
-type Handle = HandleRec
- '[ '("getWeatherData", (Location -> Day -> IO WeatherData))
- ]
-- | Domain logic. Usually some pure code that might use mtl, free monads, etc.
createWeatherReport :: WeatherProvider.WeatherData -> WeatherReport
-createWeatherReport (WeatherProvider.WeatherData temp) =
+createWeatherReport (WeatherProvider.WeatherData temp wind) =
"The current temperature in London is " ++ (show temp)
+ ++ " and wind speed is " ++ (show wind)
-- | Domain logic that uses external dependency to get data and process it.
getCurrentWeatherReportInLondon :: Handle -> IO WeatherReport
--- /dev/null
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module WindProvider where
+
+import HandleRec
+import QueryTypes
+
+type WindSpeed = Int
+
+type Methods = '[ '("getWindData", (Location -> Day -> IO WindSpeed)) ]
+
+type Handle = HandleRec Methods
+
import Data.Vinyl
import WeatherProvider
+import TemperatureProvider (Temperature)
+import WindProvider (WindSpeed)
+import QueryTypes
new :: Handle
new = Field getSuperWeatherData
+ :& Field getWindData
+ :& Field getTemperatureData
:& RNil
-- | This is some concrete implementation `WeatherProvider` interface
getSuperWeatherData :: Location -> Day -> IO WeatherData
-getSuperWeatherData _ _ = return $ WeatherData 30
+getSuperWeatherData _ _ = return $ WeatherData 30 10
+
+getTemperatureData :: Location -> Day -> IO Temperature
+getTemperatureData _ _ = return 30
+
+getWindData :: Location -> Day -> IO WindSpeed
+getWindData _ _ = return 5
import Data.Vinyl
import WeatherProvider
+import qualified TemperatureProvider as T
+import qualified WindProvider as W
+import QueryTypes
-- | This is a configuration that allows to setup the provider for tests.
data Config = Config
- { initTemperature :: Temperature
+ { initTemperature :: T.Temperature
+ , initWindSpeed :: W.WindSpeed
}
new :: Config -> Handle
-new config = Field (getTestWeatherData $ initTemperature config)
+new config = Field (getTestWeatherData (initTemperature config) (initWindSpeed config))
+ :& Field (getWindData (initWindSpeed config))
+ :& Field (getTemperatureData (initTemperature config))
:& RNil
-- | This is an implementation `WeatherProvider` interface for tests
-getTestWeatherData :: Int -> Location -> Day -> IO WeatherData
-getTestWeatherData temp _ _ = return $ WeatherData temp
+-- We can configure it independently from other providers or reuse them.
+getTestWeatherData :: T.Temperature -> W.WindSpeed -> Location -> Day -> IO WeatherData
+getTestWeatherData temp wind _ _ = return $ WeatherData temp wind
+
+getTemperatureData :: T.Temperature -> Location -> Day -> IO T.Temperature
+getTemperatureData t _ _ = return t
+
+getWindData :: W.WindSpeed -> Location -> Day -> IO W.WindSpeed
+getWindData w _ _ = return w
import qualified TestWeatherProvider
import qualified WeatherProvider
+import qualified TemperatureProvider
+import qualified WindProvider
import qualified WeatherReporter
main :: IO ()
main = hspec spec
-weatherWithTemp :: WeatherProvider.Temperature -> WeatherReporter.Handle
-weatherWithTemp = WeatherReporter.new
- . TestWeatherProvider.new
- . TestWeatherProvider.Config
+weatherWithTempAndWind
+ :: TemperatureProvider.Temperature
+ -> WindProvider.WindSpeed
+ -> WeatherReporter.Handle
+weatherWithTempAndWind t w = WeatherReporter.new
+ $ TestWeatherProvider.new
+ $ TestWeatherProvider.Config t w
spec :: Spec
spec = describe "WeatherReporter" $ do
- it "weather in London is 0" $ do
+ it "weather in London is 0 and wind is 5" $ do
weatherReportInLondon <- WeatherReporter.getCurrentWeatherReportInLondon $
- weatherWithTemp 0
- weatherReportInLondon `shouldBe` "The current temperature in London is 0"
- it "weather in London is -5" $ do
+ weatherWithTempAndWind 0 5
+ weatherReportInLondon `shouldBe` "The current temperature in London is 0 and wind speed is 5"
+ it "weather in London is -5 and wind is 10" $ do
weatherReportInLondon <- WeatherReporter.getCurrentWeatherReportInLondon $
- weatherWithTemp (-5)
- weatherReportInLondon `shouldBe` "The current temperature in London is -5"
+ weatherWithTempAndWind (-5) 10
+ weatherReportInLondon `shouldBe` "The current temperature in London is -5 and wind speed is 10"
hs-source-dirs: domain
exposed-modules: WeatherProvider
, WeatherReporter
+ , WindProvider
+ , TemperatureProvider
, HandleRec
+ , QueryTypes
default-language: Haskell2010
build-depends: base, vinyl
projects / handle-examples.hs.git / commitdiff