From 938c4b887a9e3aabd81f529d340a10d32b52cf26 Mon Sep 17 00:00:00 2001 From: Evgenii Akentev Date: Sat, 9 Jan 2021 16:02:41 +0500 Subject: [PATCH] Add vinyl-handle --- vinyl-handle/LICENSE | 21 +++++++++ vinyl-handle/Main.hs | 14 ++++++ vinyl-handle/Setup.hs | 2 + vinyl-handle/domain/HandleRec.hs | 18 ++++++++ vinyl-handle/domain/WeatherProvider.hs | 16 +++++++ vinyl-handle/domain/WeatherReporter.hs | 30 ++++++++++++ vinyl-handle/impl/SuperWeatherProvider.hs | 12 +++++ vinyl-handle/test-impl/TestWeatherProvider.hs | 17 +++++++ vinyl-handle/test/Test.hs | 24 ++++++++++ vinyl-handle/vinyl-handle.cabal | 46 +++++++++++++++++++ 10 files changed, 200 insertions(+) create mode 100644 vinyl-handle/LICENSE create mode 100644 vinyl-handle/Main.hs create mode 100644 vinyl-handle/Setup.hs create mode 100644 vinyl-handle/domain/HandleRec.hs create mode 100644 vinyl-handle/domain/WeatherProvider.hs create mode 100644 vinyl-handle/domain/WeatherReporter.hs create mode 100644 vinyl-handle/impl/SuperWeatherProvider.hs create mode 100644 vinyl-handle/test-impl/TestWeatherProvider.hs create mode 100644 vinyl-handle/test/Test.hs create mode 100644 vinyl-handle/vinyl-handle.cabal diff --git a/vinyl-handle/LICENSE b/vinyl-handle/LICENSE new file mode 100644 index 0000000..9eea539 --- /dev/null +++ b/vinyl-handle/LICENSE @@ -0,0 +1,21 @@ +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. diff --git a/vinyl-handle/Main.hs b/vinyl-handle/Main.hs new file mode 100644 index 0000000..197df48 --- /dev/null +++ b/vinyl-handle/Main.hs @@ -0,0 +1,14 @@ +module Main where + +import qualified SuperWeatherProvider +import qualified WeatherProvider +import qualified WeatherReporter + +-- | This is an actual application where we use +-- our concrete implementation of `WeatherProvider`. +main :: IO () +main = do + let wph = SuperWeatherProvider.new + let wrh = WeatherReporter.new wph + weatherReportInLondon <- WeatherReporter.getCurrentWeatherReportInLondon wrh + putStrLn weatherReportInLondon diff --git a/vinyl-handle/Setup.hs b/vinyl-handle/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/vinyl-handle/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/vinyl-handle/domain/HandleRec.hs b/vinyl-handle/domain/HandleRec.hs new file mode 100644 index 0000000..88c459c --- /dev/null +++ b/vinyl-handle/domain/HandleRec.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE AllowAmbiguousTypes #-} + +module HandleRec where + +import Data.Vinyl + +type HandleRec rs = Rec ElField rs + +getMethod + :: forall l us v record . (HasField record l us us v v, RecElemFCtx record ElField) + => record ElField us -> v +getMethod = getField . rgetf (Label @l) diff --git a/vinyl-handle/domain/WeatherProvider.hs b/vinyl-handle/domain/WeatherProvider.hs new file mode 100644 index 0000000..b974fca --- /dev/null +++ b/vinyl-handle/domain/WeatherProvider.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} + +module WeatherProvider where + +import HandleRec + +type Temperature = Int +data WeatherData = WeatherData { temperature :: Temperature } + +type Location = String +type Day = String + +type Handle = HandleRec + '[ '("getWeatherData", (Location -> Day -> IO WeatherData)) + ] diff --git a/vinyl-handle/domain/WeatherReporter.hs b/vinyl-handle/domain/WeatherReporter.hs new file mode 100644 index 0000000..343cc91 --- /dev/null +++ b/vinyl-handle/domain/WeatherReporter.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DataKinds #-} + +module WeatherReporter where + +import HandleRec +import Data.Vinyl as V + +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) = + "The current temperature in London is " ++ (show temp) + +-- | Domain logic that uses external dependency to get data and process it. +getCurrentWeatherReportInLondon :: Handle -> IO WeatherReport +getCurrentWeatherReportInLondon (Handle wph) = do + weatherData <- (getMethod @"getWeatherData" wph) "London" "now" + return $ createWeatherReport weatherData diff --git a/vinyl-handle/impl/SuperWeatherProvider.hs b/vinyl-handle/impl/SuperWeatherProvider.hs new file mode 100644 index 0000000..b27871a --- /dev/null +++ b/vinyl-handle/impl/SuperWeatherProvider.hs @@ -0,0 +1,12 @@ +module SuperWeatherProvider where + +import Data.Vinyl +import WeatherProvider + +new :: Handle +new = Field getSuperWeatherData + :& RNil + +-- | This is some concrete implementation `WeatherProvider` interface +getSuperWeatherData :: Location -> Day -> IO WeatherData +getSuperWeatherData _ _ = return $ WeatherData 30 diff --git a/vinyl-handle/test-impl/TestWeatherProvider.hs b/vinyl-handle/test-impl/TestWeatherProvider.hs new file mode 100644 index 0000000..a31879e --- /dev/null +++ b/vinyl-handle/test-impl/TestWeatherProvider.hs @@ -0,0 +1,17 @@ +module TestWeatherProvider where + +import Data.Vinyl +import WeatherProvider + +-- | This is a configuration that allows to setup the provider for tests. +data Config = Config + { initTemperature :: Temperature + } + +new :: Config -> Handle +new config = Field (getTestWeatherData $ initTemperature config) + :& RNil + +-- | This is an implementation `WeatherProvider` interface for tests +getTestWeatherData :: Int -> Location -> Day -> IO WeatherData +getTestWeatherData temp _ _ = return $ WeatherData temp diff --git a/vinyl-handle/test/Test.hs b/vinyl-handle/test/Test.hs new file mode 100644 index 0000000..7466dd4 --- /dev/null +++ b/vinyl-handle/test/Test.hs @@ -0,0 +1,24 @@ +import Test.Hspec + +import qualified TestWeatherProvider +import qualified WeatherProvider +import qualified WeatherReporter + +main :: IO () +main = hspec spec + +weatherWithTemp :: WeatherProvider.Temperature -> WeatherReporter.Handle +weatherWithTemp = WeatherReporter.new + . TestWeatherProvider.new + . TestWeatherProvider.Config + +spec :: Spec +spec = describe "WeatherReporter" $ do + it "weather in London is 0" $ do + weatherReportInLondon <- WeatherReporter.getCurrentWeatherReportInLondon $ + weatherWithTemp 0 + weatherReportInLondon `shouldBe` "The current temperature in London is 0" + it "weather in London is -5" $ do + weatherReportInLondon <- WeatherReporter.getCurrentWeatherReportInLondon $ + weatherWithTemp (-5) + weatherReportInLondon `shouldBe` "The current temperature in London is -5" diff --git a/vinyl-handle/vinyl-handle.cabal b/vinyl-handle/vinyl-handle.cabal new file mode 100644 index 0000000..e007df9 --- /dev/null +++ b/vinyl-handle/vinyl-handle.cabal @@ -0,0 +1,46 @@ +cabal-version: >=2 +name: vinyl-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 + , HandleRec + default-language: Haskell2010 + build-depends: base, vinyl + +library impl + hs-source-dirs: impl + exposed-modules: SuperWeatherProvider + default-language: Haskell2010 + build-depends: base, domain, vinyl + +library test-impl + hs-source-dirs: test-impl + exposed-modules: TestWeatherProvider + default-language: Haskell2010 + build-depends: base, domain, vinyl + +executable main + main-is: Main.hs + build-depends: base >=4.13 && <4.14 + , 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 -- 2.34.1