{-# 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 (Typeable StructuredCommunication
StructuredCommunication -> DataType
StructuredCommunication -> Constr
(forall b. Data b => b -> b)
-> StructuredCommunication -> StructuredCommunication
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> StructuredCommunication -> u
forall u.
(forall d. Data d => d -> u) -> StructuredCommunication -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> StructuredCommunication
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> StructuredCommunication
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> StructuredCommunication -> m StructuredCommunication
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StructuredCommunication -> m StructuredCommunication
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StructuredCommunication
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> StructuredCommunication
-> c StructuredCommunication
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StructuredCommunication)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StructuredCommunication)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StructuredCommunication -> m StructuredCommunication
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StructuredCommunication -> m StructuredCommunication
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StructuredCommunication -> m StructuredCommunication
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StructuredCommunication -> m StructuredCommunication
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> StructuredCommunication -> m StructuredCommunication
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> StructuredCommunication -> m StructuredCommunication
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> StructuredCommunication -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> StructuredCommunication -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> StructuredCommunication -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> StructuredCommunication -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> StructuredCommunication
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> StructuredCommunication
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> StructuredCommunication
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> StructuredCommunication
-> r
gmapT :: (forall b. Data b => b -> b)
-> StructuredCommunication -> StructuredCommunication
$cgmapT :: (forall b. Data b => b -> b)
-> StructuredCommunication -> StructuredCommunication
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StructuredCommunication)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StructuredCommunication)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StructuredCommunication)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StructuredCommunication)
dataTypeOf :: StructuredCommunication -> DataType
$cdataTypeOf :: StructuredCommunication -> DataType
toConstr :: StructuredCommunication -> Constr
$ctoConstr :: StructuredCommunication -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StructuredCommunication
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StructuredCommunication
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> StructuredCommunication
-> c StructuredCommunication
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> StructuredCommunication
-> c StructuredCommunication
Data, StructuredCommunication -> StructuredCommunication -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StructuredCommunication -> StructuredCommunication -> Bool
$c/= :: StructuredCommunication -> StructuredCommunication -> Bool
== :: StructuredCommunication -> StructuredCommunication -> Bool
$c== :: StructuredCommunication -> StructuredCommunication -> Bool
Eq, forall x. Rep StructuredCommunication x -> StructuredCommunication
forall x. StructuredCommunication -> Rep StructuredCommunication x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StructuredCommunication x -> StructuredCommunication
$cfrom :: forall x. StructuredCommunication -> Rep StructuredCommunication x
Generic, Eq StructuredCommunication
StructuredCommunication -> StructuredCommunication -> Bool
StructuredCommunication -> StructuredCommunication -> Ordering
StructuredCommunication
-> StructuredCommunication -> StructuredCommunication
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StructuredCommunication
-> StructuredCommunication -> StructuredCommunication
$cmin :: StructuredCommunication
-> StructuredCommunication -> StructuredCommunication
max :: StructuredCommunication
-> StructuredCommunication -> StructuredCommunication
$cmax :: StructuredCommunication
-> StructuredCommunication -> StructuredCommunication
>= :: StructuredCommunication -> StructuredCommunication -> Bool
$c>= :: StructuredCommunication -> StructuredCommunication -> Bool
> :: StructuredCommunication -> StructuredCommunication -> Bool
$c> :: StructuredCommunication -> StructuredCommunication -> Bool
<= :: StructuredCommunication -> StructuredCommunication -> Bool
$c<= :: StructuredCommunication -> StructuredCommunication -> Bool
< :: StructuredCommunication -> StructuredCommunication -> Bool
$c< :: StructuredCommunication -> StructuredCommunication -> Bool
compare :: StructuredCommunication -> StructuredCommunication -> Ordering
$ccompare :: StructuredCommunication -> StructuredCommunication -> Ordering
Ord, ReadPrec [StructuredCommunication]
ReadPrec StructuredCommunication
Int -> ReadS StructuredCommunication
ReadS [StructuredCommunication]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StructuredCommunication]
$creadListPrec :: ReadPrec [StructuredCommunication]
readPrec :: ReadPrec StructuredCommunication
$creadPrec :: ReadPrec StructuredCommunication
readList :: ReadS [StructuredCommunication]
$creadList :: ReadS [StructuredCommunication]
readsPrec :: Int -> ReadS StructuredCommunication
$creadsPrec :: Int -> ReadS StructuredCommunication
Read, Typeable)

_maxVal :: Integral a => a
_maxVal :: forall a. Integral a => a
_maxVal = a
9999999999

_numVals :: Integral a => a
_numVals :: forall a. Integral a => a
_numVals = a
10000000000

_fromEnum :: StructuredCommunication -> Int64
_fromEnum :: StructuredCommunication -> Int64
_fromEnum (StructuredCommunication Word16
v₀ Word16
v₁ Word32
v₂) = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
v₀ forall a. Num a => a -> a -> a
* Int64
10000000 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
v₁ forall a. Num a => a -> a -> a
* Int64
1000 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
v₂ forall a. Integral a => a -> a -> a
`div` Word32
100)

_toEnum :: Int64 -> StructuredCommunication
_toEnum :: Int64 -> StructuredCommunication
_toEnum Int64
v = StructuredCommunication -> StructuredCommunication
fixChecksum (Word16 -> Word16 -> Word32 -> StructuredCommunication
StructuredCommunication (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
v₀) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
v₁) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
v₂))
  where
    v₂ :: Int64
v₂ = (Int64
v forall a. Integral a => a -> a -> a
`mod` Int64
1000) forall a. Num a => a -> a -> a
* Int64
100
    v₁ :: Int64
v₁ = (Int64
v forall a. Integral a => a -> a -> a
`div` Int64
1000) forall a. Integral a => a -> a -> a
`mod` Int64
10000
    v₀ :: Int64
v₀ = Int64
v forall a. Integral a => a -> a -> a
`div` Int64
10000000

instance Num StructuredCommunication where
  fromInteger :: Integer -> StructuredCommunication
fromInteger = Int64 -> StructuredCommunication
_toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Integral a => a -> a -> a
`mod` forall a. Integral a => a
_numVals)
  StructuredCommunication
v1 + :: StructuredCommunication
-> StructuredCommunication -> StructuredCommunication
+ StructuredCommunication
v2 = Int64 -> StructuredCommunication
_toEnum ((StructuredCommunication -> Int64
_fromEnum StructuredCommunication
v1 forall a. Num a => a -> a -> a
+ StructuredCommunication -> Int64
_fromEnum StructuredCommunication
v2) forall a. Integral a => a -> a -> a
`mod` forall a. Integral a => a
_numVals)
  StructuredCommunication
v1 - :: StructuredCommunication
-> StructuredCommunication -> StructuredCommunication
- StructuredCommunication
v2 = Int64 -> StructuredCommunication
_toEnum ((StructuredCommunication -> Int64
_fromEnum StructuredCommunication
v1 forall a. Num a => a -> a -> a
- StructuredCommunication -> Int64
_fromEnum StructuredCommunication
v2) forall a. Integral a => a -> a -> a
`mod` forall a. Integral a => a
_numVals)
  negate :: StructuredCommunication -> StructuredCommunication
negate = Int64 -> StructuredCommunication
_toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Integral a => a -> a -> a
`mod` forall a. Integral a => a
_numVals) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a
negate forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredCommunication -> Int64
_fromEnum
  abs :: StructuredCommunication -> StructuredCommunication
abs = forall a. a -> a
id
  signum :: StructuredCommunication -> StructuredCommunication
signum StructuredCommunication
0 = StructuredCommunication
0
  signum StructuredCommunication
_ = StructuredCommunication
1
  StructuredCommunication
v1' * :: StructuredCommunication
-> StructuredCommunication -> StructuredCommunication
* StructuredCommunication
v2' = Int64 -> StructuredCommunication
_toEnum ((Int64
m1 forall a. Num a => a -> a -> a
* Int64
v2 forall a. Num a => a -> a -> a
+ (Int64
v1 forall a. Num a => a -> a -> a
- Int64
m1) forall a. Num a => a -> a -> a
* Int64
m2) forall a. Integral a => a -> a -> a
`mod` forall a. Integral a => a
_numVals)
    where
      v1 :: Int64
v1 = StructuredCommunication -> Int64
_fromEnum StructuredCommunication
v1'
      v2 :: Int64
v2 = StructuredCommunication -> Int64
_fromEnum StructuredCommunication
v2'
      m1 :: Int64
m1 = Int64
v1 forall a. Integral a => a -> a -> a
`mod` Int64
100000
      m2 :: Int64
m2 = Int64
v2 forall a. Integral a => a -> a -> a
`mod` Int64
100000

_both :: (a -> b) -> (a, a) -> (b, b)
_both :: forall a b. (a -> b) -> (a, a) -> (b, b)
_both a -> b
f ~(a
x, a
y) = (a -> b
f a
x, a -> b
f a
y)

instance Real StructuredCommunication where
  toRational :: StructuredCommunication -> Rational
toRational = forall a. Real a => a -> Rational
toRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger

instance Integral StructuredCommunication where
  toInteger :: StructuredCommunication -> Integer
toInteger = forall a. Integral a => a -> Integer
toInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredCommunication -> Int64
_fromEnum
  quot :: StructuredCommunication
-> StructuredCommunication -> StructuredCommunication
quot StructuredCommunication
x = Int64 -> StructuredCommunication
_toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> a -> a
quot (StructuredCommunication -> Int64
_fromEnum StructuredCommunication
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredCommunication -> Int64
_fromEnum
  rem :: StructuredCommunication
-> StructuredCommunication -> StructuredCommunication
rem StructuredCommunication
x = Int64 -> StructuredCommunication
_toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> a -> a
rem (StructuredCommunication -> Int64
_fromEnum StructuredCommunication
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredCommunication -> Int64
_fromEnum
  quotRem :: StructuredCommunication
-> StructuredCommunication
-> (StructuredCommunication, StructuredCommunication)
quotRem StructuredCommunication
x = forall a b. (a -> b) -> (a, a) -> (b, b)
_both Int64 -> StructuredCommunication
_toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> a -> (a, a)
quotRem (StructuredCommunication -> Int64
_fromEnum StructuredCommunication
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredCommunication -> Int64
_fromEnum
  div :: StructuredCommunication
-> StructuredCommunication -> StructuredCommunication
div StructuredCommunication
x = Int64 -> StructuredCommunication
_toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> a -> a
div (StructuredCommunication -> Int64
_fromEnum StructuredCommunication
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredCommunication -> Int64
_fromEnum
  mod :: StructuredCommunication
-> StructuredCommunication -> StructuredCommunication
mod StructuredCommunication
x = Int64 -> StructuredCommunication
_toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> a -> a
mod (StructuredCommunication -> Int64
_fromEnum StructuredCommunication
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredCommunication -> Int64
_fromEnum
  divMod :: StructuredCommunication
-> StructuredCommunication
-> (StructuredCommunication, StructuredCommunication)
divMod StructuredCommunication
x = forall a b. (a -> b) -> (a, a) -> (b, b)
_both Int64 -> StructuredCommunication
_toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> a -> (a, a)
quotRem (StructuredCommunication -> Int64
_fromEnum StructuredCommunication
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredCommunication -> Int64
_fromEnum

instance Show StructuredCommunication where
  show :: StructuredCommunication -> String
show StructuredCommunication
c = String
"[beCommunication|" forall a. [a] -> [a] -> [a]
++ StructuredCommunication -> String
communicationToString StructuredCommunication
c forall a. [a] -> [a] -> [a]
++ String
"|]"

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 -> Word32
checksum (StructuredCommunication Word16
_ Word16
_ Word32
v₂) = Word32
v₂ forall a. Integral a => a -> a -> a
`mod` Word32
100

_rcheck :: Integral i => Integer -> i -> Bool
_rcheck :: forall i. Integral i => Integer -> i -> Bool
_rcheck Integer
mx = forall {p}. Integral p => p -> Bool
go
  where
    go :: p -> Bool
go p
v = Integer
0 forall a. Ord a => a -> a -> Bool
<= Integer
i Bool -> Bool -> Bool
&& Integer
i forall a. Ord a => a -> a -> Bool
<= Integer
mx where i :: Integer
i = forall a b. (Integral a, Num b) => a -> b
fromIntegral p
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 :: forall i j k.
(Integral i, Integral j, Integral k) =>
i -> j -> k -> Maybe StructuredCommunication
structuredCommunication i
v₀ j
v₁ k
v₂
  | forall i. Integral i => Integer -> i -> Bool
_rcheck Integer
999 i
v₀ Bool -> Bool -> Bool
&& forall i. Integral i => Integer -> i -> Bool
_rcheck Integer
9999 j
v₁ Bool -> Bool -> Bool
&& forall i. Integral i => Integer -> i -> Bool
_rcheck Integer
99997 k
v₂ Bool -> Bool -> Bool
&& StructuredCommunication -> Bool
validChecksum StructuredCommunication
s = forall a. a -> Maybe a
Just StructuredCommunication
s
  | Bool
otherwise = forall a. Maybe a
Nothing
  where
    s :: StructuredCommunication
s = Word16 -> Word16 -> Word32 -> StructuredCommunication
StructuredCommunication (forall a b. (Integral a, Num b) => a -> b
fromIntegral i
v₀) (forall a b. (Integral a, Num b) => a -> b
fromIntegral j
v₁) (forall a b. (Integral a, Num b) => a -> b
fromIntegral k
v₂)

instance Arbitrary StructuredCommunication where
  arbitrary :: Gen StructuredCommunication
arbitrary = StructuredCommunication -> StructuredCommunication
fixChecksum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word16 -> Word16 -> Word32 -> StructuredCommunication
StructuredCommunication forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Random a => (a, a) -> Gen a
choose (Word16
0, Word16
999) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Random a => (a, a) -> Gen a
choose (Word16
0, Word16
9999) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Word32
100 forall a. Num a => a -> a -> a
*) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Random a => (a, a) -> Gen a
choose (Word32
0, Word32
999)))

instance Bounded StructuredCommunication where
  minBound :: StructuredCommunication
minBound = StructuredCommunication -> StructuredCommunication
fixChecksum (Word16 -> Word16 -> Word32 -> StructuredCommunication
StructuredCommunication Word16
0 Word16
0 Word32
0)
  maxBound :: StructuredCommunication
maxBound = StructuredCommunication -> StructuredCommunication
fixChecksum (Word16 -> Word16 -> Word32 -> StructuredCommunication
StructuredCommunication Word16
999 Word16
9999 Word32
99900)

instance Enum StructuredCommunication where
  fromEnum :: StructuredCommunication -> Int
fromEnum = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredCommunication -> Int64
_fromEnum
  toEnum :: Int -> StructuredCommunication
toEnum = Int64 -> StructuredCommunication
_toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
  succ :: StructuredCommunication -> StructuredCommunication
succ = Int64 -> StructuredCommunication
_toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> a
succ forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredCommunication -> Int64
_fromEnum
  pred :: StructuredCommunication -> StructuredCommunication
pred = Int64 -> StructuredCommunication
_toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> a
pred forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredCommunication -> Int64
_fromEnum
  enumFrom :: StructuredCommunication -> [StructuredCommunication]
enumFrom StructuredCommunication
v = forall a b. (a -> b) -> [a] -> [b]
map Int64 -> StructuredCommunication
_toEnum [StructuredCommunication -> Int64
_fromEnum StructuredCommunication
v .. forall a. Integral a => a
_maxVal]
  enumFromThen :: StructuredCommunication
-> StructuredCommunication -> [StructuredCommunication]
enumFromThen StructuredCommunication
v₀ StructuredCommunication
v₁
    | StructuredCommunication
v₀ forall a. Ord a => a -> a -> Bool
<= StructuredCommunication
v₁ = forall a b. (a -> b) -> [a] -> [b]
map Int64 -> StructuredCommunication
_toEnum [StructuredCommunication -> Int64
_fromEnum StructuredCommunication
v₀, StructuredCommunication -> Int64
_fromEnum StructuredCommunication
v₁ .. forall a. Integral a => a
_maxVal]
    | Bool
otherwise = forall a b. (a -> b) -> [a] -> [b]
map Int64 -> StructuredCommunication
_toEnum [StructuredCommunication -> Int64
_fromEnum StructuredCommunication
v₀, StructuredCommunication -> Int64
_fromEnum StructuredCommunication
v₁ .. Int64
0]
  enumFromTo :: StructuredCommunication
-> StructuredCommunication -> [StructuredCommunication]
enumFromTo StructuredCommunication
v₀ StructuredCommunication
v₁ = forall a b. (a -> b) -> [a] -> [b]
map Int64 -> StructuredCommunication
_toEnum [StructuredCommunication -> Int64
_fromEnum StructuredCommunication
v₀ .. StructuredCommunication -> Int64
_fromEnum StructuredCommunication
v₁]
  enumFromThenTo :: StructuredCommunication
-> StructuredCommunication
-> StructuredCommunication
-> [StructuredCommunication]
enumFromThenTo StructuredCommunication
v₀ StructuredCommunication
v₁ StructuredCommunication
v₂ = forall a b. (a -> b) -> [a] -> [b]
map Int64 -> StructuredCommunication
_toEnum [StructuredCommunication -> Int64
_fromEnum StructuredCommunication
v₀, StructuredCommunication -> Int64
_fromEnum StructuredCommunication
v₁ .. StructuredCommunication -> Int64
_fromEnum StructuredCommunication
v₂]

instance Binary StructuredCommunication where
  get :: Get StructuredCommunication
get = Word16 -> Word16 -> Word32 -> StructuredCommunication
StructuredCommunication forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get
  put :: StructuredCommunication -> Put
put (StructuredCommunication Word16
v₀ Word16
v₁ Word32
v₂) = forall t. Binary t => t -> Put
put Word16
v₀ forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Word16
v₁ forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Word32
v₂

instance Validity StructuredCommunication where
  validate :: StructuredCommunication -> Validation
validate s :: StructuredCommunication
s@(StructuredCommunication Word16
v₀ Word16
v₁ Word32
v₂) =
    Bool -> String -> Validation
check (Word16
v₀ forall a. Ord a => a -> a -> Bool
<= Word16
999) String
"first sequence larger has more than three digits."
      forall a. Monoid a => a -> a -> a
`mappend` Bool -> String -> Validation
check (Word16
v₁ forall a. Ord a => a -> a -> Bool
<= Word16
9999) String
"second sequence larger has more than four digits."
      forall a. Monoid a => a -> a -> a
`mappend` Bool -> String -> Validation
check (Word32
v₂ forall a. Ord a => a -> a -> Bool
<= Word32
99999) String
"third sequence larger has more than five digits."
      forall a. Monoid a => a -> a -> a
`mappend` Bool -> String -> Validation
check (Word32
0 forall a. Ord a => a -> a -> Bool
< Word32
c Bool -> Bool -> Bool
&& Word32
c forall a. Ord a => a -> a -> Bool
<= Word32
97) String
"checksum out of the 1–97 range."
      forall a. Monoid a => a -> a -> a
`mappend` Bool -> String -> Validation
check (StructuredCommunication -> Word32
determineChecksum StructuredCommunication
s forall a. Eq a => a -> a -> Bool
== Word32
c) String
"checksum does not match."
    where
      c :: Word32
c = StructuredCommunication -> Word32
checksum StructuredCommunication
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 -> Word32
determineChecksum (StructuredCommunication Word16
v₀ Word16
v₁ Word32
v₂)
  | Word32
cs₂ forall a. Eq a => a -> a -> Bool
== Word32
0 = Word32
97
  | Bool
otherwise = Word32
cs₂
  where
    cs₀ :: Word16
cs₀ = Word16
v₀ forall a. Integral a => a -> a -> a
`mod` Word16
97
    cs₁ :: Word16
cs₁ = (Word16
cs₀ forall a. Num a => a -> a -> a
* Word16
9 forall a. Num a => a -> a -> a
+ Word16
v₁) forall a. Integral a => a -> a -> a
`mod` Word16
97 -- 10000 `mod` 97 ==  9  (shift four decimal places)
    cs₂ :: Word32
cs₂ = (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
cs₁ forall a. Num a => a -> a -> a
* Word32
30 forall a. Num a => a -> a -> a
+ Word32
v₂ forall a. Integral a => a -> a -> a
`div` Word32
100) forall a. Integral a => a -> a -> a
`mod` Word32
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 :: StructuredCommunication -> Bool
validChecksum s :: StructuredCommunication
s@(StructuredCommunication Word16
_ Word16
_ Word32
v₂) = StructuredCommunication -> Word32
determineChecksum StructuredCommunication
s forall a. Eq a => a -> a -> Bool
== Word32
v₂ forall a. Integral a => a -> a -> a
`mod` Word32
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 :: StructuredCommunication -> StructuredCommunication
fixChecksum s :: StructuredCommunication
s@(StructuredCommunication Word16
v₀ Word16
v₁ Word32
v₂) = Word16 -> Word16 -> Word32 -> StructuredCommunication
StructuredCommunication Word16
v₀ Word16
v₁ (Word32
v₂ forall a. Num a => a -> a -> a
- (Word32
v₂ forall a. Integral a => a -> a -> a
`mod` Word32
100) forall a. Num a => a -> a -> a
+ StructuredCommunication -> Word32
determineChecksum StructuredCommunication
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 -> String
communicationToString (StructuredCommunication Word16
v₀ Word16
v₁ Word32
v₂) = String
"+++" forall a. [a] -> [a] -> [a]
++ forall r. PrintfType r => String -> r
printf String
"%03d" Word16
v₀ forall a. [a] -> [a] -> [a]
++ String
"/" forall a. [a] -> [a] -> [a]
++ forall r. PrintfType r => String -> r
printf String
"%04d" Word16
v₁ forall a. [a] -> [a] -> [a]
++ String
"/" forall a. [a] -> [a] -> [a]
++ forall r. PrintfType r => String -> r
printf String
"%05d" Word32
v₂ forall a. [a] -> [a] -> [a]
++ String
"+++"

-- | 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 :: StructuredCommunication -> Text
communicationToText = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredCommunication -> String
communicationToString

_parseNatWidth :: (Integral i, Stream s m Char) => Int -> ParsecT s u m i
_parseNatWidth :: forall i s (m :: * -> *) u.
(Integral i, Stream s m Char) =>
Int -> ParsecT s u m i
_parseNatWidth Int
m
  | Int
m forall a. Ord a => a -> a -> Bool
>= Int
0 = forall {t} {s} {m :: * -> *} {b} {u}.
(Eq t, Stream s m Char, Num t, Num b) =>
t -> b -> ParsecT s u m b
go Int
m i
0
  | Bool
otherwise = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"negative number of digits"
  where
    go :: t -> b -> ParsecT s u m b
go t
0 b
v = forall (f :: * -> *) a. Applicative f => a -> f a
pure b
v
    go t
n b
v = forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= t -> b -> ParsecT s u m b
go (t
n forall a. Num a => a -> a -> a
- t
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b
10 forall a. Num a => a -> a -> a
* b
v) forall a. Num a => a -> a -> a
+) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitToInt

_char3 :: Stream s m Char => Char -> ParsecT s u m Char
_char3 :: forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
_char3 Char
c = forall {u}. ParsecT s u m Char
c' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall {u}. ParsecT s u m Char
c' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall {u}. ParsecT s u m Char
c'
  where
    c' :: ParsecT s u m Char
c' = forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c

_presuf :: Stream s m Char => ParsecT s u m Char
_presuf :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
_presuf = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
_char3 Char
'+') forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
_char3 Char
'*'

_slash :: Stream s m Char => ParsecT s u m Char
_slash :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
_slash = forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
_space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
_space

_space :: Stream s m Char => ParsecT s u m ()
_space :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
_space = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
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' :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m StructuredCommunication
communicationParser' = do
  Char
c <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
_presuf forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
_space
  Word16
c1 <- forall i s (m :: * -> *) u.
(Integral i, Stream s m Char) =>
Int -> ParsecT s u m i
_parseNatWidth Int
3 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
_slash
  Word16
c2 <- forall i s (m :: * -> *) u.
(Integral i, Stream s m Char) =>
Int -> ParsecT s u m i
_parseNatWidth Int
4 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
_slash
  Word32
c3 <- forall i s (m :: * -> *) u.
(Integral i, Stream s m Char) =>
Int -> ParsecT s u m i
_parseNatWidth Int
5
  Word16 -> Word16 -> Word32 -> StructuredCommunication
StructuredCommunication Word16
c1 Word16
c2 Word32
c3 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
_space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
_char3 Char
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 :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m StructuredCommunication
communicationParser = forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m StructuredCommunication
communicationParser' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s (m :: * -> *) a.
(Show s, MonadFail m) =>
Either s a -> m a
_liftEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Validity a => a -> Either String a
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' :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m StructuredCommunication
communicationEParser' = forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m StructuredCommunication
communicationParser forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
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 :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m StructuredCommunication
communicationEParser = forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m StructuredCommunication
communicationEParser' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s (m :: * -> *) a.
(Show s, MonadFail m) =>
Either s a -> m a
_liftEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Validity a => a -> Either String a
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 :: forall s.
Stream s Identity Char =>
s -> Either ParseError StructuredCommunication
parseCommunication = forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runParser forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m StructuredCommunication
communicationParser () String
""

-- | 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' :: forall s.
Stream s Identity Char =>
s -> Either ParseError StructuredCommunication
parseCommunication' = forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runParser forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m StructuredCommunication
communicationParser' () String
""

-- | 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 :: forall s.
Stream s Identity Char =>
s -> Either ParseError StructuredCommunication
parseCommunicationE = forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runParser forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m StructuredCommunication
communicationEParser () String
""

-- | 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' :: forall s.
Stream s Identity Char =>
s -> Either ParseError StructuredCommunication
parseCommunicationE' = forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runParser forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m StructuredCommunication
communicationEParser' () String
""

_liftEither :: Show s => MonadFail m => Either s a -> m a
_liftEither :: forall s (m :: * -> *) a.
(Show s, MonadFail m) =>
Either s a -> m a
_liftEither = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall (f :: * -> *) a. Applicative f => a -> f a
pure

_toPattern :: StructuredCommunication -> Pat

#if MIN_VERSION_template_haskell(2, 18, 0)
_toPattern :: StructuredCommunication -> Pat
_toPattern (StructuredCommunication Word16
v₀ Word16
v₁ Word32
v₂) = Name -> [Type] -> [Pat] -> Pat
ConP 'StructuredCommunication [] [Integer -> Pat
f (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
v₀), Integer -> Pat
f (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
v₁), Integer -> Pat
f (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
v₂)]
  where
    f :: Integer -> Pat
f = Lit -> Pat
LitP forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Lit
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
beCommunication =
  QuasiQuoter
    { quoteExp :: String -> Q Exp
quoteExp = (forall s (m :: * -> *) a.
(Show s, MonadFail m) =>
Either s a -> m a
_liftEither forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
lift) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runParser forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m StructuredCommunication
communicationEParser () String
"",
      quotePat :: String -> Q Pat
quotePat = (forall s (m :: * -> *) a.
(Show s, MonadFail m) =>
Either s a -> m a
_liftEither forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredCommunication -> Pat
_toPattern) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runParser forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m StructuredCommunication
communicationEParser () String
"",
      quoteType :: String -> Q Type
quoteType = forall a b. a -> b -> a
const (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"can not produce a type with this QuasiQuoter"),
      quoteDec :: String -> Q [Dec]
quoteDec = forall a b. a -> b -> a
const (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"can not produce a declaration with this QuasiQuoter")
    }

instance Lift StructuredCommunication where
  lift :: forall (m :: * -> *). Quote m => StructuredCommunication -> m Exp
lift (StructuredCommunication Word16
v₀ Word16
v₁ Word32
v₂) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
ConE 'StructuredCommunication Exp -> Exp -> Exp
`AppE` Integer -> Exp
f (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
v₀) Exp -> Exp -> Exp
`AppE` Integer -> Exp
f (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
v₁) Exp -> Exp -> Exp
`AppE` Integer -> Exp
f (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
v₂))
    where
      f :: Integer -> Exp
f = Lit -> Exp
LitE forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Lit
IntegerL

#if MIN_VERSION_template_haskell(2, 17, 0)
  liftTyped :: forall (m :: * -> *).
Quote m =>
StructuredCommunication -> Code m StructuredCommunication
liftTyped (StructuredCommunication Word16
v₀ Word16
v₁ Word32
v₂) = forall (m :: * -> *) a. m (TExp a) -> Code m a
Code (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Exp -> TExp a
TExp (Name -> Exp
ConE 'StructuredCommunication Exp -> Exp -> Exp
`AppE` Integer -> Exp
f (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
v₀) Exp -> Exp -> Exp
`AppE` Integer -> Exp
f (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
v₁) Exp -> Exp -> Exp
`AppE` Integer -> Exp
f (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
v₂))))
    where
      f :: Integer -> Exp
f = Lit -> Exp
LitE forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Lit
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