repos / handle-examples.hs.git

commit

13b140f

parent

2343a64

author

Evgenii Akentev

date

2021-09-08 23:06:35 +0400 +04

Add row-handle

 1@@ -0,0 +1,21 @@
 2+MIT License
 3+
 4+Copyright (c) 2021 Evgenii Akentev
 5+
 6+Permission is hereby granted, free of charge, to any person obtaining a copy
 7+of this software and associated documentation files (the "Software"), to deal
 8+in the Software without restriction, including without limitation the rights
 9+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
10+copies of the Software, and to permit persons to whom the Software is
11+furnished to do so, subject to the following conditions:
12+
13+The above copyright notice and this permission notice shall be included in all
14+copies or substantial portions of the Software.
15+
16+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
17+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
18+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
19+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
20+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
21+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
22+SOFTWARE.

 1@@ -0,0 +1,19 @@
 2+module Main where
 3+
 4+import qualified SuperWeatherProvider
 5+import qualified SuperWindProvider
 6+import qualified SuperTemperatureProvider
 7+import qualified WeatherProvider
 8+import qualified WeatherReporter
 9+
10+-- | This is an actual application where we use
11+-- our concrete implementation of `WeatherProvider`.
12+main :: IO ()
13+main = do
14+  let
15+    wp = SuperWindProvider.new
16+    tp = SuperTemperatureProvider.new
17+    wph = SuperWeatherProvider.new wp tp
18+    wrh = WeatherReporter.new wph
19+  weatherReportInLondon <- WeatherReporter.getCurrentWeatherReportInLondon wrh
20+  putStrLn weatherReportInLondon

1@@ -0,0 +1,2 @@
2+import Distribution.Simple
3+main = defaultMain

 1@@ -0,0 +1,17 @@
 2+{-# LANGUAGE TypeApplications #-}
 3+{-# LANGUAGE DataKinds #-}
 4+{-# LANGUAGE RankNTypes #-}
 5+{-# LANGUAGE ScopedTypeVariables #-}
 6+{-# LANGUAGE FlexibleContexts #-}
 7+{-# LANGUAGE GADTs #-}
 8+{-# LANGUAGE AllowAmbiguousTypes #-}
 9+{-# LANGUAGE TypeOperators #-}
10+
11+module HandleRow where
12+
13+import Data.Row
14+
15+type HandleRow rs = Rec rs
16+
17+getMethod :: forall l r . KnownSymbol l => Rec r -> r .! l
18+getMethod = flip (.!) (Label @l)

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

 1@@ -0,0 +1,19 @@
 2+{-# LANGUAGE DataKinds #-}
 3+{-# LANGUAGE OverloadedStrings #-}
 4+{-# LANGUAGE TypeApplications #-}
 5+{-# LANGUAGE TypeOperators #-}
 6+
 7+module TemperatureProvider where
 8+
 9+import Data.Row
10+import HandleRow
11+import QueryTypes
12+
13+type Temperature = Int
14+
15+type Methods = "getTemperatureData" .== (Location -> Day -> IO Temperature)
16+
17+type Handle = HandleRow Methods
18+
19+getTemperatureData :: Handle -> Location -> Day -> IO Temperature
20+getTemperatureData = getMethod @"getTemperatureData"

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

 1@@ -0,0 +1,28 @@
 2+{-# LANGUAGE TypeApplications #-}
 3+{-# LANGUAGE OverloadedStrings #-}
 4+{-# LANGUAGE DataKinds #-}
 5+
 6+module WeatherReporter where
 7+
 8+import qualified WeatherProvider
 9+
10+type WeatherReport = String
11+
12+-- | We hide dependencies in the handle
13+data Handle = Handle { weatherProvider :: WeatherProvider.Handle }
14+
15+-- | Constructor for Handle
16+new :: WeatherProvider.Handle -> Handle
17+new = Handle
18+
19+-- | Domain logic. Usually some pure code that might use mtl, free monads, etc.
20+createWeatherReport :: WeatherProvider.WeatherData -> WeatherReport
21+createWeatherReport (WeatherProvider.WeatherData temp wind) =
22+  "The current temperature in London is " ++ (show temp)
23+  ++ " and wind speed is " ++ (show wind)
24+
25+-- | Domain logic that uses external dependency to get data and process it.
26+getCurrentWeatherReportInLondon :: Handle -> IO WeatherReport
27+getCurrentWeatherReportInLondon (Handle wph) = do
28+  weatherData <- WeatherProvider.getWeatherData wph "London" "now"
29+  return $ createWeatherReport weatherData

 1@@ -0,0 +1,19 @@
 2+{-# LANGUAGE DataKinds #-}
 3+{-# LANGUAGE OverloadedStrings #-}
 4+{-# LANGUAGE TypeApplications #-}
 5+{-# LANGUAGE TypeOperators #-}
 6+
 7+module WindProvider where
 8+
 9+import Data.Row
10+import HandleRow
11+import QueryTypes
12+
13+type WindSpeed = Int
14+
15+type Methods = "getWindData" .== (Location -> Day -> IO WindSpeed)
16+
17+type Handle = HandleRow Methods
18+
19+getWindData :: Handle -> Location -> Day -> IO WindSpeed
20+getWindData = getMethod @"getWindData"

 1@@ -0,0 +1,12 @@
 2+{-# LANGUAGE OverloadedLabels #-}
 3+module SuperTemperatureProvider where
 4+
 5+import Data.Row
 6+import TemperatureProvider
 7+import QueryTypes
 8+
 9+new :: Handle
10+new = #getTemperatureData .== getSuperTemperatureData
11+
12+getSuperTemperatureData :: Location -> Day -> IO Temperature
13+getSuperTemperatureData _ _ = return 30

 1@@ -0,0 +1,15 @@
 2+{-# LANGUAGE OverloadedLabels #-}
 3+module SuperWeatherProvider where
 4+
 5+import Data.Row
 6+import WeatherProvider
 7+import qualified TemperatureProvider
 8+import qualified WindProvider
 9+import QueryTypes
10+
11+new :: WindProvider.Handle -> TemperatureProvider.Handle -> Handle
12+new wp tp = #getWeatherData .== getSuperWeatherData .+ wp .+ tp
13+
14+-- | This is some concrete implementation `WeatherProvider` interface
15+getSuperWeatherData :: Location -> Day -> IO WeatherData
16+getSuperWeatherData _ _ = return $ WeatherData 30 10

 1@@ -0,0 +1,12 @@
 2+{-# LANGUAGE OverloadedLabels #-}
 3+module SuperWindProvider where
 4+
 5+import Data.Row
 6+import WindProvider
 7+import QueryTypes
 8+
 9+new :: Handle
10+new = #getWindData .== getSuperWindData
11+
12+getSuperWindData :: Location -> Day -> IO WindSpeed
13+getSuperWindData _ _ = return 5

 1@@ -0,0 +1,51 @@
 2+cabal-version:       >=2.0
 3+name:                row-handle
 4+version:             0.1.0.0
 5+license-file:        LICENSE
 6+author:              Evgenii Akentev
 7+maintainer:          i@ak3n.com
 8+build-type:          Simple
 9+extra-source-files:  CHANGELOG.md
10+
11+library domain
12+  hs-source-dirs: domain
13+  exposed-modules: WeatherProvider
14+                 , WeatherReporter
15+                 , WindProvider
16+                 , TemperatureProvider
17+                 , HandleRow
18+                 , QueryTypes
19+  default-language: Haskell2010
20+  build-depends:    base, row-types
21+
22+library impl
23+  hs-source-dirs: impl
24+  exposed-modules: SuperWeatherProvider
25+                 , SuperWindProvider
26+                 , SuperTemperatureProvider
27+  default-language: Haskell2010
28+  build-depends:    base, domain, row-types
29+
30+library test-impl
31+  hs-source-dirs: test-impl
32+  exposed-modules: TestWeatherProvider
33+  default-language: Haskell2010
34+  build-depends:    base, domain, row-types
35+
36+executable main
37+  main-is:             Main.hs
38+  build-depends:       base >=4.13 && <5
39+                     , domain
40+                     , impl
41+  default-language:    Haskell2010
42+
43+test-suite spec
44+  type:             exitcode-stdio-1.0
45+  hs-source-dirs:   test
46+  main-is:          Test.hs
47+  default-language:   Haskell2010
48+  build-depends:       base >= 4.7 && < 5
49+                     , QuickCheck
50+                     , hspec
51+                     , domain
52+                     , test-impl

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

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