{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Codec.QRCode.Mode.Numeric
  ( numeric
  , numericB
  ) where

import           Codec.QRCode.Base

import qualified Codec.QRCode.Data.ByteStreamBuilder  as BSB
import           Codec.QRCode.Data.QRSegment.Internal
import           Codec.QRCode.Data.Result
import           Codec.QRCode.Data.ToInput

-- | Generate a segment representing the specified string of decimal digits encoded in numeric mode.
numeric :: ToNumeric a => a -> Result QRSegment
numeric :: a -> Result QRSegment
numeric a
s =
  case a -> [Int]
forall a. ToNumeric a => a -> [Int]
toNumeric a
s of
    [] -> QRSegment -> Result QRSegment
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteStreamBuilder -> QRSegment
constStream ByteStreamBuilder
forall a. Monoid a => a
mempty)
    [Int]
s' -> ((Int -> Int -> QRSegment
encodeBits Int
4 Int
0b0001 QRSegment -> QRSegment -> QRSegment
forall a. Semigroup a => a -> a -> a
<> (Int, Int, Int) -> Int -> QRSegment
lengthSegment (Int
10, Int
12, Int
14) ([Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
s')) QRSegment -> QRSegment -> QRSegment
forall a. Semigroup a => a -> a -> a
<>) (QRSegment -> QRSegment)
-> (ByteStreamBuilder -> QRSegment)
-> ByteStreamBuilder
-> QRSegment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteStreamBuilder -> QRSegment
constStream (ByteStreamBuilder -> QRSegment)
-> Result ByteStreamBuilder -> Result QRSegment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> Result ByteStreamBuilder
forall a. ToNumeric a => a -> Result ByteStreamBuilder
numericB [Int]
s'

numericB :: ToNumeric a => a -> Result BSB.ByteStreamBuilder
numericB :: a -> Result ByteStreamBuilder
numericB a
s
  | (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Int
c -> Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9) [Int]
s' = ByteStreamBuilder -> Result ByteStreamBuilder
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Int] -> ByteStreamBuilder
go [Int]
s')
  | Bool
otherwise = Result ByteStreamBuilder
forall (f :: * -> *) a. Alternative f => f a
empty
  where
    s' :: [Int]
    s' :: [Int]
s' = a -> [Int]
forall a. ToNumeric a => a -> [Int]
toNumeric a
s
    go :: [Int] -> BSB.ByteStreamBuilder
    go :: [Int] -> ByteStreamBuilder
go (Int
a:Int
b:Int
c:[Int]
cs) = Int -> Int -> ByteStreamBuilder
BSB.encodeBits Int
10 (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c) ByteStreamBuilder -> ByteStreamBuilder -> ByteStreamBuilder
forall a. Semigroup a => a -> a -> a
<> [Int] -> ByteStreamBuilder
go [Int]
cs
    go [Int
a,Int
b]      = Int -> Int -> ByteStreamBuilder
BSB.encodeBits Int
7 (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b)
    go [Int
a]        = Int -> Int -> ByteStreamBuilder
BSB.encodeBits Int
4 Int
a
    go []         = ByteStreamBuilder
forall a. Monoid a => a
mempty