--- /dev/null
+MIT License
+
+Copyright (c) 2021 Evgenii Akentev
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
--- /dev/null
+module Main where
+
+import qualified SuperWeatherProvider
+import qualified SuperWindProvider
+import qualified SuperTemperatureProvider
+import qualified WeatherProvider
+import qualified WeatherReporter
+
+-- | This is an actual application where we use
+-- our concrete implementation of `WeatherProvider`.
+main :: IO ()
+main = do
+ let
+ wp = SuperWindProvider.new
+ tp = SuperTemperatureProvider.new
+ wph = SuperWeatherProvider.new wp tp
+ wrh = WeatherReporter.new wph
+ weatherReportInLondon <- WeatherReporter.getCurrentWeatherReportInLondon wrh
+ putStrLn weatherReportInLondon
--- /dev/null
+import Distribution.Simple
+main = defaultMain
--- /dev/null
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE TypeOperators #-}
+
+module HandleRow where
+
+import Data.Row
+
+type HandleRow rs = Rec rs
+
+getMethod :: forall l r . KnownSymbol l => Rec r -> r .! l
+getMethod = flip (.!) (Label @l)
--- /dev/null
+module QueryTypes where
+
+type Location = String
+type Day = String
--- /dev/null
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+
+module TemperatureProvider where
+
+import Data.Row
+import HandleRow
+import QueryTypes
+
+type Temperature = Int
+
+type Methods = "getTemperatureData" .== (Location -> Day -> IO Temperature)
+
+type Handle = HandleRow Methods
+
+getTemperatureData :: Handle -> Location -> Day -> IO Temperature
+getTemperatureData = getMethod @"getTemperatureData"
--- /dev/null
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeApplications #-}
+
+module WeatherProvider where
+
+import Data.Row
+import HandleRow
+import qualified WindProvider as W
+import qualified TemperatureProvider as T
+import QueryTypes
+
+data WeatherData = WeatherData { temperature :: T.Temperature, wind :: W.WindSpeed }
+
+-- 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 = HandleRow Methods
+
+getWeatherData :: Handle -> Location -> Day -> IO WeatherData
+getWeatherData = getMethod @"getWeatherData"
+
+getWindData :: Handle -> Location -> Day -> IO W.WindSpeed
+getWindData = getMethod @"getWindData"
--- /dev/null
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DataKinds #-}
+
+module WeatherReporter where
+
+import qualified WeatherProvider
+
+type WeatherReport = String
+
+-- | We hide dependencies in the handle
+data Handle = Handle { weatherProvider :: WeatherProvider.Handle }
+
+-- | Constructor for Handle
+new :: WeatherProvider.Handle -> Handle
+new = Handle
+
+-- | Domain logic. Usually some pure code that might use mtl, free monads, etc.
+createWeatherReport :: WeatherProvider.WeatherData -> WeatherReport
+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
+getCurrentWeatherReportInLondon (Handle wph) = do
+ weatherData <- WeatherProvider.getWeatherData wph "London" "now"
+ return $ createWeatherReport weatherData
--- /dev/null
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+
+module WindProvider where
+
+import Data.Row
+import HandleRow
+import QueryTypes
+
+type WindSpeed = Int
+
+type Methods = "getWindData" .== (Location -> Day -> IO WindSpeed)
+
+type Handle = HandleRow Methods
+
+getWindData :: Handle -> Location -> Day -> IO WindSpeed
+getWindData = getMethod @"getWindData"
--- /dev/null
+{-# LANGUAGE OverloadedLabels #-}
+module SuperTemperatureProvider where
+
+import Data.Row
+import TemperatureProvider
+import QueryTypes
+
+new :: Handle
+new = #getTemperatureData .== getSuperTemperatureData
+
+getSuperTemperatureData :: Location -> Day -> IO Temperature
+getSuperTemperatureData _ _ = return 30
--- /dev/null
+{-# LANGUAGE OverloadedLabels #-}
+module SuperWeatherProvider where
+
+import Data.Row
+import WeatherProvider
+import qualified TemperatureProvider
+import qualified WindProvider
+import QueryTypes
+
+new :: WindProvider.Handle -> TemperatureProvider.Handle -> Handle
+new wp tp = #getWeatherData .== getSuperWeatherData .+ wp .+ tp
+
+-- | This is some concrete implementation `WeatherProvider` interface
+getSuperWeatherData :: Location -> Day -> IO WeatherData
+getSuperWeatherData _ _ = return $ WeatherData 30 10
--- /dev/null
+{-# LANGUAGE OverloadedLabels #-}
+module SuperWindProvider where
+
+import Data.Row
+import WindProvider
+import QueryTypes
+
+new :: Handle
+new = #getWindData .== getSuperWindData
+
+getSuperWindData :: Location -> Day -> IO WindSpeed
+getSuperWindData _ _ = return 5
--- /dev/null
+cabal-version: >=2.0
+name: row-handle
+version: 0.1.0.0
+license-file: LICENSE
+author: Evgenii Akentev
+maintainer: i@ak3n.com
+build-type: Simple
+extra-source-files: CHANGELOG.md
+
+library domain
+ hs-source-dirs: domain
+ exposed-modules: WeatherProvider
+ , WeatherReporter
+ , WindProvider
+ , TemperatureProvider
+ , HandleRow
+ , QueryTypes
+ default-language: Haskell2010
+ build-depends: base, row-types
+
+library impl
+ hs-source-dirs: impl
+ exposed-modules: SuperWeatherProvider
+ , SuperWindProvider
+ , SuperTemperatureProvider
+ default-language: Haskell2010
+ build-depends: base, domain, row-types
+
+library test-impl
+ hs-source-dirs: test-impl
+ exposed-modules: TestWeatherProvider
+ default-language: Haskell2010
+ build-depends: base, domain, row-types
+
+executable main
+ main-is: Main.hs
+ build-depends: base >=4.13 && <5
+ , domain
+ , impl
+ default-language: Haskell2010
+
+test-suite spec
+ type: exitcode-stdio-1.0
+ hs-source-dirs: test
+ main-is: Test.hs
+ default-language: Haskell2010
+ build-depends: base >= 4.7 && < 5
+ , QuickCheck
+ , hspec
+ , domain
+ , test-impl
--- /dev/null
+{-# LANGUAGE OverloadedLabels #-}
+module TestWeatherProvider where
+
+import Data.Row
+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 :: T.Temperature
+ , initWindSpeed :: W.WindSpeed
+ }
+
+new :: Config -> Handle
+new config = #getWeatherData .== (getTestWeatherData (initTemperature config) (initWindSpeed config))
+ .+ #getWindData .== (getTestWindData (initWindSpeed config))
+ .+ #getTemperatureData .== (getTestTemperatureData (initTemperature config))
+
+-- | This is an implementation `WeatherProvider` interface for tests
+-- 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
+
+getTestTemperatureData :: T.Temperature -> Location -> Day -> IO T.Temperature
+getTestTemperatureData t _ _ = return t
+
+getTestWindData :: W.WindSpeed -> Location -> Day -> IO W.WindSpeed
+getTestWindData w _ _ = return w
--- /dev/null
+import Test.Hspec
+
+import qualified TestWeatherProvider
+import qualified WeatherProvider
+import qualified TemperatureProvider
+import qualified WindProvider
+import qualified WeatherReporter
+
+main :: IO ()
+main = hspec spec
+
+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 and wind is 5" $ do
+ weatherReportInLondon <- WeatherReporter.getCurrentWeatherReportInLondon $
+ 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 $
+ weatherWithTempAndWind (-5) 10
+ weatherReportInLondon `shouldBe` "The current temperature in London is -5 and wind speed is 10"
projects / handle-examples.git / commitdiff