{-# LANGUAGE NoImplicitPrelude #-}

module Codec.QRCode.Data.QRSegment.Internal
  ( QRSegment(..)
  , constStream
  , encodeBits
  , lengthSegment
  ) where

import           Codec.QRCode.Base

import qualified Codec.QRCode.Data.ByteStreamBuilder as BSB
import           Codec.QRCode.Data.Result
import           Codec.QRCode.Data.Version

-- | An segment of encoded data
newtype QRSegment
  = QRSegment
    { QRSegment -> VersionRange -> Result ByteStreamBuilder
unQRSegment :: VersionRange -> Result BSB.ByteStreamBuilder
    }

instance Semigroup QRSegment where
  {-# INLINE (<>) #-}
  QRSegment VersionRange -> Result ByteStreamBuilder
a <> :: QRSegment -> QRSegment -> QRSegment
<> QRSegment VersionRange -> Result ByteStreamBuilder
b = (VersionRange -> Result ByteStreamBuilder) -> QRSegment
QRSegment ((VersionRange -> Result ByteStreamBuilder) -> QRSegment)
-> (VersionRange -> Result ByteStreamBuilder) -> QRSegment
forall a b. (a -> b) -> a -> b
$ \VersionRange
v -> ByteStreamBuilder -> ByteStreamBuilder -> ByteStreamBuilder
forall a. Semigroup a => a -> a -> a
(<>) (ByteStreamBuilder -> ByteStreamBuilder -> ByteStreamBuilder)
-> Result ByteStreamBuilder
-> Result (ByteStreamBuilder -> ByteStreamBuilder)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VersionRange -> Result ByteStreamBuilder
a VersionRange
v Result (ByteStreamBuilder -> ByteStreamBuilder)
-> Result ByteStreamBuilder -> Result ByteStreamBuilder
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> VersionRange -> Result ByteStreamBuilder
b VersionRange
v

constStream :: BSB.ByteStreamBuilder -> QRSegment
{-# INLINABLE constStream #-}
constStream :: ByteStreamBuilder -> QRSegment
constStream = (VersionRange -> Result ByteStreamBuilder) -> QRSegment
QRSegment ((VersionRange -> Result ByteStreamBuilder) -> QRSegment)
-> (ByteStreamBuilder -> VersionRange -> Result ByteStreamBuilder)
-> ByteStreamBuilder
-> QRSegment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result ByteStreamBuilder
-> VersionRange -> Result ByteStreamBuilder
forall a b. a -> b -> a
const (Result ByteStreamBuilder
 -> VersionRange -> Result ByteStreamBuilder)
-> (ByteStreamBuilder -> Result ByteStreamBuilder)
-> ByteStreamBuilder
-> VersionRange
-> Result ByteStreamBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteStreamBuilder -> Result ByteStreamBuilder
forall (f :: * -> *) a. Applicative f => a -> f a
pure

encodeBits :: Int -> Int -> QRSegment
{-# INLINABLE encodeBits #-}
encodeBits :: Int -> Int -> QRSegment
encodeBits Int
len = ByteStreamBuilder -> QRSegment
constStream (ByteStreamBuilder -> QRSegment)
-> (Int -> ByteStreamBuilder) -> Int -> QRSegment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> ByteStreamBuilder
BSB.encodeBits Int
len

lengthSegment :: (Int, Int, Int) -> Int -> QRSegment
{-# INLINABLE lengthSegment #-}
lengthSegment :: (Int, Int, Int) -> Int -> QRSegment
lengthSegment (Int
n1_9, Int
n10_26, Int
n27_40) Int
l = (VersionRange -> Result ByteStreamBuilder) -> QRSegment
QRSegment ((VersionRange -> Result ByteStreamBuilder) -> QRSegment)
-> (VersionRange -> Result ByteStreamBuilder) -> QRSegment
forall a b. (a -> b) -> a -> b
$ \VersionRange
vr ->
  let
    n :: Int
n =
      case VersionRange
vr of
        VersionRange
Version1to9   -> Int
n1_9
        VersionRange
Version10to26 -> Int
n10_26
        VersionRange
Version27to40 -> Int
n27_40
  in
    if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= (Int
1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
n)
      then Result ByteStreamBuilder
forall (f :: * -> *) a. Alternative f => f a
empty
      else ByteStreamBuilder -> Result ByteStreamBuilder
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteStreamBuilder -> Result ByteStreamBuilder)
-> ByteStreamBuilder -> Result ByteStreamBuilder
forall a b. (a -> b) -> a -> b
$ Int -> Int -> ByteStreamBuilder
BSB.encodeBits Int
n Int
l