repos / handle-examples.hs.git

commit

938c4b8

parent

1831772

author

Evgenii Akentev

date

2021-01-09 15:02:41 +0400 +04

Add vinyl-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,14 @@
 2+module Main where
 3+
 4+import qualified SuperWeatherProvider
 5+import qualified WeatherProvider
 6+import qualified WeatherReporter
 7+
 8+-- | This is an actual application where we use
 9+-- our concrete implementation of `WeatherProvider`.
10+main :: IO ()
11+main = do
12+  let wph = SuperWeatherProvider.new
13+  let wrh = WeatherReporter.new wph
14+  weatherReportInLondon <- WeatherReporter.getCurrentWeatherReportInLondon wrh
15+  putStrLn weatherReportInLondon

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

 1@@ -0,0 +1,18 @@
 2+{-# LANGUAGE TypeApplications #-}
 3+{-# LANGUAGE DataKinds #-}
 4+{-# LANGUAGE RankNTypes #-}
 5+{-# LANGUAGE ScopedTypeVariables #-}
 6+{-# LANGUAGE FlexibleContexts #-}
 7+{-# LANGUAGE GADTs #-}
 8+{-# LANGUAGE AllowAmbiguousTypes #-}
 9+
10+module HandleRec where
11+
12+import Data.Vinyl
13+
14+type HandleRec rs = Rec ElField rs
15+
16+getMethod
17+  :: forall l us v record . (HasField record l us us v v, RecElemFCtx record ElField)
18+  => record ElField us -> v
19+getMethod = getField . rgetf (Label @l)

 1@@ -0,0 +1,16 @@
 2+{-# LANGUAGE DataKinds #-}
 3+{-# LANGUAGE OverloadedStrings #-}
 4+
 5+module WeatherProvider where
 6+
 7+import HandleRec
 8+
 9+type Temperature = Int
10+data WeatherData = WeatherData { temperature :: Temperature }
11+
12+type Location = String
13+type Day = String
14+
15+type Handle = HandleRec
16+  '[ '("getWeatherData", (Location -> Day -> IO WeatherData))
17+  ]

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

 1@@ -0,0 +1,12 @@
 2+module SuperWeatherProvider where
 3+
 4+import Data.Vinyl
 5+import WeatherProvider
 6+
 7+new :: Handle
 8+new = Field getSuperWeatherData
 9+  :& RNil
10+
11+-- | This is some concrete implementation `WeatherProvider` interface
12+getSuperWeatherData :: Location -> Day -> IO WeatherData
13+getSuperWeatherData _ _ = return $ WeatherData 30

 1@@ -0,0 +1,17 @@
 2+module TestWeatherProvider where
 3+
 4+import Data.Vinyl
 5+import WeatherProvider
 6+
 7+-- | This is a configuration that allows to setup the provider for tests.
 8+data Config = Config
 9+  { initTemperature :: Temperature
10+  }
11+
12+new :: Config -> Handle
13+new config = Field (getTestWeatherData $ initTemperature config)
14+  :& RNil
15+
16+-- | This is an implementation `WeatherProvider` interface for tests
17+getTestWeatherData :: Int -> Location -> Day -> IO WeatherData
18+getTestWeatherData temp _ _ = return $ WeatherData temp

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

 1@@ -0,0 +1,46 @@
 2+cabal-version:       >=2
 3+name:                vinyl-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+                 , HandleRec
16+  default-language: Haskell2010
17+  build-depends:    base, vinyl
18+
19+library impl
20+  hs-source-dirs: impl
21+  exposed-modules: SuperWeatherProvider
22+  default-language: Haskell2010
23+  build-depends:    base, domain, vinyl
24+
25+library test-impl
26+  hs-source-dirs: test-impl
27+  exposed-modules: TestWeatherProvider
28+  default-language: Haskell2010
29+  build-depends:    base, domain, vinyl
30+
31+executable main
32+  main-is:             Main.hs
33+  build-depends:       base >=4.13 && <4.14
34+                     , domain
35+                     , impl
36+  default-language:    Haskell2010
37+
38+test-suite spec
39+  type:             exitcode-stdio-1.0
40+  hs-source-dirs:   test
41+  main-is:          Test.hs
42+  default-language:   Haskell2010
43+  build-depends:       base >= 4.7 && < 5
44+                     , QuickCheck
45+                     , hspec
46+                     , domain
47+                     , test-impl