diff --git a/CHANGELOG.org b/CHANGELOG.org deleted file mode 100644 --- a/CHANGELOG.org +++ /dev/null @@ -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 diff --git a/README.org b/README.org deleted file mode 100644 --- a/README.org +++ /dev/null @@ -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 - - diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/keuringsdienst.cabal b/keuringsdienst.cabal --- a/keuringsdienst.cabal +++ b/keuringsdienst.cabal @@ -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 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 + diff --git a/test/Keuringsdienst/HelpersSpec.hs b/test/Keuringsdienst/HelpersSpec.hs --- a/test/Keuringsdienst/HelpersSpec.hs +++ b/test/Keuringsdienst/HelpersSpec.hs @@ -12,52 +12,56 @@ You should have received a copy of the GNU General Public License along with Keuringsdienst. If not, see . -} -{-# 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 diff --git a/test/KeuringsdienstSpec.hs b/test/KeuringsdienstSpec.hs --- a/test/KeuringsdienstSpec.hs +++ b/test/KeuringsdienstSpec.hs @@ -12,18 +12,33 @@ You should have received a copy of the GNU General Public License along with Keuringsdienst. If not, see . -} -{-# 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 diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -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