it-has (empty) → 0.1.0.0

raw patch · 7 files changed

+355/−0 lines, 7 filesdep +QuickCheckdep +basedep +generic-lenssetup-changed

Dependencies added: QuickCheck, base, generic-lens, it-has

Files

• ChangeLog.md +3/−0
• LICENSE +30/−0
• README.md +76/−0
• Setup.hs +2/−0
• it-has.cabal +55/−0
• src/Data/Has.hs +108/−0
• test/Spec.hs +81/−0

@@ -0,0 +1,3 @@+# Changelog for it-has++## Unreleased changes

@@ -0,0 +1,30 @@+Copyright Dobromir Nikolov (c) 2020++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Dobromir Nikolov nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,76 @@+![Haskell CI](https://github.com/dnikolovv/it-has/workflows/Haskell%20CI/badge.svg)++# it-has++This is a (nearly) drop-in replacement of [data-has](http://hackage.haskell.org/package/data-has). The differences with the original package are that this one misses `hasLens` and uses `Generic` for its default implementation. Your initial reaction may be to start mourning the loss of `hasLens`, but first take a look at the cool things you can do without it!++Reduce boilerplate! You can trim down this:++```haskell+data Config =+  Config+    { configLogEnv      :: !LogEnv+    , configJwtSettings :: !JWTSettings+    , configMetrics     :: !Metrics+    , configEkgStore    :: !EKG.Store }++-- Heavy manual instances, data-has only has default implementation for tuples+instance Has LogEnv Config where+  getter = configLogEnv+  modifier f v = v { configLogEnv = f (configLogEnv v) }++instance Has JWTSettings Config where+  getter = configJwtSettings+  modifier f v = v { configJwtSettings = f (configJwtSettings v) }++instance Has Metrics Config where+  getter = configMetrics+  modifier f v = v { configMetrics = f (configMetrics v) }++instance Has EKG.Store Config where+  getter = configEkgStore+  modifier f v = v { configEkgStore = f (configEkgStore v) }+```++To this:++```haskell+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric  #-}++data Config =+  Config+    { configLogEnv      :: !LogEnv+    , configJwtSettings :: !JWTSettings+    , configMetrics     :: !Metrics+    , configEkgStore    :: !EKG.Store+    } deriving (Generic, Has LogEnv, Has JWTSettings, Has Metrics, Has EKG.Store)+```++Another trick is that you can "force" a sum type to have a specific field defined.++E.g. you may want to define an `Error` type and enforce that it always has an `ErrorText` attached to it.++```haskell+newtype ErrorText =+ ErrorText Text+ +data Error =+ ValidationError |+ NotFound |+ Critical |+ Unauthorized+```++You can do that by deriving `Has ErrorText`. The compiler will error until you have added an `ErrorText` field to each representation.++```haskell+data Error =+ ValidationError ErrorText |+ NotFound ErrorText |+ Critical ErrorText |+ Unauthorized ErrorText+ deriving (Generic, Has ErrorText)+```++For more documentation and examples, please refer to the [original package](http://hackage.haskell.org/package/data-has).

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

@@ -0,0 +1,55 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: bfe8f0c0584b30d3e56a036f44845a917b11b45b35dc75b6133a965887d5b41b++name:           it-has+version:        0.1.0.0+synopsis:       Automatically derivable Has instances.+description:    Please see the README on GitHub at <https://github.com/dnikolovv/it-has#readme>+category:       Data+homepage:       https://github.com/dnikolovv/it-has#readme+bug-reports:    https://github.com/dnikolovv/it-has/issues+author:         Dobromir Nikolov+maintainer:     dnikolovv@hotmail.com+copyright:      Dobromir Nikolov+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/dnikolovv/it-has++library+  exposed-modules:+      Data.Has+  other-modules:+      Paths_it_has+  hs-source-dirs:+      src+  build-depends:+      base >=4.7 && <5+    , generic-lens >=1.2.0 && <1.3+  default-language: Haskell2010++test-suite it-has-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_it_has+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      QuickCheck+    , base >=4.7 && <5+    , generic-lens >=1.2.0 && <1.3+    , it-has+  default-language: Haskell2010

@@ -0,0 +1,108 @@+{-# LANGUAGE DefaultSignatures     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes            #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeApplications      #-}+{-# LANGUAGE FlexibleInstances     #-}++{-|+Module      : Data.Has+Description : Automatically derivable Has instances.+Copyright   : (c) Dobromir Nikolov, 2020+License     : BSD3+Maintainer  : dnikolovv@hotmail.com+Stability   : experimental+Portability : PORTABLE++This is a (nearly) drop-in replacement of [data-has](http://hackage.haskell.org/package/data-has). The differences with the original package are that this one misses `hasLens` and uses `Generic` for its default implementation. Your initial reaction may be to start mourning the loss of `hasLens`, but first take a look at the cool things you can do without it!++Reduce boilerplate! You can trim down this:++@+data Config =+  Config+    { configLogEnv      :: !LogEnv+    , configJwtSettings :: !JWTSettings+    , configMetrics     :: !Metrics+    , configEkgStore    :: !EKG.Store }++-- Heavy manual instances, data-has only has default implementation for tuples+instance Has LogEnv Config where+  getter = configLogEnv+  modifier f v = v { configLogEnv = f (configLogEnv v) }++instance Has JWTSettings Config where+  getter = configJwtSettings+  modifier f v = v { configJwtSettings = f (configJwtSettings v) }++instance Has Metrics Config where+  getter = configMetrics+  modifier f v = v { configMetrics = f (configMetrics v) }++instance Has EKG.Store Config where+  getter = configEkgStore+  modifier f v = v { configEkgStore = f (configEkgStore v) }+@++To this:++@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric  #-}++data Config =+  Config+    { configLogEnv      :: !LogEnv+    , configJwtSettings :: !JWTSettings+    , configMetrics     :: !Metrics+    , configEkgStore    :: !EKG.Store+    } deriving (Generic, Has LogEnv, Has JWTSettings, Has Metrics, Has EKG.Store)+@++Another trick is that you can "force" a sum type to have a specific field defined.++E.g. you may want to define an `Error` type and enforce that it always has an `ErrorText` attached to it.++@+newtype ErrorText =+ ErrorText Text++data Error =+ ValidationError |+ NotFound |+ Critical |+ Unauthorized+@++You can do that by deriving `Has ErrorText`. The compiler will error until you have added an `ErrorText` field to each representation.++@+data Error =+ ValidationError ErrorText |+ NotFound ErrorText |+ Critical ErrorText |+ Unauthorized ErrorText+ deriving (Generic, Has ErrorText)+@++For more documentation and examples, please refer to the [original package](http://hackage.haskell.org/package/data-has).+-}+module Data.Has where++import           Data.Generics.Internal.VL.Lens (over)+import           Data.Generics.Product.Typed++-- | A type class for an extensible product.+class Has a b where+  getter :: b -> a+  modifier :: (a -> a) -> b -> b++  default getter :: HasType a b => b -> a+  getter = getTyped @a++  default modifier :: HasType a b => (a -> a) -> b -> b+  modifier = over $ typed @a++instance Has a a where+  getter = id+  modifier = id

@@ -0,0 +1,81 @@+{-# LANGUAGE DeriveAnyClass     #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DerivingVia        #-}+{-# LANGUAGE TemplateHaskell    #-}++import           Control.Monad (void)+import           Data.Has+import           GHC.Generics    (Generic)+import           Test.QuickCheck (Arbitrary, quickCheckAll)++newtype LogConfig =+  LogConfig String+  deriving (Show, Eq)+  deriving (Arbitrary) via (String)++newtype SomeUrl =+  SomeUrl String+  deriving (Show, Eq)+  deriving (Arbitrary) via (String)++newtype ConnectionString =+  ConnectionString String+  deriving (Show, Eq)+  deriving (Arbitrary) via (String)++newtype DatabaseConfig =+  DatabaseConfig String+  deriving (Show, Eq)+  deriving (Arbitrary) via (String)++data SomeConfig =+  SomeConfig+    { someConfigLogConfig      :: LogConfig+    , someConfigDatabaseConfig :: DatabaseConfig+    , someConfigSomeUrl        :: SomeUrl+    } deriving+      ( Eq+      , Generic+      , Has LogConfig+      , Has DatabaseConfig+      , Has SomeUrl )++newtype ErrorText =+  ErrorText String+  deriving (Show, Eq)+  deriving (Arbitrary) via (String)++data Error =+  ValidationError ErrorText |+  Unauthorized ErrorText+  deriving (Generic, Has ErrorText)++prop_returnsSetValuesForRecord :: LogConfig -> DatabaseConfig -> SomeUrl -> Bool+prop_returnsSetValuesForRecord logConfig dbConfig someUrl =+  let config = SomeConfig logConfig dbConfig someUrl+  in getter config == logConfig &&+     getter config == dbConfig &&+     getter config == someUrl++prop_setsCorrectValues :: (LogConfig, DatabaseConfig, SomeUrl) -> (LogConfig, DatabaseConfig, SomeUrl) -> Bool+prop_setsCorrectValues (logConfig, dbConfig, someUrl) (newLogConfig, newDbConfig, newSomeUrl) =+  let config = SomeConfig logConfig dbConfig someUrl+      expectedConfig = SomeConfig newLogConfig newDbConfig newSomeUrl+      updatedConfig = modifier (const newLogConfig) . modifier (const newDbConfig) . modifier (const newSomeUrl) $ config+  in updatedConfig == expectedConfig++prop_returnsForcedFieldsForSumType :: ErrorText -> ErrorText -> Bool+prop_returnsForcedFieldsForSumType firstErrorText secondErrorText =+  let firstError = ValidationError firstErrorText+      secondError = Unauthorized secondErrorText+  in getter firstError == firstErrorText &&+     getter secondError == secondErrorText++return []++main :: IO ()+main = void runTests++runTests :: IO Bool+runTests = $quickCheckAll