{-# 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 System.Random (Random)
import System.Random.Internal (Uniform (uniformM), UniformRange (uniformRM))
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
Typeable StructuredCommunication =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> StructuredCommunication
 -> c StructuredCommunication)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c StructuredCommunication)
-> (StructuredCommunication -> Constr)
-> (StructuredCommunication -> DataType)
-> (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))
-> ((forall b. Data b => b -> b)
    -> StructuredCommunication -> StructuredCommunication)
-> (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 u.
    (forall d. Data d => d -> u) -> StructuredCommunication -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> StructuredCommunication -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> StructuredCommunication -> m StructuredCommunication)
-> Data StructuredCommunication
StructuredCommunication -> Constr
StructuredCommunication -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> StructuredCommunication
-> c StructuredCommunication
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> StructuredCommunication
-> c StructuredCommunication
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StructuredCommunication
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StructuredCommunication
$ctoConstr :: StructuredCommunication -> Constr
toConstr :: StructuredCommunication -> Constr
$cdataTypeOf :: StructuredCommunication -> DataType
dataTypeOf :: StructuredCommunication -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StructuredCommunication)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StructuredCommunication)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StructuredCommunication)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StructuredCommunication)
$cgmapT :: (forall b. Data b => b -> b)
-> StructuredCommunication -> StructuredCommunication
gmapT :: (forall b. Data b => b -> b)
-> StructuredCommunication -> StructuredCommunication
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> StructuredCommunication
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> StructuredCommunication
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> StructuredCommunication -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> StructuredCommunication -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> StructuredCommunication -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> StructuredCommunication -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StructuredCommunication -> m StructuredCommunication
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StructuredCommunication -> m StructuredCommunication
Data, StructuredCommunication -> StructuredCommunication -> Bool
(StructuredCommunication -> StructuredCommunication -> Bool)
-> (StructuredCommunication -> StructuredCommunication -> Bool)
-> Eq StructuredCommunication
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StructuredCommunication -> StructuredCommunication -> Bool
== :: StructuredCommunication -> StructuredCommunication -> Bool
$c/= :: StructuredCommunication -> StructuredCommunication -> Bool
/= :: StructuredCommunication -> StructuredCommunication -> Bool
Eq, (forall x.
 StructuredCommunication -> Rep StructuredCommunication x)
-> (forall x.
    Rep StructuredCommunication x -> StructuredCommunication)
-> Generic StructuredCommunication
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
$cfrom :: forall x. StructuredCommunication -> Rep StructuredCommunication x
from :: forall x. StructuredCommunication -> Rep StructuredCommunication x
$cto :: forall x. Rep StructuredCommunication x -> StructuredCommunication
to :: forall x. Rep StructuredCommunication x -> StructuredCommunication
Generic, Eq StructuredCommunication
Eq StructuredCommunication =>
(StructuredCommunication -> StructuredCommunication -> Ordering)
-> (StructuredCommunication -> StructuredCommunication -> Bool)
-> (StructuredCommunication -> StructuredCommunication -> Bool)
-> (StructuredCommunication -> StructuredCommunication -> Bool)
-> (StructuredCommunication -> StructuredCommunication -> Bool)
-> (StructuredCommunication
    -> StructuredCommunication -> StructuredCommunication)
-> (StructuredCommunication
    -> StructuredCommunication -> StructuredCommunication)
-> Ord 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
$ccompare :: StructuredCommunication -> StructuredCommunication -> Ordering
compare :: StructuredCommunication -> StructuredCommunication -> Ordering
$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
>= :: StructuredCommunication -> StructuredCommunication -> Bool
$cmax :: StructuredCommunication
-> StructuredCommunication -> StructuredCommunication
max :: StructuredCommunication
-> StructuredCommunication -> StructuredCommunication
$cmin :: StructuredCommunication
-> StructuredCommunication -> StructuredCommunication
min :: StructuredCommunication
-> StructuredCommunication -> StructuredCommunication
Ord, ReadPrec [StructuredCommunication]
ReadPrec StructuredCommunication
Int -> ReadS StructuredCommunication
ReadS [StructuredCommunication]
(Int -> ReadS StructuredCommunication)
-> ReadS [StructuredCommunication]
-> ReadPrec StructuredCommunication
-> ReadPrec [StructuredCommunication]
-> Read StructuredCommunication
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS StructuredCommunication
readsPrec :: Int -> ReadS StructuredCommunication
$creadList :: ReadS [StructuredCommunication]
readList :: ReadS [StructuredCommunication]
$creadPrec :: ReadPrec StructuredCommunication
readPrec :: ReadPrec StructuredCommunication
$creadListPrec :: ReadPrec [StructuredCommunication]
readListPrec :: ReadPrec [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₂) = Word16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
v₀ Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
10000000 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Word16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
v₁ Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
1000 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
v₂ Word32 -> Word32 -> Word32
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 (Int64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
v₀) (Int64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
v₁) (Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
v₂))
  where
    v₂ :: Int64
v₂ = (Int64
v Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`mod` Int64
1000) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
100
    v₁ :: Int64
v₁ = (Int64
v Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
1000) Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`mod` Int64
10000
    v₀ :: Int64
v₀ = Int64
v Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
10000000

instance Num StructuredCommunication where
  fromInteger :: Integer -> StructuredCommunication
fromInteger = Int64 -> StructuredCommunication
_toEnum (Int64 -> StructuredCommunication)
-> (Integer -> Int64) -> Integer -> StructuredCommunication
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int64
forall a. Num a => Integer -> a
fromInteger (Integer -> Int64) -> (Integer -> Integer) -> Integer -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
forall a. Integral a => a
_numVals)
  StructuredCommunication
v1 + :: StructuredCommunication
-> StructuredCommunication -> StructuredCommunication
+ StructuredCommunication
v2 = Int64 -> StructuredCommunication
_toEnum ((StructuredCommunication -> Int64
_fromEnum StructuredCommunication
v1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ StructuredCommunication -> Int64
_fromEnum StructuredCommunication
v2) Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`mod` Int64
forall a. Integral a => a
_numVals)
  StructuredCommunication
v1 - :: StructuredCommunication
-> StructuredCommunication -> StructuredCommunication
- StructuredCommunication
v2 = Int64 -> StructuredCommunication
_toEnum ((StructuredCommunication -> Int64
_fromEnum StructuredCommunication
v1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- StructuredCommunication -> Int64
_fromEnum StructuredCommunication
v2) Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`mod` Int64
forall a. Integral a => a
_numVals)
  negate :: StructuredCommunication -> StructuredCommunication
negate = Int64 -> StructuredCommunication
_toEnum (Int64 -> StructuredCommunication)
-> (StructuredCommunication -> Int64)
-> StructuredCommunication
-> StructuredCommunication
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`mod` Int64
forall a. Integral a => a
_numVals) (Int64 -> Int64)
-> (StructuredCommunication -> Int64)
-> StructuredCommunication
-> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
forall a. Num a => a -> a
negate (Int64 -> Int64)
-> (StructuredCommunication -> Int64)
-> StructuredCommunication
-> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredCommunication -> Int64
_fromEnum
  abs :: StructuredCommunication -> StructuredCommunication
abs = StructuredCommunication -> StructuredCommunication
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 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
v2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ (Int64
v1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
m1) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
m2) Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`mod` Int64
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 Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`mod` Int64
100000
      m2 :: Int64
m2 = Int64
v2 Int64 -> Int64 -> Int64
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 Random StructuredCommunication

instance Uniform StructuredCommunication where
  uniformM :: forall g (m :: * -> *).
StatefulGen g m =>
g -> m StructuredCommunication
uniformM g
g = Int64 -> StructuredCommunication
_toEnum (Int64 -> StructuredCommunication)
-> m Int64 -> m StructuredCommunication
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int64, Int64) -> g -> m Int64
forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
forall g (m :: * -> *).
StatefulGen g m =>
(Int64, Int64) -> g -> m Int64
uniformRM (Int64
0, Int64
forall a. Integral a => a
_maxVal) g
g

instance UniformRange StructuredCommunication where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(StructuredCommunication, StructuredCommunication)
-> g -> m StructuredCommunication
uniformRM (StructuredCommunication
s0, StructuredCommunication
s1) g
g = Int64 -> StructuredCommunication
_toEnum (Int64 -> StructuredCommunication)
-> m Int64 -> m StructuredCommunication
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int64, Int64) -> g -> m Int64
forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
forall g (m :: * -> *).
StatefulGen g m =>
(Int64, Int64) -> g -> m Int64
uniformRM (StructuredCommunication -> Int64
_fromEnum StructuredCommunication
s0, StructuredCommunication -> Int64
_fromEnum StructuredCommunication
s1) g
g

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

instance Integral StructuredCommunication where
  toInteger :: StructuredCommunication -> Integer
toInteger = Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int64 -> Integer)
-> (StructuredCommunication -> Int64)
-> StructuredCommunication
-> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredCommunication -> Int64
_fromEnum
  quot :: StructuredCommunication
-> StructuredCommunication -> StructuredCommunication
quot StructuredCommunication
x = Int64 -> StructuredCommunication
_toEnum (Int64 -> StructuredCommunication)
-> (StructuredCommunication -> Int64)
-> StructuredCommunication
-> StructuredCommunication
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
quot (StructuredCommunication -> Int64
_fromEnum StructuredCommunication
x) (Int64 -> Int64)
-> (StructuredCommunication -> Int64)
-> StructuredCommunication
-> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredCommunication -> Int64
_fromEnum
  rem :: StructuredCommunication
-> StructuredCommunication -> StructuredCommunication
rem StructuredCommunication
x = Int64 -> StructuredCommunication
_toEnum (Int64 -> StructuredCommunication)
-> (StructuredCommunication -> Int64)
-> StructuredCommunication
-> StructuredCommunication
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
rem (StructuredCommunication -> Int64
_fromEnum StructuredCommunication
x) (Int64 -> Int64)
-> (StructuredCommunication -> Int64)
-> StructuredCommunication
-> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredCommunication -> Int64
_fromEnum
  quotRem :: StructuredCommunication
-> StructuredCommunication
-> (StructuredCommunication, StructuredCommunication)
quotRem StructuredCommunication
x = (Int64 -> StructuredCommunication)
-> (Int64, Int64)
-> (StructuredCommunication, StructuredCommunication)
forall a b. (a -> b) -> (a, a) -> (b, b)
_both Int64 -> StructuredCommunication
_toEnum ((Int64, Int64)
 -> (StructuredCommunication, StructuredCommunication))
-> (StructuredCommunication -> (Int64, Int64))
-> StructuredCommunication
-> (StructuredCommunication, StructuredCommunication)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
quotRem (StructuredCommunication -> Int64
_fromEnum StructuredCommunication
x) (Int64 -> (Int64, Int64))
-> (StructuredCommunication -> Int64)
-> StructuredCommunication
-> (Int64, Int64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredCommunication -> Int64
_fromEnum
  div :: StructuredCommunication
-> StructuredCommunication -> StructuredCommunication
div StructuredCommunication
x = Int64 -> StructuredCommunication
_toEnum (Int64 -> StructuredCommunication)
-> (StructuredCommunication -> Int64)
-> StructuredCommunication
-> StructuredCommunication
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
div (StructuredCommunication -> Int64
_fromEnum StructuredCommunication
x) (Int64 -> Int64)
-> (StructuredCommunication -> Int64)
-> StructuredCommunication
-> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredCommunication -> Int64
_fromEnum
  mod :: StructuredCommunication
-> StructuredCommunication -> StructuredCommunication
mod StructuredCommunication
x = Int64 -> StructuredCommunication
_toEnum (Int64 -> StructuredCommunication)
-> (StructuredCommunication -> Int64)
-> StructuredCommunication
-> StructuredCommunication
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
mod (StructuredCommunication -> Int64
_fromEnum StructuredCommunication
x) (Int64 -> Int64)
-> (StructuredCommunication -> Int64)
-> StructuredCommunication
-> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredCommunication -> Int64
_fromEnum
  divMod :: StructuredCommunication
-> StructuredCommunication
-> (StructuredCommunication, StructuredCommunication)
divMod StructuredCommunication
x = (Int64 -> StructuredCommunication)
-> (Int64, Int64)
-> (StructuredCommunication, StructuredCommunication)
forall a b. (a -> b) -> (a, a) -> (b, b)
_both Int64 -> StructuredCommunication
_toEnum ((Int64, Int64)
 -> (StructuredCommunication, StructuredCommunication))
-> (StructuredCommunication -> (Int64, Int64))
-> StructuredCommunication
-> (StructuredCommunication, StructuredCommunication)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
quotRem (StructuredCommunication -> Int64
_fromEnum StructuredCommunication
x) (Int64 -> (Int64, Int64))
-> (StructuredCommunication -> Int64)
-> StructuredCommunication
-> (Int64, Int64)
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|" String -> ShowS
forall a. [a] -> [a] -> [a]
++ StructuredCommunication -> String
communicationToString StructuredCommunication
c String -> ShowS
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₂ Word32 -> Word32 -> Word32
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 = i -> Bool
forall {p}. Integral p => p -> Bool
go
  where
    go :: p -> Bool
go p
v = Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
i Bool -> Bool -> Bool
&& Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
mx where i :: Integer
i = p -> Integer
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₂
  | Integer -> i -> Bool
forall i. Integral i => Integer -> i -> Bool
_rcheck Integer
999 i
v₀ Bool -> Bool -> Bool
&& Integer -> j -> Bool
forall i. Integral i => Integer -> i -> Bool
_rcheck Integer
9999 j
v₁ Bool -> Bool -> Bool
&& Integer -> k -> Bool
forall i. Integral i => Integer -> i -> Bool
_rcheck Integer
99997 k
v₂ Bool -> Bool -> Bool
&& StructuredCommunication -> Bool
validChecksum StructuredCommunication
s = StructuredCommunication -> Maybe StructuredCommunication
forall a. a -> Maybe a
Just StructuredCommunication
s
  | Bool
otherwise = Maybe StructuredCommunication
forall a. Maybe a
Nothing
  where
    s :: StructuredCommunication
s = Word16 -> Word16 -> Word32 -> StructuredCommunication
StructuredCommunication (i -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
v₀) (j -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral j
v₁) (k -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral k
v₂)

instance Arbitrary StructuredCommunication where
  arbitrary :: Gen StructuredCommunication
arbitrary = StructuredCommunication -> StructuredCommunication
fixChecksum (StructuredCommunication -> StructuredCommunication)
-> Gen StructuredCommunication -> Gen StructuredCommunication
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word16 -> Word16 -> Word32 -> StructuredCommunication
StructuredCommunication (Word16 -> Word16 -> Word32 -> StructuredCommunication)
-> Gen Word16 -> Gen (Word16 -> Word32 -> StructuredCommunication)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word16, Word16) -> Gen Word16
forall a. Random a => (a, a) -> Gen a
choose (Word16
0, Word16
999) Gen (Word16 -> Word32 -> StructuredCommunication)
-> Gen Word16 -> Gen (Word32 -> StructuredCommunication)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word16, Word16) -> Gen Word16
forall a. Random a => (a, a) -> Gen a
choose (Word16
0, Word16
9999) Gen (Word32 -> StructuredCommunication)
-> Gen Word32 -> Gen StructuredCommunication
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Word32
100 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
*) (Word32 -> Word32) -> Gen Word32 -> Gen Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word32, Word32) -> Gen Word32
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 = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int)
-> (StructuredCommunication -> Int64)
-> StructuredCommunication
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredCommunication -> Int64
_fromEnum
  toEnum :: Int -> StructuredCommunication
toEnum = Int64 -> StructuredCommunication
_toEnum (Int64 -> StructuredCommunication)
-> (Int -> Int64) -> Int -> StructuredCommunication
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  succ :: StructuredCommunication -> StructuredCommunication
succ = Int64 -> StructuredCommunication
_toEnum (Int64 -> StructuredCommunication)
-> (StructuredCommunication -> Int64)
-> StructuredCommunication
-> StructuredCommunication
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
forall a. Enum a => a -> a
succ (Int64 -> Int64)
-> (StructuredCommunication -> Int64)
-> StructuredCommunication
-> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredCommunication -> Int64
_fromEnum
  pred :: StructuredCommunication -> StructuredCommunication
pred = Int64 -> StructuredCommunication
_toEnum (Int64 -> StructuredCommunication)
-> (StructuredCommunication -> Int64)
-> StructuredCommunication
-> StructuredCommunication
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
forall a. Enum a => a -> a
pred (Int64 -> Int64)
-> (StructuredCommunication -> Int64)
-> StructuredCommunication
-> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredCommunication -> Int64
_fromEnum
  enumFrom :: StructuredCommunication -> [StructuredCommunication]
enumFrom StructuredCommunication
v = (Int64 -> StructuredCommunication)
-> [Int64] -> [StructuredCommunication]
forall a b. (a -> b) -> [a] -> [b]
map Int64 -> StructuredCommunication
_toEnum [StructuredCommunication -> Int64
_fromEnum StructuredCommunication
v .. Int64
forall a. Integral a => a
_maxVal]
  enumFromThen :: StructuredCommunication
-> StructuredCommunication -> [StructuredCommunication]
enumFromThen StructuredCommunication
v₀ StructuredCommunication
v₁
    | StructuredCommunication
v₀ StructuredCommunication -> StructuredCommunication -> Bool
forall a. Ord a => a -> a -> Bool
<= StructuredCommunication
v₁ = (Int64 -> StructuredCommunication)
-> [Int64] -> [StructuredCommunication]
forall a b. (a -> b) -> [a] -> [b]
map Int64 -> StructuredCommunication
_toEnum [StructuredCommunication -> Int64
_fromEnum StructuredCommunication
v₀, StructuredCommunication -> Int64
_fromEnum StructuredCommunication
v₁ .. Int64
forall a. Integral a => a
_maxVal]
    | Bool
otherwise = (Int64 -> StructuredCommunication)
-> [Int64] -> [StructuredCommunication]
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₁ = (Int64 -> StructuredCommunication)
-> [Int64] -> [StructuredCommunication]
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₂ = (Int64 -> StructuredCommunication)
-> [Int64] -> [StructuredCommunication]
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 (Word16 -> Word16 -> Word32 -> StructuredCommunication)
-> Get Word16 -> Get (Word16 -> Word32 -> StructuredCommunication)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
forall t. Binary t => Get t
get Get (Word16 -> Word32 -> StructuredCommunication)
-> Get Word16 -> Get (Word32 -> StructuredCommunication)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
forall t. Binary t => Get t
get Get (Word32 -> StructuredCommunication)
-> Get Word32 -> Get StructuredCommunication
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
forall t. Binary t => Get t
get
  put :: StructuredCommunication -> Put
put (StructuredCommunication Word16
v₀ Word16
v₁ Word32
v₂) = Word16 -> Put
forall t. Binary t => t -> Put
put Word16
v₀ Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word16 -> Put
forall t. Binary t => t -> Put
put Word16
v₁ Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
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₀ Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word16
999) String
"first sequence larger has more than three digits."
      Validation -> Validation -> Validation
forall a. Monoid a => a -> a -> a
`mappend` Bool -> String -> Validation
check (Word16
v₁ Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word16
9999) String
"second sequence larger has more than four digits."
      Validation -> Validation -> Validation
forall a. Monoid a => a -> a -> a
`mappend` Bool -> String -> Validation
check (Word32
v₂ Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32
99999) String
"third sequence larger has more than five digits."
      Validation -> Validation -> Validation
forall a. Monoid a => a -> a -> a
`mappend` Bool -> String -> Validation
check (Word32
0 Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
c Bool -> Bool -> Bool
&& Word32
c Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32
97) String
"checksum out of the 1–97 range."
      Validation -> Validation -> Validation
forall a. Monoid a => a -> a -> a
`mappend` Bool -> String -> Validation
check (StructuredCommunication -> Word32
determineChecksum StructuredCommunication
s Word32 -> Word32 -> Bool
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₂ Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0 = Word32
97
  | Bool
otherwise = Word32
cs₂
  where
    cs₀ :: Word16
cs₀ = Word16
v₀ Word16 -> Word16 -> Word16
forall a. Integral a => a -> a -> a
`mod` Word16
97
    cs₁ :: Word16
cs₁ = (Word16
cs₀ Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
* Word16
9 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
v₁) Word16 -> Word16 -> Word16
forall a. Integral a => a -> a -> a
`mod` Word16
97 -- 10000 `mod` 97 ==  9  (shift four decimal places)
    cs₂ :: Word32
cs₂ = (Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
cs₁ Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
30 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
v₂ Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`div` Word32
100) Word32 -> Word32 -> Word32
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 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
v₂ Word32 -> Word32 -> Word32
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₂ Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- (Word32
v₂ Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`mod` Word32
100) Word32 -> Word32 -> Word32
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
"+++" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> Word16 -> String
forall r. PrintfType r => String -> r
printf String
"%03d" Word16
v₀ String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> Word16 -> String
forall r. PrintfType r => String -> r
printf String
"%04d" Word16
v₁ String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> Word32 -> String
forall r. PrintfType r => String -> r
printf String
"%05d" Word32
v₂ String -> ShowS
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 (String -> Text)
-> (StructuredCommunication -> String)
-> StructuredCommunication
-> Text
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = Int -> i -> ParsecT s u m i
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 = String -> ParsecT s u m i
forall a. String -> ParsecT s u m a
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 = b -> ParsecT s u m b
forall a. a -> ParsecT s u m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
v
    go t
n b
v = ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit ParsecT s u m Char -> (Char -> ParsecT s u m b) -> ParsecT s u m b
forall a b.
ParsecT s u m a -> (a -> ParsecT s u m b) -> ParsecT s u m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= t -> b -> ParsecT s u m b
go (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1) (b -> ParsecT s u m b) -> (Char -> b) -> Char -> ParsecT s u m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b
10 b -> b -> b
forall a. Num a => a -> a -> a
* b
v) b -> b -> b
forall a. Num a => a -> a -> a
+) (b -> b) -> (Char -> b) -> Char -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> b) -> (Char -> Int) -> Char -> b
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 = ParsecT s u m Char
forall {u}. ParsecT s u m Char
c' ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT s u m Char
forall {u}. ParsecT s u m Char
c' ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT s u m Char
forall {u}. ParsecT s u m Char
c'
  where
    c' :: ParsecT s u m Char
c' = Char -> ParsecT s u m Char
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 = ParsecT s u m Char -> ParsecT s u m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
_char3 Char
'+') ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
forall a. ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT s u m Char
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 = ParsecT s u m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
_space ParsecT s u m () -> ParsecT s u m Char -> ParsecT s u m Char
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/' ParsecT s u m Char -> ParsecT s u m () -> ParsecT s u m Char
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT s u m ()
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 = ParsecT s u m Char -> ParsecT s u m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT s u m Char
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 <- ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
_presuf ParsecT s u m Char -> ParsecT s u m () -> ParsecT s u m Char
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT s u m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
_space
  Word16
c1 <- Int -> ParsecT s u m Word16
forall i s (m :: * -> *) u.
(Integral i, Stream s m Char) =>
Int -> ParsecT s u m i
_parseNatWidth Int
3 ParsecT s u m Word16 -> ParsecT s u m Char -> ParsecT s u m Word16
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
_slash
  Word16
c2 <- Int -> ParsecT s u m Word16
forall i s (m :: * -> *) u.
(Integral i, Stream s m Char) =>
Int -> ParsecT s u m i
_parseNatWidth Int
4 ParsecT s u m Word16 -> ParsecT s u m Char -> ParsecT s u m Word16
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
_slash
  Word32
c3 <- Int -> ParsecT s u m Word32
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 StructuredCommunication
-> ParsecT s u m () -> ParsecT s u m StructuredCommunication
forall a b. a -> ParsecT s u m b -> ParsecT s u m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT s u m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
_space ParsecT s u m StructuredCommunication
-> ParsecT s u m Char -> ParsecT s u m StructuredCommunication
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT s u m Char
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 = ParsecT s u m StructuredCommunication
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m StructuredCommunication
communicationParser' ParsecT s u m StructuredCommunication
-> (StructuredCommunication
    -> ParsecT s u m StructuredCommunication)
-> ParsecT s u m StructuredCommunication
forall a b.
ParsecT s u m a -> (a -> ParsecT s u m b) -> ParsecT s u m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either String StructuredCommunication
-> ParsecT s u m StructuredCommunication
forall s (m :: * -> *) a.
(Show s, MonadFail m) =>
Either s a -> m a
_liftEither (Either String StructuredCommunication
 -> ParsecT s u m StructuredCommunication)
-> (StructuredCommunication
    -> Either String StructuredCommunication)
-> StructuredCommunication
-> ParsecT s u m StructuredCommunication
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredCommunication -> Either String StructuredCommunication
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' = ParsecT s u m StructuredCommunication
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m StructuredCommunication
communicationParser ParsecT s u m StructuredCommunication
-> ParsecT s u m () -> ParsecT s u m StructuredCommunication
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT s u m ()
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 = ParsecT s u m StructuredCommunication
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m StructuredCommunication
communicationEParser' ParsecT s u m StructuredCommunication
-> (StructuredCommunication
    -> ParsecT s u m StructuredCommunication)
-> ParsecT s u m StructuredCommunication
forall a b.
ParsecT s u m a -> (a -> ParsecT s u m b) -> ParsecT s u m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either String StructuredCommunication
-> ParsecT s u m StructuredCommunication
forall s (m :: * -> *) a.
(Show s, MonadFail m) =>
Either s a -> m a
_liftEither (Either String StructuredCommunication
 -> ParsecT s u m StructuredCommunication)
-> (StructuredCommunication
    -> Either String StructuredCommunication)
-> StructuredCommunication
-> ParsecT s u m StructuredCommunication
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredCommunication -> Either String StructuredCommunication
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 = Parsec s () StructuredCommunication
-> () -> String -> s -> Either ParseError StructuredCommunication
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runParser Parsec s () StructuredCommunication
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' = Parsec s () StructuredCommunication
-> () -> String -> s -> Either ParseError StructuredCommunication
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runParser Parsec s () StructuredCommunication
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 = Parsec s () StructuredCommunication
-> () -> String -> s -> Either ParseError StructuredCommunication
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runParser Parsec s () StructuredCommunication
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' = Parsec s () StructuredCommunication
-> () -> String -> s -> Either ParseError StructuredCommunication
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runParser Parsec s () StructuredCommunication
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 = (s -> m a) -> (a -> m a) -> Either s a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> (s -> String) -> s -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> String
forall a. Show a => a -> String
show) a -> m a
forall a. a -> m a
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 (Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
v₀), Integer -> Pat
f (Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
v₁), Integer -> Pat
f (Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
v₂)]
  where
    f :: Integer -> Pat
f = Lit -> Pat
LitP (Lit -> Pat) -> (Integer -> Lit) -> Integer -> Pat
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 = (Either ParseError StructuredCommunication
-> Q StructuredCommunication
forall s (m :: * -> *) a.
(Show s, MonadFail m) =>
Either s a -> m a
_liftEither (Either ParseError StructuredCommunication
 -> Q StructuredCommunication)
-> (StructuredCommunication -> Q Exp)
-> Either ParseError StructuredCommunication
-> Q Exp
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> StructuredCommunication -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => StructuredCommunication -> m Exp
lift) (Either ParseError StructuredCommunication -> Q Exp)
-> (String -> Either ParseError StructuredCommunication)
-> String
-> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec String () StructuredCommunication
-> ()
-> String
-> String
-> Either ParseError StructuredCommunication
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runParser Parsec String () StructuredCommunication
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m StructuredCommunication
communicationEParser () String
"",
      quotePat :: String -> Q Pat
quotePat = (Either ParseError StructuredCommunication
-> Q StructuredCommunication
forall s (m :: * -> *) a.
(Show s, MonadFail m) =>
Either s a -> m a
_liftEither (Either ParseError StructuredCommunication
 -> Q StructuredCommunication)
-> (StructuredCommunication -> Q Pat)
-> Either ParseError StructuredCommunication
-> Q Pat
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Pat -> Q Pat
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pat -> Q Pat)
-> (StructuredCommunication -> Pat)
-> StructuredCommunication
-> Q Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredCommunication -> Pat
_toPattern) (Either ParseError StructuredCommunication -> Q Pat)
-> (String -> Either ParseError StructuredCommunication)
-> String
-> Q Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec String () StructuredCommunication
-> ()
-> String
-> String
-> Either ParseError StructuredCommunication
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runParser Parsec String () StructuredCommunication
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m StructuredCommunication
communicationEParser () String
"",
      quoteType :: String -> Q Type
quoteType = Q Type -> String -> Q Type
forall a b. a -> b -> a
const (String -> Q Type
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"can not produce a type with this QuasiQuoter"),
      quoteDec :: String -> Q [Dec]
quoteDec = Q [Dec] -> String -> Q [Dec]
forall a b. a -> b -> a
const (String -> Q [Dec]
forall a. String -> Q a
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₂) = Exp -> m Exp
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Exp
ConE 'StructuredCommunication Exp -> Exp -> Exp
`AppE` Integer -> Exp
f (Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
v₀) Exp -> Exp -> Exp
`AppE` Integer -> Exp
f (Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
v₁) Exp -> Exp -> Exp
`AppE` Integer -> Exp
f (Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
v₂))
    where
      f :: Integer -> Exp
f = Lit -> Exp
LitE (Lit -> Exp) -> (Integer -> Lit) -> Integer -> Exp
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₂) = m (TExp StructuredCommunication) -> Code m StructuredCommunication
forall (m :: * -> *) a. m (TExp a) -> Code m a
Code (TExp StructuredCommunication -> m (TExp StructuredCommunication)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> TExp StructuredCommunication
forall a. Exp -> TExp a
TExp (Name -> Exp
ConE 'StructuredCommunication Exp -> Exp -> Exp
`AppE` Integer -> Exp
f (Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
v₀) Exp -> Exp -> Exp
`AppE` Integer -> Exp
f (Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
v₁) Exp -> Exp -> Exp
`AppE` Integer -> Exp
f (Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
v₂))))
    where
      f :: Integer -> Exp
f = Lit -> Exp
LitE (Lit -> Exp) -> (Integer -> Lit) -> Integer -> Exp
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