belgian-structured-communication (empty) → 0.1.0.0

raw patch · 8 files changed

+596/−0 lines, 8 filesdep +QuickCheckdep +basedep +belgian-structured-communicationsetup-changed

Dependencies added: QuickCheck, base, belgian-structured-communication, binary, hashable, hspec, parsec, template-haskell, text, validity

Files

• CHANGELOG.md +13/−0
• LICENSE +30/−0
• README.md +36/−0
• Setup.hs +2/−0
• belgian-structured-communication.cabal +68/−0
• src/Finance/Belgium/StructuredCommunication.hs +386/−0
• test/Finance/Belgium/StructuredCommunicationSpec.hs +50/−0
• test/Main.hs +11/−0

@@ -0,0 +1,13 @@+# Changelog for `belgian-structured-communication`++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/).++## Unreleased++## 0.1.0.0 - 2023-06-17++Initial version with parser, instance for `Eq`, `Enum`, `Ord`, `Show`, `Integral` and `Real`.

@@ -0,0 +1,30 @@+Copyright Willem Van Onsem (c) 2023++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 Willem Van Onsem 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,36 @@+# belgian-structured-communication++[![Build Status of the package by GitHub actions](https://github.com/hapytex/belgian-structured-communication/actions/workflows/build-ci.yml/badge.svg)](https://github.com/hapytex/tuple-append/actions/workflows/build-ci.yml)+[![Hackage version badge](https://img.shields.io/hackage/v/belgian-structured-communication.svg)](https://hackage.haskell.org/package/tuple-append)++Belgium introduced a system of structured communication for bank transfers (Dutch: *gestructureerde mededeling (GM)*; French: *Communication structurée (CS)*). The format is three digits, four digits and five digits separated by slashes (`/`), and preceded and succeeded by three plusses (`+`) or asterisks (`*`). The two last digits are a checksum of all the previous digits. An example and the lowest representable structured communication is `+++000/0000/00097+++`.++# Package overview++This package provides a data type `StructuredCommunication` to parse, validate, manipulate and render structured communication. The package aims to prevent constructing invalid structured communication, although it is not impossible when parsing, such that one can later fix the checksum of the parsed communication, or check its validity.++## `StructuredCommunication`++The main aspect of the package is the `StructuredCommunication` which encapsulates two `Word16`s and one `Word32` for the three components of the structured communication. It might however be advisable *not* to use the data constructor, since it can construct `StructuredCommunication` that is simply invalid. It is better to use the `structuredCommunication` which only constructs a `StructuredCommunication` wrapped in a `Just` data constructor, if the given `Integral` parameters are out of range, or the checksum does not match. This is thus more safe.++`StructuredCommunication` is an instance of `Show`, but does *not* render it in the given format, it renders it as how you can use it as a quasiquoter, so - as is often done in Haskell - to use it in code.++One can use `communicationToString :: StructuredCommunication -> String` and `communicationToText :: StructuredCommunication -> Text` to convert it to a `String` or a `Text` which uses three plusses, followed by the three segments separated by a slash and three additional plusses.++One can also parse a `StructuredCommunication` with four parsers: `communicationParser`, `communicationParser'` `communicationEParser`, and `communicationEParser'`. The parsers without a prime perform also validation that the checksum matches. The parsers with an `E` also require that the stream ends. For each parser, there is also a conter-part function such as `parseCommuncation`, `parseCommuncation'`, `parseCommuncationE`, and `parseCommuncationE'` which runs the parser with a stream. These functions either return the `StructuredCommunication` or a `ParseError`.++## Quasiquoter++The package also has a `QuasiQuoter` `beCommuncation` that can be parsed to an expression or a pattern. This thus can be used to use structured communication for example to render it somewhere (on an invoice for example), but also to do pattern matching in a function to check if a certain `StructuredCommunication` matches.++## Checksum++The algorithm of the checksum sees the first ten digits as a whole number and determines the result of that number modulo 97. If that result is zero, the checksum is 97, otherwise it is the result of the modulo operation. So for <code>+++123/4567/890&hellip;&hellip;+++</code>, the number is `1234567890`, the result of the modulo operation is `2`, so that means that the result with checksum is `+++123/4567/89002+++`.++# Structured communication and friends++Belgian bank account numbers also have twelve digits, except that one does not write slashes and plusses or asterisks, but the same checksum algorithm is used. The digits are grouped in three groups of four digits. Therefore the lowest Belgian banking account number is `0000 0000 0097`. In order to convert this to an International Bank Account Number (IBAN), a prefix `BE` is added and two extra checksum digits. The IBAN variant of the lowest Belgian account number is thus `BE54 0000 0000 0097`.++Belgian VAT numbers use ten numbers, often defined in one group of four digits, and two groups of three digits. For transactions related this VAT number, one often adds the checksum to the VAT number to turn it into a structured communication. If the VAT number is thus `0000.000.000`, then the structured communication to pay VAT in advance to the federal government is `+++000/0000/00097+++`. Beware that this is *not* the case for *all* banking transfers regarding the (VAT of) a company.++Some portals, like *Bolero* for example also use the client number as prefix, and then add the checksum to construct structured messages for bank transfers to the corresponding account(s).

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

@@ -0,0 +1,68 @@+name:                belgian-structured-communication+version:             0.1.0.0+synopsis:  parsing, rendering and manipulating the structured communication of Belgian financial transactions.+description:+  A package that exports a 'StructuredCommunication' data type that can render and manipulate structured+  communcation.++  The package also has some parsers to parse structured communcation, and a quasi quoter to define these at compile time.+homepage:            https://github.com/hapytex/belgian-structured-communication#readme+license:             BSD3+license-file:        LICENSE+author:              Willem Van Onsem+maintainer:          hapytexeu+gh@gmail.com+copyright:           2023 HaPyTeΧ+category:            finance+build-type:          Simple+extra-source-files:  README.md+                     CHANGELOG.md+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:+      Finance.Belgium.StructuredCommunication+  build-depends:+      base >= 4.7 && < 5+    , binary >= 0.2+    , hashable >= 1.0+    , parsec >=3.0+    , QuickCheck >=2.1+    , template-haskell >=2.3.0.0+    , text >= 0.1+    , validity >= 0.4.0.0+  default-language:    Haskell2010+  ghc-options:         -Wall+                       -Wcompat+                       -Widentities+                       -Wincomplete-record-updates+                       -Wincomplete-uni-patterns+                       -Wmissing-home-modules+                       -Wredundant-constraints++test-suite             belgian-structured-test+  type:                exitcode-stdio-1.0+  main-is:             Main.hs+  hs-source-dirs:      test+  other-modules:+      Finance.Belgium.StructuredCommunicationSpec+  build-depends:+      base+    , belgian-structured-communication+    , hspec ==2.*+    , parsec >=3.0+    , QuickCheck >=2.1+    , validity >= 0.4.0.0+  build-tool-depends:+      hspec-discover:hspec-discover == 2.*+  default-language:    Haskell2010+  default-extensions:+  ghc-options:       -Wall -Wcompat -Wcompat+                     -Wincomplete-record-updates+                     -Wincomplete-uni-patterns+                     -Wredundant-constraints+++source-repository head+  type:     git+  location: https://github.com/hapytex/belgian-structured-communication

@@ -0,0 +1,386 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskellQuotes #-}++-- |+-- Module      : Finance.Belgium.StructuredCommunication+-- Description : A module to parse, render and manipulate Belgian structured communication for financial transactions.+-- Maintainer  : hapytexeu+gh@gmail.com+-- Stability   : experimental+-- Portability : POSIX+--+-- Belgian companies often make use of /structured communication/ with a checksum. This package aims to provide a toolkit to parse, render and manipulate 'StructuredCommunication'.+module Finance.Belgium.StructuredCommunication+  ( -- * Constructing 'StructuredCommunication'+    StructuredCommunication (StructuredCommunication),+    structuredCommunication,++    -- * determining the checksum+    checksum,+    determineChecksum,+    validChecksum,+    fixChecksum,++    -- * Converting to text+    communicationToString,+    communicationToText,++    -- * Parsing from text+    communicationParser,+    communicationParser',+    communicationEParser,+    communicationEParser',+    parseCommunication,+    parseCommunication',+    parseCommunicationE,+    parseCommunicationE',++    -- * Quasi quotation+    beCommunication,+  )+where++import Control.Applicative ((<|>))+import Control.Monad ((>=>))+#if !MIN_VERSION_base(4,13,0)+import Control.Monad.Fail(MonadFail)+#endif+import Data.Binary (Binary (get, put))+import Data.Char (digitToInt)+import Data.Data (Data)+import Data.Functor.Identity (Identity)+import Data.Hashable (Hashable)+import Data.Int (Int64)+import Data.Text (Text, pack)+import Data.Typeable (Typeable)+#if MIN_VERSION_validity(0,9,0)+import Data.Validity (Validity (validate), check, prettyValidate)+#else+import Data.Validity (Validation(Validation), Validity (validate), check)+#endif+import Data.Word (Word16, Word32)+import GHC.Generics (Generic)+import Language.Haskell.TH.Quote (QuasiQuoter (QuasiQuoter, quoteDec, quoteExp, quotePat, quoteType))+#if MIN_VERSION_template_haskell(2, 17, 0)+import Language.Haskell.TH.Syntax (Code (Code), Exp (AppE, ConE, LitE), Lift (lift, liftTyped), Lit (IntegerL), Pat (ConP, LitP), TExp (TExp))+#elif MIN_VERSION_template_haskell(2, 16, 0)+import Language.Haskell.TH.Syntax (Exp (AppE, ConE, LitE), Lift (lift, liftTyped), Lit (IntegerL), Pat (ConP, LitP), TExp (TExp))+#else+import Language.Haskell.TH.Syntax (Exp (AppE, ConE, LitE), Lift (lift), Lit (IntegerL), Pat (ConP, LitP))+#endif+import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary))+import Test.QuickCheck.Gen (choose)+import Text.Parsec (ParseError)+import Text.Parsec.Char (char, digit, space)+import Text.Parsec.Combinator (eof)+import Text.Parsec.Prim (ParsecT, Stream, runParser, skipMany, try)+import Text.Printf (printf)++-- | A data type that stores three numbers: one with three digits (@000–999@), four digits (@0000–9999@) and five digits (@00001–99997@). The data+-- constructor itself is not accessible, since the `StructuredCommunication` could produce objects that are out of the given ranges, or where the+-- checksum is not valid. The module thus aims to prevent parsing, changing, etc. 'StructuredCommunication' objects into an invalid state.+data StructuredCommunication = StructuredCommunication !Word16 !Word16 !Word32 deriving (Data, Eq, Generic, Ord, Read, Typeable)++_maxVal :: Integral a => a+_maxVal = 9999999999++_numVals :: Integral a => a+_numVals = 10000000000++_fromEnum :: StructuredCommunication -> Int64+_fromEnum (StructuredCommunication v₀ v₁ v₂) = fromIntegral v₀ * 10000000 + fromIntegral v₁ * 1000 + fromIntegral (v₂ `div` 100)++_toEnum :: Int64 -> StructuredCommunication+_toEnum v = fixChecksum (StructuredCommunication (fromIntegral v₀) (fromIntegral v₁) (fromIntegral v₂))+  where+    v₂ = (v `mod` 1000) * 100+    v₁ = (v `div` 1000) `mod` 10000+    v₀ = v `div` 10000000++instance Num StructuredCommunication where+  fromInteger = _toEnum . fromInteger . (`mod` _numVals)+  v1 + v2 = _toEnum ((_fromEnum v1 + _fromEnum v2) `mod` _numVals)+  v1 - v2 = _toEnum ((_fromEnum v1 - _fromEnum v2) `mod` _numVals)+  negate = _toEnum . (`mod` _numVals) . negate . _fromEnum+  abs = id+  signum 0 = 0+  signum _ = 1+  v1' * v2' = _toEnum ((m1 * v2 + (v1 - m1) * m2) `mod` _numVals)+    where+      v1 = _fromEnum v1'+      v2 = _fromEnum v2'+      m1 = v1 `mod` 100000+      m2 = v2 `mod` 100000++_both :: (a -> b) -> (a, a) -> (b, b)+_both f ~(x, y) = (f x, f y)++instance Real StructuredCommunication where+  toRational = toRational . toInteger++instance Integral StructuredCommunication where+  toInteger = toInteger . _fromEnum+  quot x = _toEnum . quot (_fromEnum x) . _fromEnum+  rem x = _toEnum . rem (_fromEnum x) . _fromEnum+  quotRem x = _both _toEnum . quotRem (_fromEnum x) . _fromEnum+  div x = _toEnum . div (_fromEnum x) . _fromEnum+  mod x = _toEnum . mod (_fromEnum x) . _fromEnum+  divMod x = _both _toEnum . quotRem (_fromEnum x) . _fromEnum++instance Show StructuredCommunication where+  show c = "[beCommunication|" ++ communicationToString c ++ "|]"++instance Hashable StructuredCommunication++-- | Determining the /checksum/-part for the given 'StructuredCommunication'. This thus takes the last two digits, or the third number modulo one hundred.+checksum ::+  -- | The 'StructuredCommunication' for which we determine the checkum.+  StructuredCommunication ->+  -- | The last two digits of the 'StructuredCommunication' object. The checksum is /not/ per se valid.+  Word32+checksum (StructuredCommunication _ _ v₂) = v₂ `mod` 100++_rcheck :: Integral i => Integer -> i -> Bool+_rcheck mx = go+  where+    go v = 0 <= i && i <= mx where i = fromIntegral v++-- | Construct a 'StructuredCommunication' object for the given three integral values that form the three sequences of digits.+structuredCommunication ::+  (Integral i, Integral j, Integral k) =>+  -- | The first number, should be between @000@ and @999@.+  i ->+  -- | The second number, should be between @0000@ and @9999@.+  j ->+  -- | The third number, should be between @00001@ and @99997@.+  k ->+  -- | The 'StructuredCommunication' wrapped in a 'Just' of the three numbers are in range, and the checksum matches, otherwise 'Nothing'.+  Maybe StructuredCommunication+structuredCommunication v₀ v₁ v₂+  | _rcheck 999 v₀ && _rcheck 9999 v₁ && _rcheck 99997 v₂ && validChecksum s = Just s+  | otherwise = Nothing+  where+    s = StructuredCommunication (fromIntegral v₀) (fromIntegral v₁) (fromIntegral v₂)++instance Arbitrary StructuredCommunication where+  arbitrary = fixChecksum <$> (StructuredCommunication <$> choose (0, 999) <*> choose (0, 9999) <*> ((100 *) <$> choose (0, 999)))++instance Bounded StructuredCommunication where+  minBound = fixChecksum (StructuredCommunication 0 0 0)+  maxBound = fixChecksum (StructuredCommunication 999 9999 99900)++instance Enum StructuredCommunication where+  fromEnum = fromIntegral . _fromEnum+  toEnum = _toEnum . fromIntegral+  succ = _toEnum . succ . _fromEnum+  pred = _toEnum . pred . _fromEnum+  enumFrom v = map _toEnum [_fromEnum v .. _maxVal]+  enumFromThen v₀ v₁+    | v₀ <= v₁ = map _toEnum [_fromEnum v₀, _fromEnum v₁ .. _maxVal]+    | otherwise = map _toEnum [_fromEnum v₀, _fromEnum v₁ .. 0]+  enumFromTo v₀ v₁ = map _toEnum [_fromEnum v₀ .. _fromEnum v₁]+  enumFromThenTo v₀ v₁ v₂ = map _toEnum [_fromEnum v₀, _fromEnum v₁ .. _fromEnum v₂]++instance Binary StructuredCommunication where+  get = StructuredCommunication <$> get <*> get <*> get+  put (StructuredCommunication v₀ v₁ v₂) = put v₀ >> put v₁ >> put v₂++instance Validity StructuredCommunication where+  validate s@(StructuredCommunication v₀ v₁ v₂) =+    check (v₀ <= 999) "first sequence larger has more than three digits."+      `mappend` check (v₁ <= 9999) "second sequence larger has more than four digits."+      `mappend` check (v₂ <= 99999) "third sequence larger has more than five digits."+      `mappend` check (0 < c && c <= 97) "checksum out of the 1–97 range."+      `mappend` check (determineChecksum s == c) "checksum does not match."+    where+      c = checksum s++-- | Determine the checksum based on the first ten digits. If the 'StructuredCommunication' is not valid, its 'checksum' will /not/ match the result of the 'determineChecksum'.+determineChecksum ::+  -- | The 'StructuredCommunication' to determine the /checksum/ from.+  StructuredCommunication ->+  -- | The checksum determined by the first ten digits, not per se the /real/ checksum of the 'StructuredCommunication'.+  Word32+determineChecksum (StructuredCommunication v₀ v₁ v₂)+  | cs₂ == 0 = 97+  | otherwise = cs₂+  where+    cs₀ = v₀ `mod` 97+    cs₁ = (cs₀ * 9 + v₁) `mod` 97 -- 10000 `mod` 97 ==  9  (shift four decimal places)+    cs₂ = (fromIntegral cs₁ * 30 + v₂ `div` 100) `mod` 97 --  1000 `mod` 97 == 30  (shift three decimal places)++-- | Check if the checksum matches for the given 'StructuredCommunication'.+validChecksum ::+  -- | The 'StructuredCommunication' for which we check the checksum.+  StructuredCommunication ->+  -- | 'True' if the checksum is valid; 'False' otherwise.+  Bool+validChecksum s@(StructuredCommunication _ _ v₂) = determineChecksum s == v₂ `mod` 100++-- | Convert the given 'StructuredCommunication' to one where the checksum is valid. If the checksum was already valid, it returns an equivalent+-- 'StructuredCommunication', this operation is thus /idempotent/.+fixChecksum ::+  -- | The given 'StructuredCommunication' to fix.+  StructuredCommunication ->+  -- | A variant of the given 'StructuredCommunication' where only the last two digits are changed to have a valid checksum.+  StructuredCommunication+fixChecksum s@(StructuredCommunication v₀ v₁ v₂) = StructuredCommunication v₀ v₁ (v₂ - (v₂ `mod` 100) + determineChecksum s)++-- | Convert the given 'StructuredCommunication' to a 'String' that looks like a structured communication, so @+++000\/0000\/00097+++@.+communicationToString ::+  -- | The given 'StructuredCommunication' to convert to a 'String'.+  StructuredCommunication ->+  -- | The corresponding 'String', of the form @+++000\/0000\/00097+++@.+  String+communicationToString (StructuredCommunication v₀ v₁ v₂) = "+++" ++ printf "%03d" v₀ ++ "/" ++ printf "%04d" v₁ ++ "/" ++ printf "%05d" v₂ ++ "+++"++-- | Convert the given 'StructuredCommunication' to a 'Text' that looks like a structured communication, so @+++000\/0000\/00097+++@.+communicationToText ::+  -- | The given 'StructuredCommunication' to convert to a 'Text'.+  StructuredCommunication ->+  -- | The corresponding 'Text', of the form @+++000\/0000\/00097+++@.+  Text+communicationToText = pack . communicationToString++_parseNatWidth :: (Integral i, Stream s m Char) => Int -> ParsecT s u m i+_parseNatWidth m+  | m >= 0 = go m 0+  | otherwise = fail "negative number of digits"+  where+    go 0 v = pure v+    go n v = digit >>= go (n - 1) . ((10 * v) +) . fromIntegral . digitToInt++_char3 :: Stream s m Char => Char -> ParsecT s u m Char+_char3 c = c' <* c' <* c'+  where+    c' = char c++_presuf :: Stream s m Char => ParsecT s u m Char+_presuf = try (_char3 '+') <|> _char3 '*'++_slash :: Stream s m Char => ParsecT s u m Char+_slash = _space *> char '/' <* _space++_space :: Stream s m Char => ParsecT s u m ()+_space = skipMany space++-- | A 'ParsecT' that parses a string into a 'StructuredCommunication', the 'StructuredCommunication' can be invalid. The parser also does /not/ (per se) ends with an 'eof'.+communicationParser' ::+  Stream s m Char =>+  -- | The 'ParsecT' object that parses the structured communication of the form @+++000\/0000\/00097+++@.+  ParsecT s u m StructuredCommunication+communicationParser' = do+  c <- _presuf <* _space+  c1 <- _parseNatWidth 3 <* _slash+  c2 <- _parseNatWidth 4 <* _slash+  c3 <- _parseNatWidth 5+  StructuredCommunication c1 c2 c3 <$ _space <* _char3 c++-- | A 'ParsecT' that parses a string into a 'StructuredCommunication', the 'StructuredCommunication' is checked for its validity (checksum). The parser does /not/ (per se) ends with an 'eof'.+communicationParser ::+  Stream s m Char =>+  -- | The 'ParsecT' object that parses the structured communication of the form @+++000\/0000\/00097+++@.+  ParsecT s u m StructuredCommunication+communicationParser = communicationParser' >>= _liftEither . prettyValidate++-- | A 'ParsecT' that parses a string into a 'StructuredCommunication', the 'StructuredCommunication' can be invalid. The parser also checks if this is the end of the stream.+communicationEParser' ::+  Stream s m Char =>+  -- | The 'ParsecT' object that parses the structured communication of the form @+++000\/0000\/00097+++@.+  ParsecT s u m StructuredCommunication+communicationEParser' = communicationParser <* eof++-- | A 'ParsecT' that parses a string into a 'StructuredCommunication', the 'StructuredCommunication' is checked for its validity (checksum). The parser also checks that this is the end of the stream.+communicationEParser ::+  Stream s m Char =>+  -- | The 'ParsecT' object that parses the structured communication of the form @+++000\/0000\/00097+++@.+  ParsecT s u m StructuredCommunication+communicationEParser = communicationEParser' >>= _liftEither . prettyValidate++-- | Parsing a stream into a 'StructuredCommunication' that also validates the checksum of the communication. The stream does not per se needs to end with structured communcation.+parseCommunication ::+  Stream s Identity Char =>+  -- | The stream that is parsed into a 'StructuredCommunication'+  s ->+  -- | The result of parsing, either a 'StructuredCommunication' wrapped in a 'Right' or a parsing error wrapped in a 'Left'.+  Either ParseError StructuredCommunication+parseCommunication = runParser communicationParser () ""++-- | Parsing a stream into a 'StructuredCommunication' that does /noet/ validate the checksum of the communication. The stream does not per se needs to end with structured communcation.+parseCommunication' ::+  Stream s Identity Char =>+  -- | The stream that is parsed into a 'StructuredCommunication'+  s ->+  -- | The result of parsing, either a 'StructuredCommunication' wrapped in a 'Right' or a parsing error wrapped in a 'Left'.+  Either ParseError StructuredCommunication+parseCommunication' = runParser communicationParser' () ""++-- | Parsing a stream into a 'StructuredCommunication' that also validates the checksum of the communication. After the structured communication, the stream needs to end.+parseCommunicationE ::+  Stream s Identity Char =>+  -- | The stream that is parsed into a 'StructuredCommunication'+  s ->+  -- | The result of parsing, either a 'StructuredCommunication' wrapped in a 'Right' or a parsing error wrapped in a 'Left'.+  Either ParseError StructuredCommunication+parseCommunicationE = runParser communicationEParser () ""++-- | Parsing a stream into a 'StructuredCommunication' that does /noet/ validate the checksum of the communication. After the structured communication, the stream needs to end.+parseCommunicationE' ::+  Stream s Identity Char =>+  -- | The stream that is parsed into a 'StructuredCommunication'+  s ->+  -- | The result of parsing, either a 'StructuredCommunication' wrapped in a 'Right' or a parsing error wrapped in a 'Left'.+  Either ParseError StructuredCommunication+parseCommunicationE' = runParser communicationEParser' () ""++_liftEither :: Show s => MonadFail m => Either s a -> m a+_liftEither = either (fail . show) pure++_toPattern :: StructuredCommunication -> Pat++#if MIN_VERSION_template_haskell(2, 18, 0)+_toPattern (StructuredCommunication v₀ v₁ v₂) = ConP 'StructuredCommunication [] [f (fromIntegral v₀), f (fromIntegral v₁), f (fromIntegral v₂)]+  where+    f = LitP . IntegerL+#else+_toPattern (StructuredCommunication v₀ v₁ v₂) = ConP 'StructuredCommunication [f (fromIntegral v₀), f (fromIntegral v₁), f (fromIntegral v₂)]+  where+    f = LitP . IntegerL+#endif++#if !MIN_VERSION_validity(0,9,0)+prettyValidate :: Validity a => a -> Either String a+prettyValidate a = go (validate a)+  where go (Validation []) = Right a+        go v = Left (show v)+#endif++-- | A 'QuasiQuoter' that can parse a string into an expression or pattern. It will thus convert @+++000\/000\/00097+++@ into a 'StructuredCommunication' as expression or pattern.+beCommunication ::+  -- | A 'QuasiQuoter' to parse to a 'StructuredCommunication'.+  QuasiQuoter+beCommunication =+  QuasiQuoter+    { quoteExp = (_liftEither >=> lift) . runParser communicationEParser () "",+      quotePat = (_liftEither >=> pure . _toPattern) . runParser communicationEParser () "",+      quoteType = const (fail "can not produce a type with this QuasiQuoter"),+      quoteDec = const (fail "can not produce a declaration with this QuasiQuoter")+    }++instance Lift StructuredCommunication where+  lift (StructuredCommunication v₀ v₁ v₂) = pure (ConE 'StructuredCommunication `AppE` f (fromIntegral v₀) `AppE` f (fromIntegral v₁) `AppE` f (fromIntegral v₂))+    where+      f = LitE . IntegerL++#if MIN_VERSION_template_haskell(2, 17, 0)+  liftTyped (StructuredCommunication v₀ v₁ v₂) = Code (pure (TExp (ConE 'StructuredCommunication `AppE` f (fromIntegral v₀) `AppE` f (fromIntegral v₁) `AppE` f (fromIntegral v₂))))+    where+      f = LitE . IntegerL+#elif MIN_VERSION_template_haskell(2, 16, 0)+  liftTyped (StructuredCommunication v₀ v₁ v₂) = pure (TExp (ConE 'StructuredCommunication `AppE` f (fromIntegral v₀) `AppE` f (fromIntegral v₁) `AppE` f (fromIntegral v₂)))+    where+      f = LitE . IntegerL+#endif

@@ -0,0 +1,50 @@+{-# LANGUAGE QuasiQuotes #-}++module Finance.Belgium.StructuredCommunicationSpec where++import Data.Validity(isValid)++import Finance.Belgium.StructuredCommunication(StructuredCommunication, beCommunication, communicationToString, parseCommunication')++import Test.Hspec(Spec, it)+import Test.QuickCheck(maxSuccess, property, quickCheckWith, stdArgs)++import Text.Parsec.Prim (runParser)++_testEq :: (Integer -> Integer) -> (StructuredCommunication -> StructuredCommunication) -> Integer -> Bool+_testEq f g x' = fromInteger (f x) == g (fromInteger x)+  where x = abs x'++_testEq2 :: (Integer -> Integer -> Integer) -> (StructuredCommunication -> StructuredCommunication -> StructuredCommunication) -> Integer -> Integer -> Bool+_testEq2 f g x' y' = fromInteger (f y x) == g (fromInteger y) (fromInteger x)+  where x = abs x'+        y = abs y'++_testEq2Inc :: (Integer -> Integer -> Integer) -> (StructuredCommunication -> StructuredCommunication -> StructuredCommunication) -> Integer -> Integer -> Bool+_testEq2Inc f g = _testEq2 f g . (1+) . abs++spec :: Spec+spec = do+  it "all random StructuredCommunications are valid" (property (isValid :: StructuredCommunication -> Bool))+  it "all succ's of a random StructuredCommunications are valid" (quickCheckWith stdArgs { maxSuccess = 1000000 } (property (isValid . succ :: StructuredCommunication -> Bool)))+  it "all pred's of a random StructuredCommunications are valid" (property (isValid . pred :: StructuredCommunication -> Bool))+  it "quasi quotation is valid" (isValid [beCommunication|+++000/0000/00097+++|])+  it "abs" (property (_testEq abs abs))+  it "negate" (property (_testEq negate negate))+  it "signum" (property (_testEq signum signum))+  it "(+)" (property (_testEq2 (+) (+)))+  it "(-)" (property (_testEq2 (-) (-)))+  it "(*)" (property (_testEq2 (*) (*)))+  it "quot" (property (_testEq2Inc quot quot))+  it "rem" (property (_testEq2Inc rem rem))+  it "div" (property (_testEq2Inc div div))+  it "mod" (property (_testEq2Inc mod mod))+  -- it "all are valid in an arbitrary range" (property (\x1 -> all isValid . enumFromTo x1 :: StructuredCommunication -> Bool))+  it "all StructuredCommunications can be parsed back" (property (\x -> parseCommunication' (communicationToString x) == Right x))++patternMatch :: StructuredCommunication -> Bool+-- patternMatch [beCommunication|+++999/9999/99901+++|] = True -- raises a compile error, expected behavior+patternMatch [beCommunication|+++999/9999/99948+++|] = True+patternMatch [beCommunication|*** 000 / 0000 / 00101 ***|] = True+-- patternMatch [beCommunication|*** 000 / 0000 / 00101 +++|] = True  -- raises a compile error, expected behavior+patternMatch _ = False

@@ -0,0 +1,11 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+-- cabal v2-test --test-show-details=direct+-- cabal v2-test --test-show-details=direct --test-options="--color --format=progress"++module Main++-- main :: IO ExitCode+-- main = runAllLiquid++-- runAllLiquid :: IO ExitCode+-- runAllLiquid = mconcat <$> mapM runLiquid orderedSrcFiles