{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}

{-|
Description:    

Copyright:      (c) 2020-2021 Sam May
License:        GPL-3.0-or-later
Maintainer:     ag@eitilt.life

Stability:      stable
Portability:    non-portable (requires libcdio)
-}
module Foreign.Libcdio.CdText.Binary
    ( Info ( .. )
    , emptyCdTextRaw
    , packCdTextBlock
    , joinBlockInfo
    , checksum
    ) where


import qualified Data.Bits as B
import qualified Data.Bifunctor as F.B
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS.C
import qualified Data.Char as C
import qualified Data.List as L
import qualified Data.Maybe as Y
import qualified Data.Word as W

import qualified Data.Text as T
import qualified Data.Text.Encoding.Error as T
import qualified Data.Text.Encoding.MsJIS as T

import Data.Bits ( (.&.), (.|.) )

import Foreign.Libcdio.Track
import Foreign.Libcdio.Types.Enums

import Sound.Libcdio.Common


type TrackId = W.Word8
type PackType = W.Word8
type BlockId = Word
type BlockSize = W.Word8


-- | Textual data used for describing tracks on a disc (as well as the disc
-- itself).
data Info = Info
    { Info -> Maybe String
title      :: Maybe String
    , Info -> Maybe String
performer  :: Maybe String
    , Info -> Maybe String
songwriter :: Maybe String
    , Info -> Maybe String
composer   :: Maybe String
    , Info -> Maybe String
arranger   :: Maybe String
    , Info -> Maybe String
message    :: Maybe String
    , Info -> Maybe String
code       :: Maybe String
    }
  deriving ( Info -> Info -> Bool
(Info -> Info -> Bool) -> (Info -> Info -> Bool) -> Eq Info
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Info -> Info -> Bool
$c/= :: Info -> Info -> Bool
== :: Info -> Info -> Bool
$c== :: Info -> Info -> Bool
Eq, Int -> Info -> ShowS
[Info] -> ShowS
Info -> String
(Int -> Info -> ShowS)
-> (Info -> String) -> ([Info] -> ShowS) -> Show Info
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Info] -> ShowS
$cshowList :: [Info] -> ShowS
show :: Info -> String
$cshow :: Info -> String
showsPrec :: Int -> Info -> ShowS
$cshowsPrec :: Int -> Info -> ShowS
Show, ReadPrec [Info]
ReadPrec Info
Int -> ReadS Info
ReadS [Info]
(Int -> ReadS Info)
-> ReadS [Info] -> ReadPrec Info -> ReadPrec [Info] -> Read Info
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Info]
$creadListPrec :: ReadPrec [Info]
readPrec :: ReadPrec Info
$creadPrec :: ReadPrec Info
readList :: ReadS [Info]
$creadList :: ReadS [Info]
readsPrec :: Int -> ReadS Info
$creadsPrec :: Int -> ReadS Info
Read )


emptyCdTextRaw :: [Maybe Language] -> BS.ByteString
emptyCdTextRaw :: [Maybe Language] -> ByteString
emptyCdTextRaw [] = [Maybe Language] -> ByteString
emptyCdTextRaw [Maybe Language
forall a. Maybe a
Nothing]
emptyCdTextRaw [Maybe Language]
ls =
    [ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString)
-> (((BlockId, Maybe Language) -> [ByteString]) -> [ByteString])
-> ((BlockId, Maybe Language) -> [ByteString])
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[ByteString]] -> [ByteString]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ByteString]] -> [ByteString])
-> (((BlockId, Maybe Language) -> [ByteString]) -> [[ByteString]])
-> ((BlockId, Maybe Language) -> [ByteString])
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((BlockId, Maybe Language) -> [ByteString])
 -> [(BlockId, Maybe Language)] -> [[ByteString]])
-> [(BlockId, Maybe Language)]
-> ((BlockId, Maybe Language) -> [ByteString])
-> [[ByteString]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((BlockId, Maybe Language) -> [ByteString])
-> [(BlockId, Maybe Language)] -> [[ByteString]]
forall a b. (a -> b) -> [a] -> [b]
map ([BlockId] -> [Maybe Language] -> [(BlockId, Maybe Language)]
forall a b. [a] -> [b] -> [(a, b)]
zip [BlockId
0..] [Maybe Language]
ls) (((BlockId, Maybe Language) -> [ByteString]) -> ByteString)
-> ((BlockId, Maybe Language) -> [ByteString]) -> ByteString
forall a b. (a -> b) -> a -> b
$ \(BlockId
i, Maybe Language
_) -> (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
checksum ([ByteString] -> [ByteString])
-> ([Int] -> [ByteString]) -> [Int] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    [Maybe Language] -> [BlockSize] -> [ByteString] -> [ByteString]
joinBlockInfo [Maybe Language]
ls [BlockSize
3 | Maybe Language
_ <- [Maybe Language]
ls] ([ByteString] -> [ByteString])
-> ([Int] -> [ByteString]) -> [Int] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    BlockId
-> Encoding -> BlockSize -> BlockSize -> [Int] -> [ByteString]
generateBlockInfo BlockId
i Encoding
Iso8859_1 BlockSize
0 BlockSize
0 ([Int] -> [ByteString]) -> [Int] -> [ByteString]
forall a b. (a -> b) -> a -> b
$
    Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate Int
15 Int
0 [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
3]


data Encoding
    = Iso8859_1
    | ASCII
    | MS_JIS
  deriving ( Encoding -> Encoding -> Bool
(Encoding -> Encoding -> Bool)
-> (Encoding -> Encoding -> Bool) -> Eq Encoding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Encoding -> Encoding -> Bool
$c/= :: Encoding -> Encoding -> Bool
== :: Encoding -> Encoding -> Bool
$c== :: Encoding -> Encoding -> Bool
Eq, Eq Encoding
Eq Encoding
-> (Encoding -> Encoding -> Ordering)
-> (Encoding -> Encoding -> Bool)
-> (Encoding -> Encoding -> Bool)
-> (Encoding -> Encoding -> Bool)
-> (Encoding -> Encoding -> Bool)
-> (Encoding -> Encoding -> Encoding)
-> (Encoding -> Encoding -> Encoding)
-> Ord Encoding
Encoding -> Encoding -> Bool
Encoding -> Encoding -> Ordering
Encoding -> Encoding -> Encoding
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 :: Encoding -> Encoding -> Encoding
$cmin :: Encoding -> Encoding -> Encoding
max :: Encoding -> Encoding -> Encoding
$cmax :: Encoding -> Encoding -> Encoding
>= :: Encoding -> Encoding -> Bool
$c>= :: Encoding -> Encoding -> Bool
> :: Encoding -> Encoding -> Bool
$c> :: Encoding -> Encoding -> Bool
<= :: Encoding -> Encoding -> Bool
$c<= :: Encoding -> Encoding -> Bool
< :: Encoding -> Encoding -> Bool
$c< :: Encoding -> Encoding -> Bool
compare :: Encoding -> Encoding -> Ordering
$ccompare :: Encoding -> Encoding -> Ordering
$cp1Ord :: Eq Encoding
Ord, Encoding
Encoding -> Encoding -> Bounded Encoding
forall a. a -> a -> Bounded a
maxBound :: Encoding
$cmaxBound :: Encoding
minBound :: Encoding
$cminBound :: Encoding
Bounded, Int -> Encoding -> ShowS
[Encoding] -> ShowS
Encoding -> String
(Int -> Encoding -> ShowS)
-> (Encoding -> String) -> ([Encoding] -> ShowS) -> Show Encoding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Encoding] -> ShowS
$cshowList :: [Encoding] -> ShowS
show :: Encoding -> String
$cshow :: Encoding -> String
showsPrec :: Int -> Encoding -> ShowS
$cshowsPrec :: Int -> Encoding -> ShowS
Show, ReadPrec [Encoding]
ReadPrec Encoding
Int -> ReadS Encoding
ReadS [Encoding]
(Int -> ReadS Encoding)
-> ReadS [Encoding]
-> ReadPrec Encoding
-> ReadPrec [Encoding]
-> Read Encoding
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Encoding]
$creadListPrec :: ReadPrec [Encoding]
readPrec :: ReadPrec Encoding
$creadPrec :: ReadPrec Encoding
readList :: ReadS [Encoding]
$creadList :: ReadS [Encoding]
readsPrec :: Int -> ReadS Encoding
$creadsPrec :: Int -> ReadS Encoding
Read )
instance Enum Encoding where
    toEnum :: Int -> Encoding
toEnum Int
0x00 = Encoding
Iso8859_1
    toEnum Int
0x01 = Encoding
ASCII
    toEnum Int
0x80 = Encoding
MS_JIS
    toEnum Int
_ = Encoding
ASCII
    fromEnum :: Encoding -> Int
fromEnum Encoding
Iso8859_1 = Int
0x00
    fromEnum Encoding
ASCII = Int
0x01
    fromEnum Encoding
MS_JIS = Int
0x80

data Pack
    = TitlePack
    | PerformerPack
    | SongwriterPack
    | ComposerPack
    | ArrangerPack
    | MessagePack
    | DiscIdPack
    | GenrePack
    | TocPack
    | Toc2Pack
    | ClosedPack
    | CodePack
    | InfoPack
  deriving ( Pack -> Pack -> Bool
(Pack -> Pack -> Bool) -> (Pack -> Pack -> Bool) -> Eq Pack
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pack -> Pack -> Bool
$c/= :: Pack -> Pack -> Bool
== :: Pack -> Pack -> Bool
$c== :: Pack -> Pack -> Bool
Eq, Eq Pack
Eq Pack
-> (Pack -> Pack -> Ordering)
-> (Pack -> Pack -> Bool)
-> (Pack -> Pack -> Bool)
-> (Pack -> Pack -> Bool)
-> (Pack -> Pack -> Bool)
-> (Pack -> Pack -> Pack)
-> (Pack -> Pack -> Pack)
-> Ord Pack
Pack -> Pack -> Bool
Pack -> Pack -> Ordering
Pack -> Pack -> Pack
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 :: Pack -> Pack -> Pack
$cmin :: Pack -> Pack -> Pack
max :: Pack -> Pack -> Pack
$cmax :: Pack -> Pack -> Pack
>= :: Pack -> Pack -> Bool
$c>= :: Pack -> Pack -> Bool
> :: Pack -> Pack -> Bool
$c> :: Pack -> Pack -> Bool
<= :: Pack -> Pack -> Bool
$c<= :: Pack -> Pack -> Bool
< :: Pack -> Pack -> Bool
$c< :: Pack -> Pack -> Bool
compare :: Pack -> Pack -> Ordering
$ccompare :: Pack -> Pack -> Ordering
$cp1Ord :: Eq Pack
Ord, Pack
Pack -> Pack -> Bounded Pack
forall a. a -> a -> Bounded a
maxBound :: Pack
$cmaxBound :: Pack
minBound :: Pack
$cminBound :: Pack
Bounded, Int -> Pack
Pack -> Int
Pack -> [Pack]
Pack -> Pack
Pack -> Pack -> [Pack]
Pack -> Pack -> Pack -> [Pack]
(Pack -> Pack)
-> (Pack -> Pack)
-> (Int -> Pack)
-> (Pack -> Int)
-> (Pack -> [Pack])
-> (Pack -> Pack -> [Pack])
-> (Pack -> Pack -> [Pack])
-> (Pack -> Pack -> Pack -> [Pack])
-> Enum Pack
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Pack -> Pack -> Pack -> [Pack]
$cenumFromThenTo :: Pack -> Pack -> Pack -> [Pack]
enumFromTo :: Pack -> Pack -> [Pack]
$cenumFromTo :: Pack -> Pack -> [Pack]
enumFromThen :: Pack -> Pack -> [Pack]
$cenumFromThen :: Pack -> Pack -> [Pack]
enumFrom :: Pack -> [Pack]
$cenumFrom :: Pack -> [Pack]
fromEnum :: Pack -> Int
$cfromEnum :: Pack -> Int
toEnum :: Int -> Pack
$ctoEnum :: Int -> Pack
pred :: Pack -> Pack
$cpred :: Pack -> Pack
succ :: Pack -> Pack
$csucc :: Pack -> Pack
Enum, Int -> Pack -> ShowS
[Pack] -> ShowS
Pack -> String
(Int -> Pack -> ShowS)
-> (Pack -> String) -> ([Pack] -> ShowS) -> Show Pack
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pack] -> ShowS
$cshowList :: [Pack] -> ShowS
show :: Pack -> String
$cshow :: Pack -> String
showsPrec :: Int -> Pack -> ShowS
$cshowsPrec :: Int -> Pack -> ShowS
Show, ReadPrec [Pack]
ReadPrec Pack
Int -> ReadS Pack
ReadS [Pack]
(Int -> ReadS Pack)
-> ReadS [Pack] -> ReadPrec Pack -> ReadPrec [Pack] -> Read Pack
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Pack]
$creadListPrec :: ReadPrec [Pack]
readPrec :: ReadPrec Pack
$creadPrec :: ReadPrec Pack
readList :: ReadS [Pack]
$creadList :: ReadS [Pack]
readsPrec :: Int -> ReadS Pack
$creadsPrec :: Int -> ReadS Pack
Read )


-- | Generate the binary data representing a CDTEXT language block.
packCdTextBlock
    :: BlockId
    -> Maybe String
    -> Track
    -> Maybe Genre
    -> Maybe String
    -> Info
    -> [Info]
    -> [BS.ByteString]
packCdTextBlock :: BlockId
-> Maybe String
-> Track
-> Maybe Genre
-> Maybe String
-> Info
-> [Info]
-> [ByteString]
packCdTextBlock BlockId
blockIndex Maybe String
catalogue startTrack :: Track
startTrack@(Track TrackNum
_) Maybe Genre
genreCode Maybe String
genreName Info
disc [Info]
tracks =
    [ByteString]
allPacks [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> BlockId
-> Encoding -> BlockSize -> BlockSize -> [Int] -> [ByteString]
generateBlockInfo BlockId
blockIndex Encoding
encoding BlockSize
startTrackId BlockSize
endTrackId [Int]
allLengths
  where ([ByteString]
titles, BlockSize
tt) = (Info -> Maybe String) -> Pack -> Int -> ([ByteString], BlockSize)
forall a.
Integral a =>
(Info -> Maybe String) -> Pack -> a -> ([ByteString], BlockSize)
text Info -> Maybe String
title Pack
TitlePack (Int
0 :: Int)
        ([ByteString]
performers, BlockSize
tp) = (Info -> Maybe String) -> Pack -> Int -> ([ByteString], BlockSize)
forall a.
Integral a =>
(Info -> Maybe String) -> Pack -> a -> ([ByteString], BlockSize)
text Info -> Maybe String
performer Pack
PerformerPack Int
ip
        ([ByteString]
songwriters, BlockSize
ts) = (Info -> Maybe String) -> Pack -> Int -> ([ByteString], BlockSize)
forall a.
Integral a =>
(Info -> Maybe String) -> Pack -> a -> ([ByteString], BlockSize)
text Info -> Maybe String
songwriter Pack
SongwriterPack Int
is
        (composers, tc) = text composer ComposerPack ic
        (arrangers, ta) = text arranger ArrangerPack ia
        ([ByteString]
messages, BlockSize
tm) = (Info -> Maybe String) -> Pack -> Int -> ([ByteString], BlockSize)
forall a.
Integral a =>
(Info -> Maybe String) -> Pack -> a -> ([ByteString], BlockSize)
text Info -> Maybe String
message Pack
MessagePack Int
im
        (catalogueB, _) = pack' DiscIdPack False il (prepareSingleText ASCII catalogue, 0 :: Int)
        (genreB, _) = pack' GenrePack False ig (prepareGenre genreCode genreName, 0 :: Int)
     -- (tocB, _) = pack' TocPack False it _
     -- (toc2B, ) = pack' Toc2Pack False i2 _
     -- (closedB, ) = pack' ClosedPack False ix $ prepareSingleText Iso8859_1 _
        (codes, to) = pack' CodePack False io $ prepareText' ASCII code
        lt :: Int
lt = [ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
titles
        (Int
ip, Int
lp) = (     Int
lt, [ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
performers)
        (is, ls) = (ip + lp, length songwriters)
        (ic, lc) = (is + ls, length composers)
        (ia, la) = (ic + lc, length arrangers)
        (im, lm) = (ia + la, length messages)
        (il, ll) = (im + lm, length catalogueB)
        (ig, lg) = (il + ll, length genreB)
        (io, lo) = (ig + lg, length codes)
        allLengths :: [Int]
allLengths = [Int] -> [Int]
forall a. [a] -> [a]
reverse ([Int] -> [Int])
-> ((Int, [Int]) -> [Int]) -> (Int, [Int]) -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
3 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) ([Int] -> [Int])
-> ((Int, [Int]) -> [Int]) -> (Int, [Int]) -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, [Int]) -> [Int]
forall a b. (a, b) -> b
snd ((Int, [Int]) -> [Int]) -> (Int, [Int]) -> [Int]
forall a b. (a -> b) -> a -> b
$ ((Int, [Int]) -> Int -> (Int, [Int]))
-> (Int, [Int]) -> [Int] -> (Int, [Int])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl'
            (\(Int
acc, [Int]
as) Int
a -> if Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0xFC then (Int
0xFC, (Int
0xFC Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
acc) Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
as) else (Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
a, Int
a Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
as))
            (Int
0, [])
            [Int
lt, Int
lp, Int
ls, Int
lc, Int
la, Int
lm, Int
ll, Int
lg, Int
0, Int
0, Int
0, Int
0, Int
0, Int
0, Int
lo]
        allPacks :: [ByteString]
allPacks = Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
take Int
0xFC
             ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ [ByteString]
titles
            [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ByteString]
performers
            [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ByteString]
songwriters
            [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ByteString]
composers
            [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ByteString]
arrangers
            [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ByteString]
messages
            [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ByteString]
catalogueB
            [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ByteString]
genreB
            [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ByteString]
codes
        encoding :: Encoding
encoding = [String] -> Encoding
guessEncoding ([String] -> Encoding)
-> ([[Maybe String]] -> [String]) -> [[Maybe String]] -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
Y.catMaybes ([Maybe String] -> [String])
-> ([[Maybe String]] -> [Maybe String])
-> [[Maybe String]]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Maybe String]] -> [Maybe String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Maybe String]] -> Encoding) -> [[Maybe String]] -> Encoding
forall a b. (a -> b) -> a -> b
$ Info -> [Maybe String]
infoList Info
disc [Maybe String] -> [[Maybe String]] -> [[Maybe String]]
forall a. a -> [a] -> [a]
: (Info -> [Maybe String]) -> [Info] -> [[Maybe String]]
forall a b. (a -> b) -> [a] -> [b]
map Info -> [Maybe String]
infoList [Info]
tracks
        wideChars :: Bool
wideChars = Encoding
encoding Encoding -> Encoding -> Bool
forall a. Eq a => a -> a -> Bool
== Encoding
MS_JIS
        infoList :: Info -> [Maybe String]
infoList Info
i = [Info -> Maybe String
f Info
i | Info -> Maybe String
f <- [Info -> Maybe String
title, Info -> Maybe String
performer, Info -> Maybe String
songwriter, Info -> Maybe String
composer, Info -> Maybe String
arranger, Info -> Maybe String
message, Info -> Maybe String
code]]
        startTrackId :: BlockSize
startTrackId = Int -> BlockSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> BlockSize) -> Int -> BlockSize
forall a b. (a -> b) -> a -> b
$ Track -> Int
forall a. Enum a => a -> Int
fromEnum Track
startTrack
        endTrackId :: BlockSize
endTrackId = (BlockSize -> BlockSize -> BlockSize)
-> BlockSize -> [BlockSize] -> BlockSize
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr BlockSize -> BlockSize -> BlockSize
forall a. Ord a => a -> a -> a
max BlockSize
0 [BlockSize
tt, BlockSize
tp, BlockSize
ts, BlockSize
tc, BlockSize
ta, BlockSize
tm, BlockSize
to]
        text :: (Info -> Maybe String) -> Pack -> a -> ([ByteString], BlockSize)
text Info -> Maybe String
f Pack
p a
i = ([(BlockSize, ByteString)] -> [ByteString])
-> ([(BlockSize, ByteString)], BlockSize)
-> ([ByteString], BlockSize)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
F.B.first (Pack
-> Bool
-> BlockId
-> BlockSize
-> [(BlockSize, ByteString)]
-> [ByteString]
pack Pack
p Bool
wideChars BlockId
blockIndex (BlockSize -> [(BlockSize, ByteString)] -> [ByteString])
-> BlockSize -> [(BlockSize, ByteString)] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ a -> BlockSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i) (([(BlockSize, ByteString)], BlockSize)
 -> ([ByteString], BlockSize))
-> ([(BlockSize, ByteString)], BlockSize)
-> ([ByteString], BlockSize)
forall a b. (a -> b) -> a -> b
$
            Encoding
-> (Info -> Maybe String) -> ([(BlockSize, ByteString)], BlockSize)
prepareText' Encoding
encoding Info -> Maybe String
f
        prepareSingleText :: Encoding -> Maybe String -> [(a, ByteString)]
prepareSingleText Encoding
_ Maybe String
Nothing = []
        prepareSingleText Encoding
e (Just String
t) = (\ByteString
t' -> [(a
0, ByteString
t')]) (ByteString -> [(a, ByteString)])
-> ByteString -> [(a, ByteString)]
forall a b. (a -> b) -> a -> b
$ Encoding -> String -> ByteString
encodeText Encoding
e String
t
        prepareText' :: Encoding
-> (Info -> Maybe String) -> ([(BlockSize, ByteString)], BlockSize)
prepareText' Encoding
e Info -> Maybe String
f = ([(BlockSize, ByteString)]
t', ((BlockSize, ByteString) -> BlockSize -> BlockSize)
-> BlockSize -> [(BlockSize, ByteString)] -> BlockSize
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (BlockSize -> BlockSize -> BlockSize
forall a. Ord a => a -> a -> a
max (BlockSize -> BlockSize -> BlockSize)
-> ((BlockSize, ByteString) -> BlockSize)
-> (BlockSize, ByteString)
-> BlockSize
-> BlockSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BlockSize, ByteString) -> BlockSize
forall a b. (a, b) -> a
fst) BlockSize
0 [(BlockSize, ByteString)]
t')
          where t' :: [(BlockSize, ByteString)]
t' = Encoding
-> BlockSize
-> Maybe String
-> [Maybe String]
-> [(BlockSize, ByteString)]
prepareText Encoding
e BlockSize
startTrackId (Info -> Maybe String
f Info
disc) ((Info -> Maybe String) -> [Info] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
map Info -> Maybe String
f [Info]
tracks)
        pack' :: Pack
-> Bool -> a -> p [(BlockSize, ByteString)] c -> p [ByteString] c
pack' Pack
p Bool
w a
i = ([(BlockSize, ByteString)] -> [ByteString])
-> p [(BlockSize, ByteString)] c -> p [ByteString] c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
F.B.first (([(BlockSize, ByteString)] -> [ByteString])
 -> p [(BlockSize, ByteString)] c -> p [ByteString] c)
-> (BlockSize -> [(BlockSize, ByteString)] -> [ByteString])
-> BlockSize
-> p [(BlockSize, ByteString)] c
-> p [ByteString] c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pack
-> Bool
-> BlockId
-> BlockSize
-> [(BlockSize, ByteString)]
-> [ByteString]
pack Pack
p Bool
w BlockId
blockIndex (BlockSize -> p [(BlockSize, ByteString)] c -> p [ByteString] c)
-> BlockSize -> p [(BlockSize, ByteString)] c -> p [ByteString] c
forall a b. (a -> b) -> a -> b
$ a -> BlockSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i
packCdTextBlock BlockId
blockIndex Maybe String
catalogue Track
DiscPregap Maybe Genre
genreCode Maybe String
genreName Info
_ [Info]
tracks =
    BlockId
-> Maybe String
-> Track
-> Maybe Genre
-> Maybe String
-> Info
-> [Info]
-> [ByteString]
packCdTextBlock BlockId
blockIndex Maybe String
catalogue Track
1 Maybe Genre
genreCode Maybe String
genreName Info
disc [Info]
tracks'
  where (Info
disc, [Info]
tracks') = case [Info]
tracks of
            [] -> (Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> Info
Info Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing, [])
            (Info
t:[Info]
ts) -> (Info
t, [Info]
ts)
packCdTextBlock BlockId
blockIndex Maybe String
catalogue Track
DiscLeadout Maybe Genre
genreCode Maybe String
genreName Info
disc [Info]
_ =
    BlockId
-> Maybe String
-> Track
-> Maybe Genre
-> Maybe String
-> Info
-> [Info]
-> [ByteString]
packCdTextBlock BlockId
blockIndex Maybe String
catalogue Track
1 Maybe Genre
genreCode Maybe String
genreName Info
disc []

-- | Generate the local block info.  Note that this does /not/ result in full
-- payloads for the last two packs; @packInfo@ adds them automatically.
generateBlockInfo :: BlockId -> Encoding -> TrackId -> TrackId -> [Int] -> [BS.ByteString]
generateBlockInfo :: BlockId
-> Encoding -> BlockSize -> BlockSize -> [Int] -> [ByteString]
generateBlockInfo BlockId
blockIndex Encoding
encoding BlockSize
startTrack BlockSize
endTrack [Int]
lengths =
    Pack
-> Bool
-> BlockId
-> BlockSize
-> [(BlockSize, ByteString)]
-> [ByteString]
pack Pack
InfoPack Bool
False BlockId
blockIndex (Int -> BlockSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> BlockSize) -> Int -> BlockSize
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
lengths Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3) ([(BlockSize, ByteString)] -> [ByteString])
-> ([BlockSize] -> [(BlockSize, ByteString)])
-> [BlockSize]
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [BlockSize] -> [(BlockSize, ByteString)]
forall a. Num a => [BlockSize] -> [(a, ByteString)]
packTuple ([BlockSize] -> [ByteString]) -> [BlockSize] -> [ByteString]
forall a b. (a -> b) -> a -> b
$
        [Int -> BlockSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> BlockSize) -> Int -> BlockSize
forall a b. (a -> b) -> a -> b
$ Encoding -> Int
forall a. Enum a => a -> Int
fromEnum Encoding
encoding, BlockSize
startTrack, BlockSize
endTrack, BlockSize
0x00] [BlockSize] -> [BlockSize] -> [BlockSize]
forall a. [a] -> [a] -> [a]
++
        Int -> [BlockSize] -> [BlockSize]
forall a. Int -> [a] -> [a]
take Int
16 ((Int -> BlockSize) -> [Int] -> [BlockSize]
forall a b. (a -> b) -> [a] -> [b]
map Int -> BlockSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int]
lengths [BlockSize] -> [BlockSize] -> [BlockSize]
forall a. [a] -> [a] -> [a]
++ BlockSize -> [BlockSize]
forall a. a -> [a]
repeat BlockSize
0)
  where packTuple :: [BlockSize] -> [(a, ByteString)]
packTuple [BlockSize]
bs = [(a
0, [BlockSize] -> ByteString
BS.pack [BlockSize]
bs)]


-- | Use the minimal encoding based on the characters used by the strings.  If
-- any character outside ISO 8859-1 ("Latin-1") is found, 'MS_JIS' is used as a
-- fallback; this isn't strictly comprehensive, but it is a lot harder to test
-- for (i.e. I'd have to write a function for it).
guessEncoding :: [String] -> Encoding
guessEncoding :: [String] -> Encoding
guessEncoding [] = Encoding
Iso8859_1
guessEncoding [String]
ts
    | (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
C.isAscii) [String]
ts = Encoding
ASCII
    | (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
C.isLatin1) [String]
ts = Encoding
Iso8859_1
    | Bool
otherwise = Encoding
MS_JIS


-- | Collapse the track texts to their minimal size if allowed (if present for
-- disc-level info, all tracks must be represented).
prepareText :: Encoding -> TrackId -> Maybe String -> [Maybe String] -> [(TrackId, BS.ByteString)]
prepareText :: Encoding
-> BlockSize
-> Maybe String
-> [Maybe String]
-> [(BlockSize, ByteString)]
prepareText Encoding
e BlockSize
_ (Just String
d) [] = [(BlockSize
0, Encoding -> String -> ByteString
encodeText Encoding
e String
d)]
prepareText Encoding
e BlockSize
i d' :: Maybe String
d'@(Just String
d) ta :: [Maybe String]
ta@(Maybe String
t:[Maybe String]
_)
    | Maybe String
d' Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe String
t = case Encoding
-> BlockSize -> [Maybe String] -> [(BlockSize, ByteString)]
prepareTrackTexts Encoding
e BlockSize
i' ([Maybe String] -> [(BlockSize, ByteString)])
-> [Maybe String] -> [(BlockSize, ByteString)]
forall a b. (a -> b) -> a -> b
$ Maybe String
d' Maybe String -> [Maybe String] -> [Maybe String]
forall a. a -> [a] -> [a]
: [Maybe String] -> [Maybe String]
forall a. [Maybe a] -> [Maybe a]
trim [Maybe String]
ta of
        [] -> []
        ((BlockSize
_, ByteString
bs):[(BlockSize, ByteString)]
bss) -> (BlockSize
0, ByteString
bs) (BlockSize, ByteString)
-> [(BlockSize, ByteString)] -> [(BlockSize, ByteString)]
forall a. a -> [a] -> [a]
: [(BlockSize, ByteString)]
bss
    | Bool
otherwise = (BlockSize
0, Encoding -> String -> ByteString
encodeText Encoding
e String
d) (BlockSize, ByteString)
-> [(BlockSize, ByteString)] -> [(BlockSize, ByteString)]
forall a. a -> [a] -> [a]
: (BlockSize -> [Maybe String] -> [(BlockSize, ByteString)])
-> (BlockSize, [Maybe String]) -> [(BlockSize, ByteString)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Encoding
-> BlockSize -> [Maybe String] -> [(BlockSize, ByteString)]
prepareTrackTexts Encoding
e) (BlockSize -> [Maybe String] -> (BlockSize, [Maybe String])
trimTexts BlockSize
i [Maybe String]
ta)
  where trim :: [Maybe a] -> [Maybe a]
trim = (Maybe a -> Bool) -> [Maybe a] -> [Maybe a]
forall a. (a -> Bool) -> [a] -> [a]
L.dropWhileEnd Maybe a -> Bool
forall a. Maybe a -> Bool
Y.isNothing ([Maybe a] -> [Maybe a])
-> ([Maybe a] -> [Maybe a]) -> [Maybe a] -> [Maybe a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe a -> Bool) -> [Maybe a] -> [Maybe a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Maybe a -> Bool
forall a. Maybe a -> Bool
Y.isNothing
        i' :: BlockSize
i' = BlockSize
i BlockSize -> BlockSize -> BlockSize
forall a. Num a => a -> a -> a
- BlockSize
1 BlockSize -> BlockSize -> BlockSize
forall a. Num a => a -> a -> a
+ Int -> BlockSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Maybe String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Maybe String] -> Int) -> [Maybe String] -> Int
forall a b. (a -> b) -> a -> b
$ (Maybe String -> Bool) -> [Maybe String] -> [Maybe String]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Maybe String -> Bool
forall a. Maybe a -> Bool
Y.isNothing [Maybe String]
ta)
{- This block forces track info if it's present for the disc, as required by
 - the libcdio docs.  It doesn't look like that's actually required in these
 - references, but I don't trust them enough to take it out entirely.
prepareText e i d'@(Just d) ta@(t:_)
    | d' == t = case prepareTrackTexts e (i - 1) $ d' : ta of
        [] -> []
        ((_, bs):bss) -> (0, bs) : bss
    | otherwise = (0, encodeText e d) : prepareTrackTexts e i ta
-}
prepareText Encoding
e BlockSize
i Maybe String
Nothing [Maybe String]
ts = (BlockSize -> [Maybe String] -> [(BlockSize, ByteString)])
-> (BlockSize, [Maybe String]) -> [(BlockSize, ByteString)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Encoding
-> BlockSize -> [Maybe String] -> [(BlockSize, ByteString)]
prepareTrackTexts Encoding
e) ((BlockSize, [Maybe String]) -> [(BlockSize, ByteString)])
-> (BlockSize, [Maybe String]) -> [(BlockSize, ByteString)]
forall a b. (a -> b) -> a -> b
$ BlockSize -> [Maybe String] -> (BlockSize, [Maybe String])
trimTexts BlockSize
i [Maybe String]
ts

trimTexts :: TrackId -> [Maybe String] -> (TrackId, [Maybe String])
trimTexts :: BlockSize -> [Maybe String] -> (BlockSize, [Maybe String])
trimTexts BlockSize
i' [] = (BlockSize
i', [])
trimTexts BlockSize
i' (Maybe String
Nothing:[Maybe String]
ts') = BlockSize -> [Maybe String] -> (BlockSize, [Maybe String])
trimTexts (BlockSize
i' BlockSize -> BlockSize -> BlockSize
forall a. Num a => a -> a -> a
+ BlockSize
1) [Maybe String]
ts'
trimTexts BlockSize
i' [Maybe String]
ts' = (BlockSize
i', (Maybe String -> Bool) -> [Maybe String] -> [Maybe String]
forall a. (a -> Bool) -> [a] -> [a]
L.dropWhileEnd Maybe String -> Bool
forall a. Maybe a -> Bool
Y.isNothing [Maybe String]
ts')

-- | Collapse the texts further by making use of the tab-replacement shortcut
-- for repeated values.
prepareTrackTexts :: Encoding -> TrackId -> [Maybe String] -> [(TrackId, BS.ByteString)]
prepareTrackTexts :: Encoding
-> BlockSize -> [Maybe String] -> [(BlockSize, ByteString)]
prepareTrackTexts Encoding
_ BlockSize
_ [] = []
prepareTrackTexts Encoding
e BlockSize
i [Maybe String]
ts = Encoding -> BlockSize -> [String] -> [(BlockSize, ByteString)]
encodeTrackTexts Encoding
e BlockSize
i ([String] -> [(BlockSize, ByteString)])
-> ([String] -> [String]) -> [String] -> [(BlockSize, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [(BlockSize, ByteString)])
-> [String] -> [(BlockSize, ByteString)]
forall a b. (a -> b) -> a -> b
$ ([String] -> Maybe String -> [String])
-> [String] -> [Maybe String] -> [String]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' [String] -> Maybe String -> [String]
forall a. (IsString a, Eq a) => [a] -> Maybe a -> [a]
deduplicate [] [Maybe String]
ts
  where deduplicate :: [a] -> Maybe a -> [a]
deduplicate [] (Just a
s) = [a
s]
        deduplicate [a]
ts' Maybe a
Nothing = a
"" a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ts'
        deduplicate [a]
ts' (Just a
s) =
            let ss :: [a]
ss = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
s) [a]
ts'
            in  a
s a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> a
forall a b. a -> b -> a
const a
"\t") [a]
ss [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
deduplicate' (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ss) [a]
ts')
        deduplicate' :: [a] -> [a]
deduplicate' [] = []
        deduplicate' (a
t':[a]
ts') = [a] -> Maybe a -> [a]
deduplicate [a]
ts' (Maybe a -> [a]) -> Maybe a -> [a]
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
t'

-- | Combine the genre code and description into a single bytestring.
prepareGenre :: Maybe Genre -> Maybe String -> [(TrackId, BS.ByteString)]
prepareGenre :: Maybe Genre -> Maybe String -> [(BlockSize, ByteString)]
prepareGenre Maybe Genre
Nothing Maybe String
Nothing = []
prepareGenre Maybe Genre
gc Maybe String
gt = [(BlockSize
0, Maybe Genre -> ByteString
encodeGenre Maybe Genre
gc ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Encoding -> String -> ByteString
encodeText Encoding
ASCII (String -> Maybe String -> String
forall a. a -> Maybe a -> a
Y.fromMaybe String
"" Maybe String
gt))]


-- | Conduct text to the proper encoder and append the proper terminator.
encodeText :: Encoding -> String -> BS.ByteString
encodeText :: Encoding -> String -> ByteString
encodeText Encoding
MS_JIS String
"\t" = [BlockSize] -> ByteString
BS.pack [BlockSize
0x09,BlockSize
0x09,BlockSize
0x00,BlockSize
0x00]
encodeText Encoding
ASCII String
t = (BlockSize -> BlockSize) -> ByteString -> ByteString
BS.map (BlockSize -> BlockSize -> BlockSize
forall a. Bits a => a -> a -> a
.&. BlockSize
0x7F) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Encoding -> String -> ByteString
encodeText Encoding
Iso8859_1 String
t
encodeText Encoding
Iso8859_1 String
t = String -> ByteString
BS.C.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'\NUL']
encodeText Encoding
MS_JIS String
t = OnError Char ByteString -> Text -> ByteString
T.encodeMsJISWith OnError Char ByteString
forall a b. OnError a b
T.ignore (String -> Text
T.pack String
t) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
BS.C.pack [Char
'\NUL', Char
'\NUL']

-- | Encode all members of a given textual category, pairing them with their
-- track index or 0 if one applies to the disc as a whole.
encodeTrackTexts :: Encoding -> TrackId -> [String] -> [(TrackId, BS.ByteString)]
encodeTrackTexts :: Encoding -> BlockSize -> [String] -> [(BlockSize, ByteString)]
encodeTrackTexts Encoding
e BlockSize
i [String]
ts = [BlockSize] -> [ByteString] -> [(BlockSize, ByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [BlockSize
i ..] ([ByteString] -> [(BlockSize, ByteString)])
-> [ByteString] -> [(BlockSize, ByteString)]
forall a b. (a -> b) -> a -> b
$ (String -> ByteString) -> [String] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (Encoding -> String -> ByteString
encodeText Encoding
e) [String]
ts

-- | Store the genre code in a two-byte string.
encodeGenre :: Maybe Genre -> BS.ByteString
encodeGenre :: Maybe Genre -> ByteString
encodeGenre Maybe Genre
g = [BlockSize] -> ByteString
BS.pack [BlockSize
gh, BlockSize
gc]
  where gc :: BlockSize
gc = BlockSize -> (Genre -> BlockSize) -> Maybe Genre -> BlockSize
forall b a. b -> (a -> b) -> Maybe a -> b
maybe BlockSize
0x00 (Int -> BlockSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> BlockSize) -> (Genre -> Int) -> Genre -> BlockSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Genre -> Int
forall a. Enum a => a -> Int
fromEnum) Maybe Genre
g
        -- Futureproofing decades-old technology
        gh :: BlockSize
gh = if BlockSize
gc BlockSize -> BlockSize -> Bool
forall a. Ord a => a -> a -> Bool
<= BlockSize
0xFF then BlockSize
0x00 else BlockSize -> Int -> BlockSize
forall a. Bits a => a -> Int -> a
B.shiftR BlockSize
gc Int
8


-- | Prevent index overflow for any single pack type.
pack :: Pack -> Bool -> BlockId -> BlockSize -> [(TrackId, BS.ByteString)] -> [BS.ByteString]
pack :: Pack
-> Bool
-> BlockId
-> BlockSize
-> [(BlockSize, ByteString)]
-> [ByteString]
pack Pack
p Bool
w BlockId
b BlockSize
i [(BlockSize, ByteString)]
bss = Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
take Int
0xFF ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Pack
-> Bool
-> BlockId
-> BlockSize
-> [(BlockSize, ByteString)]
-> [ByteString]
pack_ Pack
p Bool
w BlockId
b BlockSize
i [(BlockSize, ByteString)]
bss

-- | Conduct binary data and starting track to the proper packers.
pack_ :: Pack -> Bool -> BlockId -> BlockSize -> [(TrackId, BS.ByteString)] -> [BS.ByteString]
pack_ :: Pack
-> Bool
-> BlockId
-> BlockSize
-> [(BlockSize, ByteString)]
-> [ByteString]
pack_ Pack
TitlePack = BlockSize
-> Bool
-> BlockId
-> BlockSize
-> [(BlockSize, ByteString)]
-> [ByteString]
packText BlockSize
0x80
pack_ Pack
PerformerPack = BlockSize
-> Bool
-> BlockId
-> BlockSize
-> [(BlockSize, ByteString)]
-> [ByteString]
packText BlockSize
0x81
pack_ Pack
SongwriterPack = BlockSize
-> Bool
-> BlockId
-> BlockSize
-> [(BlockSize, ByteString)]
-> [ByteString]
packText BlockSize
0x82
pack_ Pack
ComposerPack = BlockSize
-> Bool
-> BlockId
-> BlockSize
-> [(BlockSize, ByteString)]
-> [ByteString]
packText BlockSize
0x83
pack_ Pack
ArrangerPack = BlockSize
-> Bool
-> BlockId
-> BlockSize
-> [(BlockSize, ByteString)]
-> [ByteString]
packText BlockSize
0x84
pack_ Pack
MessagePack = BlockSize
-> Bool
-> BlockId
-> BlockSize
-> [(BlockSize, ByteString)]
-> [ByteString]
packText BlockSize
0x85
pack_ Pack
DiscIdPack = BlockSize
-> Bool
-> BlockId
-> BlockSize
-> [(BlockSize, ByteString)]
-> [ByteString]
packText BlockSize
0x86
pack_ Pack
GenrePack = Bool
-> BlockId
-> BlockSize
-> [(BlockSize, ByteString)]
-> [ByteString]
packGenre
pack_ Pack
ClosedPack = BlockSize
-> Bool
-> BlockId
-> BlockSize
-> [(BlockSize, ByteString)]
-> [ByteString]
packText BlockSize
0x8D
pack_ Pack
TocPack = [ByteString]
-> Bool
-> BlockId
-> BlockSize
-> [(BlockSize, ByteString)]
-> [ByteString]
forall a b c d e. a -> b -> c -> d -> e -> a
const4 []
pack_ Pack
Toc2Pack = [ByteString]
-> Bool
-> BlockId
-> BlockSize
-> [(BlockSize, ByteString)]
-> [ByteString]
forall a b c d e. a -> b -> c -> d -> e -> a
const4 []
pack_ Pack
CodePack = BlockSize
-> Bool
-> BlockId
-> BlockSize
-> [(BlockSize, ByteString)]
-> [ByteString]
packText BlockSize
0x8E
pack_ Pack
InfoPack = Bool
-> BlockId
-> BlockSize
-> [(BlockSize, ByteString)]
-> [ByteString]
packBlockInfo

const4 :: a -> b -> c -> d -> e -> a
const4 :: a -> b -> c -> d -> e -> a
const4 a
a b
_ c
_ d
_ e
_ = a
a

packText
    :: PackType
    -> Bool
    -> BlockId
    -> BlockSize
    -> [(TrackId, BS.ByteString)] -> [BS.ByteString]
packText :: BlockSize
-> Bool
-> BlockId
-> BlockSize
-> [(BlockSize, ByteString)]
-> [ByteString]
packText BlockSize
p Bool
w BlockId
b BlockSize
i [(BlockSize, ByteString)]
bss = (BlockSize -> (BlockSize, BlockId, ByteString) -> ByteString)
-> [BlockSize]
-> [(BlockSize, BlockId, ByteString)]
-> [ByteString]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (((BlockSize, (BlockSize, BlockId, ByteString)) -> ByteString)
-> BlockSize -> (BlockSize, BlockId, ByteString) -> ByteString
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((BlockSize, (BlockSize, BlockId, ByteString)) -> ByteString)
 -> BlockSize -> (BlockSize, BlockId, ByteString) -> ByteString)
-> ((BlockSize, (BlockSize, BlockId, ByteString)) -> ByteString)
-> BlockSize
-> (BlockSize, BlockId, ByteString)
-> ByteString
forall a b. (a -> b) -> a -> b
$ BlockSize
-> Bool
-> BlockId
-> (BlockSize, (BlockSize, BlockId, ByteString))
-> ByteString
addHeader BlockSize
p Bool
w BlockId
b) [BlockSize
i ..] ([(BlockSize, BlockId, ByteString)] -> [ByteString])
-> ([(BlockSize, BlockId, ByteString)]
    -> [(BlockSize, BlockId, ByteString)])
-> [(BlockSize, BlockId, ByteString)]
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    [(BlockSize, BlockId, ByteString)]
-> [(BlockSize, BlockId, ByteString)]
forall a. [a] -> [a]
reverse ([(BlockSize, BlockId, ByteString)] -> [ByteString])
-> [(BlockSize, BlockId, ByteString)] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ([(BlockSize, BlockId, ByteString)]
 -> (BlockSize, ByteString) -> [(BlockSize, BlockId, ByteString)])
-> [(BlockSize, BlockId, ByteString)]
-> [(BlockSize, ByteString)]
-> [(BlockSize, BlockId, ByteString)]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' [(BlockSize, BlockId, ByteString)]
-> (BlockSize, ByteString) -> [(BlockSize, BlockId, ByteString)]
splitText [] [(BlockSize, ByteString)]
bss

packGenre :: Bool -> BlockId -> BlockSize -> [(TrackId, BS.ByteString)] -> [BS.ByteString]
packGenre :: Bool
-> BlockId
-> BlockSize
-> [(BlockSize, ByteString)]
-> [ByteString]
packGenre Bool
_ BlockId
_ BlockSize
_ [] = []
packGenre Bool
w BlockId
b BlockSize
i ((BlockSize
_, ByteString
bs):[(BlockSize, ByteString)]
_) = (BlockSize -> (BlockSize, BlockId, ByteString) -> ByteString)
-> [BlockSize]
-> [(BlockSize, BlockId, ByteString)]
-> [ByteString]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (((BlockSize, (BlockSize, BlockId, ByteString)) -> ByteString)
-> BlockSize -> (BlockSize, BlockId, ByteString) -> ByteString
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((BlockSize, (BlockSize, BlockId, ByteString)) -> ByteString)
 -> BlockSize -> (BlockSize, BlockId, ByteString) -> ByteString)
-> ((BlockSize, (BlockSize, BlockId, ByteString)) -> ByteString)
-> BlockSize
-> (BlockSize, BlockId, ByteString)
-> ByteString
forall a b. (a -> b) -> a -> b
$ BlockSize
-> Bool
-> BlockId
-> (BlockSize, (BlockSize, BlockId, ByteString))
-> ByteString
addHeader BlockSize
0x87 Bool
w BlockId
b) [BlockSize
i ..] ([(BlockSize, BlockId, ByteString)] -> [ByteString])
-> [(BlockSize, BlockId, ByteString)] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> [(BlockSize, BlockId, ByteString)]
splitGenre ByteString
bs

-- | Create the skeleton block info packs, leaving out counts and languages.
packBlockInfo :: Bool -> BlockId -> BlockSize -> [(TrackId, BS.ByteString)] -> [BS.ByteString]
packBlockInfo :: Bool
-> BlockId
-> BlockSize
-> [(BlockSize, ByteString)]
-> [ByteString]
packBlockInfo Bool
w BlockId
b BlockSize
i [] =
    [ BlockSize
-> Bool
-> BlockId
-> (BlockSize, (BlockSize, BlockId, ByteString))
-> ByteString
addHeader BlockSize
0x8F Bool
w BlockId
b (BlockSize
i BlockSize -> BlockSize -> BlockSize
forall a. Num a => a -> a -> a
+ BlockSize
p, (BlockSize
p, BlockId
0, ByteString
BS.empty))
    | BlockSize
p <- [BlockSize
0 .. BlockSize
2]
    ]
packBlockInfo Bool
w BlockId
b BlockSize
i ((BlockSize
_, ByteString
bs):[(BlockSize, ByteString)]
_) =
    [ BlockSize
-> Bool
-> BlockId
-> (BlockSize, (BlockSize, BlockId, ByteString))
-> ByteString
addHeader BlockSize
0x8F Bool
w BlockId
b (BlockSize
i, (BlockSize
0, BlockId
0, ByteString
p1))
    , BlockSize
-> Bool
-> BlockId
-> (BlockSize, (BlockSize, BlockId, ByteString))
-> ByteString
addHeader BlockSize
0x8F Bool
w BlockId
b (BlockSize
i BlockSize -> BlockSize -> BlockSize
forall a. Num a => a -> a -> a
+ BlockSize
1, (BlockSize
1, BlockId
0, ByteString
p2))
    , BlockSize
-> Bool
-> BlockId
-> (BlockSize, (BlockSize, BlockId, ByteString))
-> ByteString
addHeader BlockSize
0x8F Bool
w BlockId
b (BlockSize
i BlockSize -> BlockSize -> BlockSize
forall a. Num a => a -> a -> a
+ BlockSize
2, (BlockSize
2, BlockId
0, ByteString
BS.empty))
    ]
  where (ByteString
p1, ByteString
p2) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
12 ByteString
bs

-- | Generate the four-byte identifying and metadata-carrying header.
-- 
-- NOTE: While the libcdio documentation on the CDTEXT format says that byte 3
-- (@l'@) is 15 if the text starts at any point before the previous pack,
-- that's not the case in any of my (admittedly limited and unverified)
-- reference blobs: it's capped at 15, yes, but if one pack has two characters,
-- the next has the full twelve, and the text still continues into a third,
-- that third will have a third byte of 14.
addHeader
    :: PackType
        -- ^ Pack type
    -> Bool
        -- ^ Two-byte characters?
    -> BlockId
        -- ^ Language index
    -> (BlockSize, (TrackId, Word, BS.ByteString))
                        -- ^ Starting pack index, track number, characters in previous block, and payload
    -> BS.ByteString
addHeader :: BlockSize
-> Bool
-> BlockId
-> (BlockSize, (BlockSize, BlockId, ByteString))
-> ByteString
addHeader BlockSize
p Bool
w BlockId
b (BlockSize
i, (BlockSize
t, BlockId
l, ByteString
bs)) = [BlockSize] -> ByteString
BS.pack [BlockSize
p, BlockSize
t, BlockSize
i, BlockSize
f] ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bs
  where l' :: BlockSize
l' = if BlockId
l BlockId -> BlockId -> Bool
forall a. Ord a => a -> a -> Bool
> BlockId
15 then BlockSize
0x0F else BlockSize
0x0F BlockSize -> BlockSize -> BlockSize
forall a. Bits a => a -> a -> a
.&. BlockId -> BlockSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral BlockId
l
        b' :: BlockSize
b' = BlockSize
0x70 BlockSize -> BlockSize -> BlockSize
forall a. Bits a => a -> a -> a
.&. BlockSize -> Int -> BlockSize
forall a. Bits a => a -> Int -> a
B.shiftL (BlockId -> BlockSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral BlockId
b) Int
4
        w' :: BlockSize
w' = if Bool
w then BlockSize
0x80 else BlockSize
0x00
        f :: BlockSize
f = BlockSize
w' BlockSize -> BlockSize -> BlockSize
forall a. Bits a => a -> a -> a
.|. BlockSize
b' BlockSize -> BlockSize -> BlockSize
forall a. Bits a => a -> a -> a
.|. BlockSize
l'

-- | Takes tuples of (track index, track data) and adds them (initial track,
-- initial length in previous packs, packed data), where the packed data is
-- /no more than/ 12 bytes long.  Note that the final list will have to be
-- 'reverse'd.
splitText :: [(TrackId, Word, BS.ByteString)] -> (TrackId, BS.ByteString) -> [(TrackId, Word, BS.ByteString)]
splitText :: [(BlockSize, BlockId, ByteString)]
-> (BlockSize, ByteString) -> [(BlockSize, BlockId, ByteString)]
splitText [] bst :: (BlockSize, ByteString)
bst@(BlockSize
t, ByteString
_) = [(BlockSize, BlockId, ByteString)]
-> (BlockSize, ByteString) -> [(BlockSize, BlockId, ByteString)]
splitText [(BlockSize
t, BlockId
0, ByteString
BS.empty)] (BlockSize, ByteString)
bst
splitText csa :: [(BlockSize, BlockId, ByteString)]
csa@((BlockSize
u, BlockId
l, ByteString
cs):[(BlockSize, BlockId, ByteString)]
css) (BlockSize
t, ByteString
bs)
    | BlockId
cl BlockId -> BlockId -> Bool
forall a. Eq a => a -> a -> Bool
== BlockId
12 =
        [ (BlockSize
t, BlockId
l', ByteString
bs')
        | (BlockId
l', ByteString
bs') <- [(BlockId, ByteString)] -> [(BlockId, ByteString)]
forall a. [a] -> [a]
reverse ([(BlockId, ByteString)] -> [(BlockId, ByteString)])
-> ([ByteString] -> [(BlockId, ByteString)])
-> [ByteString]
-> [(BlockId, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [BlockId] -> [ByteString] -> [(BlockId, ByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [BlockId
0, BlockId
12 ..] ([ByteString] -> [(BlockId, ByteString)])
-> [ByteString] -> [(BlockId, ByteString)]
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> [ByteString]
splitAtEvery Int
12 ByteString
bs
        ] [(BlockSize, BlockId, ByteString)]
-> [(BlockSize, BlockId, ByteString)]
-> [(BlockSize, BlockId, ByteString)]
forall a. [a] -> [a] -> [a]
++ [(BlockSize, BlockId, ByteString)]
csa
    -- Will have incorrect t, l' if @BS.length cs > 12@, but as that shouldn't
    -- happen anyway, it's not an issue.
    | Bool
otherwise =
        let (ByteString
cs':[ByteString]
bss) = Int -> ByteString -> [ByteString]
splitAtEvery Int
12 (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString
cs ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bs
        in  [ (BlockSize
t, BlockId
l', ByteString
bs')
            | (BlockId
l', ByteString
bs') <- [(BlockId, ByteString)] -> [(BlockId, ByteString)]
forall a. [a] -> [a]
reverse ([(BlockId, ByteString)] -> [(BlockId, ByteString)])
-> [(BlockId, ByteString)] -> [(BlockId, ByteString)]
forall a b. (a -> b) -> a -> b
$ [BlockId] -> [ByteString] -> [(BlockId, ByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(BlockId
12 BlockId -> BlockId -> BlockId
forall a. Num a => a -> a -> a
- BlockId
cl), (BlockId
24 BlockId -> BlockId -> BlockId
forall a. Num a => a -> a -> a
- BlockId
cl) ..] [ByteString]
bss
            ] [(BlockSize, BlockId, ByteString)]
-> [(BlockSize, BlockId, ByteString)]
-> [(BlockSize, BlockId, ByteString)]
forall a. [a] -> [a] -> [a]
++ (BlockSize
u, BlockId
l, ByteString
cs') (BlockSize, BlockId, ByteString)
-> [(BlockSize, BlockId, ByteString)]
-> [(BlockSize, BlockId, ByteString)]
forall a. a -> [a] -> [a]
: [(BlockSize, BlockId, ByteString)]
css
  where cl :: BlockId
cl = Int -> BlockId
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> BlockId) -> Int -> BlockId
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
cs

-- | Takes the genre string prefixed by a single, two-byte genre code
-- identifier, splits the string, and prepends the code to every pack.
splitGenre :: BS.ByteString -> [(TrackId, Word, BS.ByteString)]
splitGenre :: ByteString -> [(BlockSize, BlockId, ByteString)]
splitGenre ByteString
bs =
    [ (BlockSize
0, BlockId
l', ByteString
gc ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bs')
    | (BlockId
l', ByteString
bs') <- [BlockId] -> [ByteString] -> [(BlockId, ByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [BlockId
0, BlockId
10 ..] ([ByteString] -> [(BlockId, ByteString)])
-> (ByteString -> [ByteString])
-> ByteString
-> [(BlockId, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> [ByteString]
splitAtEvery Int
10 (ByteString -> [(BlockId, ByteString)])
-> ByteString -> [(BlockId, ByteString)]
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
2 ByteString
bs
    ]
  where gc :: ByteString
gc = Int -> ByteString -> ByteString
BS.take Int
2 ByteString
bs

-- | Extend the builtin 'BS.splitAt' to return an entire list of substrings.
splitAtEvery :: Int -> BS.ByteString -> [BS.ByteString]
splitAtEvery :: Int -> ByteString -> [ByteString]
splitAtEvery Int
i ByteString
bs
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = []
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= ByteString -> Int
BS.length ByteString
bs = [ByteString
bs]
    | Bool
otherwise = (ByteString, ByteString) -> [ByteString]
recurse ((ByteString, ByteString) -> [ByteString])
-> (ByteString, ByteString) -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
i ByteString
bs
  where recurse :: (ByteString, ByteString) -> [ByteString]
recurse (ByteString
h, ByteString
t) = ByteString
h ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: Int -> ByteString -> [ByteString]
splitAtEvery Int
i ByteString
t


-- | Now that we have the languages and sizes of all blocks, update the info
-- packs to include them.  Note that this requires that the info packs are
-- located at the end of the block.
joinBlockInfo :: [Maybe Language] -> [BlockSize] -> [BS.ByteString] -> [BS.ByteString]
joinBlockInfo :: [Maybe Language] -> [BlockSize] -> [ByteString] -> [ByteString]
joinBlockInfo [Maybe Language]
_ [BlockSize]
_ [] = []
joinBlockInfo [Maybe Language]
_ [BlockSize]
_ [ByteString
b] = [ByteString
b]
joinBlockInfo [Maybe Language]
ls [BlockSize]
ss [ByteString]
bss = [ByteString]
h [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString
p2, ByteString
p3]
  where ([ByteString]
h, [ByteString]
t) = Int -> [ByteString] -> ([ByteString], [ByteString])
forall a. Int -> [a] -> ([a], [a])
splitAt ([ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
bss Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) [ByteString]
bss
        ls' :: [BlockSize]
ls' = Int -> [BlockSize] -> [BlockSize]
forall a. Int -> [a] -> [a]
take Int
8 ([BlockSize] -> [BlockSize]) -> [BlockSize] -> [BlockSize]
forall a b. (a -> b) -> a -> b
$ (Maybe Language -> BlockSize) -> [Maybe Language] -> [BlockSize]
forall a b. (a -> b) -> [a] -> [b]
map (BlockSize -> (Language -> BlockSize) -> Maybe Language -> BlockSize
forall b a. b -> (a -> b) -> Maybe a -> b
maybe BlockSize
0 ((Language -> BlockSize) -> Maybe Language -> BlockSize)
-> (Language -> BlockSize) -> Maybe Language -> BlockSize
forall a b. (a -> b) -> a -> b
$ Int -> BlockSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> BlockSize) -> (Language -> Int) -> Language -> BlockSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Language -> Int
forall a. Enum a => a -> Int
fromEnum) [Maybe Language]
ls [BlockSize] -> [BlockSize] -> [BlockSize]
forall a. [a] -> [a] -> [a]
++ BlockSize -> [BlockSize]
forall a. a -> [a]
repeat BlockSize
0
        ss' :: [BlockSize]
ss' = Int -> [BlockSize] -> [BlockSize]
forall a. Int -> [a] -> [a]
take Int
8 ([BlockSize] -> [BlockSize]) -> [BlockSize] -> [BlockSize]
forall a b. (a -> b) -> a -> b
$ [BlockSize]
ss [BlockSize] -> [BlockSize] -> [BlockSize]
forall a. [a] -> [a] -> [a]
++ BlockSize -> [BlockSize]
forall a. a -> [a]
repeat BlockSize
0
        p2 :: ByteString
p2 = [ByteString] -> ByteString
forall a. [a] -> a
head [ByteString]
t ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [BlockSize] -> ByteString
BS.pack (Int -> [BlockSize] -> [BlockSize]
forall a. Int -> [a] -> [a]
take Int
4 [BlockSize]
ss')
        p3 :: ByteString
p3 = [ByteString] -> ByteString
forall a. [a] -> a
head ([ByteString] -> [ByteString]
forall a. [a] -> [a]
tail [ByteString]
t) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [BlockSize] -> ByteString
BS.pack (Int -> [BlockSize] -> [BlockSize]
forall a. Int -> [a] -> [a]
drop Int
4 [BlockSize]
ss' [BlockSize] -> [BlockSize] -> [BlockSize]
forall a. [a] -> [a] -> [a]
++ [BlockSize]
ls')


-- | Generate a checksum over the first 16 (including header) bytes of a data
-- pack, zero-padding /or truncating/ as necessary.
checksum :: BS.ByteString -> BS.ByteString
checksum :: ByteString -> ByteString
checksum ByteString
bs = ByteString -> ByteString
checksum' (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
16 (Int -> Ordering) -> Int -> Ordering
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
bs of
    Ordering
GT -> Int -> ByteString -> ByteString
BS.take Int
16 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
bs ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> BlockSize -> ByteString
BS.replicate Int
16 BlockSize
0
    Ordering
EQ -> ByteString
bs
    Ordering
LT -> Int -> ByteString -> ByteString
BS.take Int
16 ByteString
bs

-- | Actually run the checksum function on all the bytes of the input.  Note
-- that this doesn't verify that the length is actually the proper 16.
checksum' :: BS.ByteString -> BS.ByteString
checksum' :: ByteString -> ByteString
checksum' ByteString
bs = ByteString
bs ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ([BlockSize] -> ByteString
BS.pack ([BlockSize] -> ByteString)
-> (ByteString -> [BlockSize]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> [BlockSize]
forall a b. (Integral a, Bits a, Num b) => a -> [b]
split (Word16 -> [BlockSize])
-> (ByteString -> Word16) -> ByteString -> [BlockSize]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Word16
forall a. (Bits a, Num a) => a -> a
finalize (Word16 -> Word16)
-> (ByteString -> Word16) -> ByteString -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word16 -> BlockSize -> Word16) -> Word16 -> ByteString -> Word16
forall a. (a -> BlockSize -> a) -> a -> ByteString -> a
BS.foldl' Word16 -> BlockSize -> Word16
checksumBytes Word16
h' (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
t ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> BlockSize -> ByteString
BS.singleton BlockSize
0)
  where split :: a -> [b]
split a
i = (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral [a -> Int -> a
forall a. Bits a => a -> Int -> a
B.shiftR a
i Int
8, a
i]
        finalize :: a -> a
finalize a
i = a -> a -> a
forall a. Bits a => a -> a -> a
B.xor a
i a
0xFFFF
        (BlockSize
h, ByteString
t) = (BlockSize, ByteString)
-> Maybe (BlockSize, ByteString) -> (BlockSize, ByteString)
forall a. a -> Maybe a -> a
Y.fromMaybe (BlockSize
0, ByteString
BS.empty) (Maybe (BlockSize, ByteString) -> (BlockSize, ByteString))
-> Maybe (BlockSize, ByteString) -> (BlockSize, ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe (BlockSize, ByteString)
BS.uncons ByteString
bs
        h' :: Word16
h' = Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
B.shiftL (BlockSize -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral BlockSize
h) Int
8

checksumBytes :: W.Word16 -> W.Word8 -> W.Word16
checksumBytes :: Word16 -> BlockSize -> Word16
checksumBytes Word16
acc BlockSize
a = BlockId -> Word16 -> Word16
checksumBits BlockId
8 (Word16 -> Word16) -> (Word16 -> Word16) -> Word16 -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
B.xor Word16
acc (Word16 -> Word16) -> Word16 -> Word16
forall a b. (a -> b) -> a -> b
$ BlockSize -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral BlockSize
a

checksumBits :: Word -> W.Word16 -> W.Word16
checksumBits :: BlockId -> Word16 -> Word16
checksumBits BlockId
0 Word16
i = Word16
i
checksumBits BlockId
c Word16
i = BlockId -> Word16 -> Word16
checksumBits (BlockId
c BlockId -> BlockId -> BlockId
forall a. Num a => a -> a -> a
- BlockId
1) Word16
i'
  where i' :: Word16
i'  | Word16 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
B.testBit Word16
i Int
15 = Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
B.xor Word16
0x1021 (Word16 -> Word16) -> Word16 -> Word16
forall a b. (a -> b) -> a -> b
$ Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
B.shiftL Word16
i Int
1
            | Bool
otherwise = Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
B.shiftL Word16
i Int
1