packages feed

keuringsdienst 0.1.1.0 → 1.0.0.5

raw patch · 7 files changed

+121/−225 lines, 7 filesdep +HUnitdep −HTFdep ~aesondep ~basedep ~containerssetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: HUnit

Dependencies removed: HTF

Dependency ranges changed: aeson, base, containers, text

API changes (from Hackage documentation)

Files

− CHANGELOG.org 
@@ -1,8 +0,0 @@-* Changelog for `keuringsdienst`--All notable changes to this project will be documented in this file.--The format is based on Keep a Changelog - https://keepachangelog.com/en/1.0.0/, and this project adheres to the Haskell Package Versioning Policy - https://pvp.haskell.org/.--** v0.1.0.2-- First stable API release
− README.org 
@@ -1,98 +0,0 @@-#+author: Josep Bigorra-#+email: jjbigorra@gmail.com-#+options: toc:nil--* Keuringsdienst (van Waarde)--[[https://git.sr.ht/~teutonicjoe/honeybadger/blob/master/dist/haskell.png]] [[https://git.sr.ht/~teutonicjoe/honeybadger/blob/master/dist/gnu-gpl-v3.png]]--If you know, you know. Data validation in Haskell that is composable, made easy and clean.--Licensed under the GNU General Public License v3 or later.--Data validation rules that are easy to write and serve as documentation of your data as well. Therefore, data validations *SHOULD* live next to your data models.---** Context and motivation--There exist many data validation packages, in Haskell and other languages, but so far I have never found something that was flexible but powerful enough for my needs.--I based myself on ~Semigroup~ and ~Monoid~ operations, and attempted to make validation rules that are easy to write, read, compose and maintain.--See an example, from my music website WikiMusic.--#+begin_src haskell-  validateEntity x =-    (identifier x) |?| isTextOfLength 36-    <> (displayName x) |?| (isNonEmptyText <> isTextSmallerThanOrEqual 120)-#+end_src--Imagine a simple data model (record) for a music artist:--#+begin_src haskell-  data Artist = Artist-  { identifier :: Text,-    displayName :: Text,-    createdBy :: Text,-    visibilityStatus :: Int,-    approvedBy :: Maybe Text,-    createdAt :: UTCTime,-    lastEditedAt :: Maybe UTCTime,-    artworks :: Map Text ArtistArtwork,-    comments :: Map Text ArtistComment,-    opinions :: Map Text ArtistOpinion,-    spotifyUrl :: Maybe Text-  }-  deriving (Eq, Show, Generic)-#+end_src--** Defining validations-      -Of course for all this to work, you need some imports:-#+begin_src haskell-  import Keuringsdienst-  import Keuringsdienst.Helpers-#+end_src--You can define a validation function for ~Artist~ by composing validation results and rules. Validation results are the result of applying rules to certain data and can be composed with ~<>~ since they are ~Monoid~. Rules can also be composed (~AND~) with ~<>~ since they are also ~Monoid~ and can be ~OR~'ed with the ~*||*~ operator, a.k.a ~ofDitOfDat~.--#+begin_src haskell-  validateArtist :: Artist -> ValidationResult-  validateArtist x =-    (identifier x) |?| isTextOfLength 36-      <> (displayName x) |?| (isNonEmptyText <> isTextSmallerThanOrEqual 120)-      <> (createdBy x) |?| isTextOfLength 36-      <> (visibilityStatus x) |?| isPositiveOrZero-      <> (approvedBy x) |??| isTextOfLength 36-      <> (spotifyUrl x) |??| isNonEmptyText-#+end_src--** What is a ValidationResult--#+begin_src haskell-  type ErrMsg = Text--  data Validation err-    = Success-    | Failure err-    deriving (Eq, Show, Generic, FromJSON, ToJSON)--  type ValidationResult = Validation [ErrMsg]-#+end_src--** Optics / Lenses--If you like ~Optics~ and lenses as I do, you are fully free to use it:--#+begin_src haskell-  validateArtist :: Artist -> ValidationResult-  validateArtist x =-    (x ^. #identifier) |?| isTextOfLength 36-      <> (x ^. #displayName) |?| (isNonEmptyText <> isTextSmallerThanOrEqual 120)-      <> (x ^. #createdBy) |?| isTextOfLength 36-      <> (x ^. #visibilityStatus) |?| isPositiveOrZero-      <> (x ^. #approvedBy) |??| isTextOfLength 36-      <> (x ^. #spotifyUrl) |??| isNonEmptyText-#+end_src--
− Setup.hs 
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
keuringsdienst.cabal view
@@ -1,37 +1,20 @@ cabal-version: 1.12---- This file has been generated from package.yaml by hpack version 0.35.2.------ see: https://github.com/sol/hpack--name:           keuringsdienst-version:        0.1.1.0-synopsis:       Data validation in Haskell made easy.-description:    Data validation in Haskell made easy and clean, with user rules that can be combined.-category:       Validation, Data-author:         Josep Jesus Bigorra Algaba-maintainer:     Josep Jesus Bigorra Algaba-license:        GPL-3-license-file:   COPYING+name: keuringsdienst+version: 1.0.0.5+description:    See README at+maintainer:     Josep Bigorra <jjbigorra@gmail.com> build-type:     Simple-extra-source-files:-    README.org-    CHANGELOG.org--source-repository head-  type: git-  location: https://gitlab.com/jjba-projects/keuringsdienst-+license:        GPL-3+license-file: COPYING+                +          library   exposed-modules:-      Keuringsdienst-      Keuringsdienst.Helpers-  other-modules:-      Paths_keuringsdienst+    Keuringsdienst+    Keuringsdienst.Helpers           hs-source-dirs:-      src+    src   default-extensions:-      ImportQualifiedPost       BangPatterns       BinaryLiterals       ConstraintKinds@@ -60,31 +43,31 @@       PatternGuards       PolyKinds       RankNTypes+      RecordWildCards       ScopedTypeVariables       StandaloneDeriving       TupleSections       TypeFamilies       TypeSynonymInstances       ViewPatterns-  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints   build-depends:-      aeson <=2.2.0.0-    , base >=4.5 && <5-    , containers <=0.6.7-    , text <=2.0.2-  default-language: Haskell2010+    base < 5+    , aeson+    , containers+    , text+  default-language: GHC2021 -test-suite keuringsdienst-test+test-suite spec   type: exitcode-stdio-1.0   main-is: Spec.hs   other-modules:-      Keuringsdienst.HelpersSpec-      KeuringsdienstSpec       Paths_keuringsdienst+      KeuringsdienstSpec+      Keuringsdienst.HelpersSpec   hs-source-dirs:       test   default-extensions:-      ImportQualifiedPost       BangPatterns       BinaryLiterals       ConstraintKinds@@ -113,18 +96,20 @@       PatternGuards       PolyKinds       RankNTypes+      RecordWildCards       ScopedTypeVariables       StandaloneDeriving       TupleSections       TypeFamilies       TypeSynonymInstances       ViewPatterns-  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints   build-depends:-      HTF <=0.15.0.1-    , aeson <=2.2.0.0-    , base-    , containers <=0.6.7+      base < 5+    , aeson+    , containers+    , text+    , HUnit     , keuringsdienst-    , text <=2.0.2-  default-language: Haskell2010+  default-language: GHC2021+
test/Keuringsdienst/HelpersSpec.hs view
@@ -12,52 +12,56 @@   You should have received a copy of the GNU General Public License along with Keuringsdienst.   If not, see <https://www.gnu.org/licenses/>. -}-{-# OPTIONS_GHC -F -pgmF htfpp #-} -module Keuringsdienst.HelpersSpec-  ( htf_thisModulesTests,-  )-where+module Keuringsdienst.HelpersSpec where  import Data.Text as T import Keuringsdienst as K import Keuringsdienst.Helpers as KH-import Test.Framework+import Test.HUnit --- λ test helpers+keuringsdienstHelpersSpec :: Test+keuringsdienstHelpersSpec =+  TestList+    [ context "is equal to rule will succeed with text" isEqualToRuleWillSucceedWithText,+      context "is equal to rule will fail with text" isEqualToRuleWillFailWithText,+      context "is not equal to rule will succeed with text" isNotEqualToRuleWillSucceedWithText,+      context "is not equal to rule will fail with text" isNotEqualToRuleWillFailWithText+    ]++context :: String -> Test -> Test+context = TestLabel+ someText :: Text someText = "Keuringsdienst van Waarde" --- λ test cases--- isEqualTo-test_isEqualToRuleWillSucceedWithText :: IO ()-test_isEqualToRuleWillSucceedWithText =-  assertEqual K.Success systemUnderTest+isEqualToRuleWillSucceedWithText :: Test+isEqualToRuleWillSucceedWithText =+  TestCase (assertEqual "" K.Success systemUnderTest)   where     systemUnderTest :: ValidationResult     systemUnderTest = someText |?| isEqualTo someText -test_isEqualToRuleWillFailWithText :: IO ()-test_isEqualToRuleWillFailWithText =+isEqualToRuleWillFailWithText :: Test+isEqualToRuleWillFailWithText =   case systemUnderTest of-    K.Failure _ -> pure ()+    K.Failure _ -> TestCase (assertBool "" True)     K.Success -> error "Expected rule validation to return a failure"   where     systemUnderTest :: ValidationResult     systemUnderTest = T.take 1 someText |?| isEqualTo someText --- isNotEqualTo-test_isNotEqualToRuleWillSucceedWithText :: IO ()-test_isNotEqualToRuleWillSucceedWithText =-  assertEqual K.Success systemUnderTest+isNotEqualToRuleWillSucceedWithText :: Test+isNotEqualToRuleWillSucceedWithText =+  TestCase (assertEqual "" K.Success systemUnderTest)   where     systemUnderTest :: ValidationResult     systemUnderTest = T.take 1 someText |?| isNotEqualTo someText -test_isNotEqualToRuleWillFailWithText :: IO ()-test_isNotEqualToRuleWillFailWithText =+isNotEqualToRuleWillFailWithText :: Test+isNotEqualToRuleWillFailWithText =   case systemUnderTest of-    K.Failure _ -> pure ()+    K.Failure _ -> TestCase (assertBool "" True)     K.Success -> error "Expected rule validation to return a failure"   where     systemUnderTest :: ValidationResult
test/KeuringsdienstSpec.hs view
@@ -12,18 +12,33 @@   You should have received a copy of the GNU General Public License along with Keuringsdienst.   If not, see <https://www.gnu.org/licenses/>. -}-{-# OPTIONS_GHC -F -pgmF htfpp #-} -module KeuringsdienstSpec-  ( htf_thisModulesTests,-  )-where+module KeuringsdienstSpec where  import Data.Text import Keuringsdienst as K-import Test.Framework+import Test.HUnit --- λ test helpers+keuringsdienstSpec :: Test+keuringsdienstSpec =+  TestList+    [ context "validation results can be composed if both success" validationResultsCanBeComposedIfBothSuccess,+      context "validation results can be composed if success failure" validationResultsCanBeComposedIfSuccessFailure,+      context "validation results can be composed if failure success" validationResultsCanBeComposedIfFailureSuccess,+      context "keuren operator applies validation" keurenOperatorAppliesValidation,+      context "non infix keuren operator applies validation" nonInfixKeurenOperatorAppliesValidation,+      context "non infix validate operator applies validation" nonInfixValidateOperatorAppliesValidation,+      context "misschien keuren operator applies validation" misschienKeurenOperatorAppliesValidation,+      context "non infix misschien keuren operator applies validation" nonInfixMisschienKeurenOperatorAppliesValidation,+      context "non infix maybe validate operator applies validation" nonInfixMaybeValidateOperatorAppliesValidation,+      context "misschien keuren operator applies validation on nothing" misschienKeurenOperatorAppliesValidationOnNothing,+      context "non infix misschien keuren operator applies validation on nothing" nonInfixMisschienKeurenOperatorAppliesValidationOnNothing,+      context "non infix maybe validate operator applies validation on nothing" nonInfixMaybeValidateOperatorAppliesValidationOnNothing+    ]++context :: String -> Test -> Test+context = TestLabel+ someErrorMessage :: Text someErrorMessage = "You're simply a test! Better than all the rest!" @@ -33,97 +48,96 @@ alwaysFailureValidationRule :: ValidationRule a alwaysFailureValidationRule = ValidationRule {performValidation = const (K.Failure [someErrorMessage])} --- λ test cases-test_validationResultsCanBeComposedIfBothSuccess :: IO ()-test_validationResultsCanBeComposedIfBothSuccess =-  assertEqual K.Success systemUnderTest+validationResultsCanBeComposedIfBothSuccess :: Test+validationResultsCanBeComposedIfBothSuccess =+  TestCase (assertEqual "" K.Success systemUnderTest)   where     systemUnderTest :: ValidationResult     systemUnderTest = K.Success <> K.Success -test_validationResultsCanBeComposedIfSuccessFailure :: IO ()-test_validationResultsCanBeComposedIfSuccessFailure =-  assertEqual expected systemUnderTest+validationResultsCanBeComposedIfSuccessFailure :: Test+validationResultsCanBeComposedIfSuccessFailure =+  TestCase (assertEqual "" expected systemUnderTest)   where     expected :: ValidationResult     expected = K.Failure [someErrorMessage]     systemUnderTest :: ValidationResult     systemUnderTest = K.Success <> K.Failure [someErrorMessage] -test_validationResultsCanBeComposedIfFailureSuccess :: IO ()-test_validationResultsCanBeComposedIfFailureSuccess =-  assertEqual expected systemUnderTest+validationResultsCanBeComposedIfFailureSuccess :: Test+validationResultsCanBeComposedIfFailureSuccess =+  TestCase (assertEqual "" expected systemUnderTest)   where     expected :: ValidationResult     expected = K.Failure [someErrorMessage]     systemUnderTest :: ValidationResult     systemUnderTest = K.Failure [someErrorMessage] <> K.Success -test_keurenOperatorAppliesValidation :: IO ()-test_keurenOperatorAppliesValidation =-  assertEqual K.Success systemUnderTest+keurenOperatorAppliesValidation :: Test+keurenOperatorAppliesValidation =+  TestCase (assertEqual "" K.Success systemUnderTest)   where     systemUnderTest :: ValidationResult     systemUnderTest = ("" :: Text) |?| alwaysSuccessfulValidationRule -test_nonInfixKeurenOperatorAppliesValidation :: IO ()-test_nonInfixKeurenOperatorAppliesValidation =-  assertEqual K.Success systemUnderTest+nonInfixKeurenOperatorAppliesValidation :: Test+nonInfixKeurenOperatorAppliesValidation =+  TestCase (assertEqual "" K.Success systemUnderTest)   where     systemUnderTest :: ValidationResult     systemUnderTest = keuren ("" :: Text) alwaysSuccessfulValidationRule -test_nonInfixValidateOperatorAppliesValidation :: IO ()-test_nonInfixValidateOperatorAppliesValidation =-  assertEqual K.Success systemUnderTest+nonInfixValidateOperatorAppliesValidation :: Test+nonInfixValidateOperatorAppliesValidation =+  TestCase (assertEqual "" K.Success systemUnderTest)   where     systemUnderTest :: ValidationResult     systemUnderTest = validate ("" :: Text) alwaysSuccessfulValidationRule -test_misschienKeurenOperatorAppliesValidation :: IO ()-test_misschienKeurenOperatorAppliesValidation =-  assertEqual expected systemUnderTest+misschienKeurenOperatorAppliesValidation :: Test+misschienKeurenOperatorAppliesValidation =+  TestCase (assertEqual "" expected systemUnderTest)   where     expected :: ValidationResult     expected = K.Failure [someErrorMessage]     systemUnderTest :: ValidationResult     systemUnderTest = (Just "" :: Maybe Text) |??| alwaysFailureValidationRule -test_nonInfixMisschienKeurenOperatorAppliesValidation :: IO ()-test_nonInfixMisschienKeurenOperatorAppliesValidation =-  assertEqual expected systemUnderTest+nonInfixMisschienKeurenOperatorAppliesValidation :: Test+nonInfixMisschienKeurenOperatorAppliesValidation =+  TestCase (assertEqual "" expected systemUnderTest)   where     expected :: ValidationResult     expected = K.Failure [someErrorMessage]     systemUnderTest :: ValidationResult     systemUnderTest = misschienKeuren (Just "" :: Maybe Text) alwaysFailureValidationRule -test_nonInfixMaybeValidateOperatorAppliesValidation :: IO ()-test_nonInfixMaybeValidateOperatorAppliesValidation =-  assertEqual expected systemUnderTest+nonInfixMaybeValidateOperatorAppliesValidation :: Test+nonInfixMaybeValidateOperatorAppliesValidation =+  TestCase (assertEqual "" expected systemUnderTest)   where     expected :: ValidationResult     expected = K.Failure [someErrorMessage]     systemUnderTest :: ValidationResult     systemUnderTest = maybeValidate (Just "" :: Maybe Text) alwaysFailureValidationRule -test_misschienKeurenOperatorAppliesValidationOnNothing :: IO ()-test_misschienKeurenOperatorAppliesValidationOnNothing =-  assertEqual K.Success systemUnderTest+misschienKeurenOperatorAppliesValidationOnNothing :: Test+misschienKeurenOperatorAppliesValidationOnNothing =+  TestCase (assertEqual "" K.Success systemUnderTest)   where     systemUnderTest :: ValidationResult     systemUnderTest = (Nothing :: Maybe Text) |??| alwaysSuccessfulValidationRule -test_nonInfixMisschienKeurenOperatorAppliesValidationOnNothing :: IO ()-test_nonInfixMisschienKeurenOperatorAppliesValidationOnNothing =-  assertEqual K.Success systemUnderTest+nonInfixMisschienKeurenOperatorAppliesValidationOnNothing :: Test+nonInfixMisschienKeurenOperatorAppliesValidationOnNothing =+  TestCase (assertEqual "" K.Success systemUnderTest)   where     systemUnderTest :: ValidationResult     systemUnderTest = misschienKeuren (Nothing :: Maybe Text) alwaysSuccessfulValidationRule -test_nonInfixMaybeValidateOperatorAppliesValidationOnNothing :: IO ()-test_nonInfixMaybeValidateOperatorAppliesValidationOnNothing =-  assertEqual K.Success systemUnderTest+nonInfixMaybeValidateOperatorAppliesValidationOnNothing :: Test+nonInfixMaybeValidateOperatorAppliesValidationOnNothing =+  TestCase (assertEqual "" K.Success systemUnderTest)   where     systemUnderTest :: ValidationResult     systemUnderTest = maybeValidate (Nothing :: Maybe Text) alwaysSuccessfulValidationRule
test/Spec.hs view
@@ -1,10 +1,11 @@-{-# OPTIONS_GHC -F -pgmF htfpp #-}- module Main (main) where -import {-@ HTF_TESTS @-} Keuringsdienst.HelpersSpec-import {-@ HTF_TESTS @-} KeuringsdienstSpec-import Test.Framework+import Keuringsdienst.HelpersSpec+import KeuringsdienstSpec+import System.Exit qualified as Exit+import Test.HUnit  main :: IO ()-main = htfMain htf_importedTests+main = do+  result <- runTestTT (TestList [keuringsdienstSpec, keuringsdienstHelpersSpec])+  if failures result > 0 then Exit.exitFailure else Exit.exitSuccess