htalkat-0.1.1: TimedText.hs

-- This file is part of htalkat
-- Copyright (C) 2021 Martin Bays <mbays@sdf.org>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of version 3 of the GNU General Public License as
-- published by the Free Software Foundation, or any later version.
--
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see http://www.gnu.org/licenses/.

{-# LANGUAGE OverloadedStrings #-}

module TimedText where

import qualified Data.Array                 as A
import qualified Data.ByteString.Lazy       as BL
import qualified Data.ByteString.Lazy.Char8 as BLC
import qualified Data.Text.Encoding.Error   as T
import qualified Data.Text.Lazy             as T
import qualified Data.Text.Lazy.Encoding    as T

type TimedText = [ Either Int Char ]

pauseMax :: Int
pauseMax = 64 * 64 - 1

encodeTimedText :: TimedText -> BL.ByteString
encodeTimedText = pad . BL.concat . (encode <$>)
    where
    encode (Left n) | n <= 0 = BL.empty
    encode (Left n) | n >= pauseMax = "~//"
    encode (Left n) | (a,b) <- n `divMod` 64 = "~" <> base64BC a <> base64BC b
        where
        base64BC = BLC.singleton . (base64Array A.!)
        base64Array = A.listArray (0,63) "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
    encode (Right '~') = "~~"
    encode (Right c) = T.encodeUtf8 $ T.singleton c
    pad b = b <> BL.pack (replicate (fromIntegral $ (- BL.length b) `mod` padLength) 0)
    padLength = 24

decodeTimedText :: BL.ByteString -> TimedText
decodeTimedText = decode . T.unpack . T.decodeUtf8With T.lenientDecode. unpad
    where
    decode [] = []
    decode ('~':'~':s) = Right '~' : decode s
    decode ('~':a:b:s) | Just n <- decodePause a b = Left n : decode s
    decode ('~':s) = decode s  -- unparseable sequence
    decode (c:s) = Right c : decode s

    decodePause a b
        | Just n <- fromIntegral <$> decodeBase64Char a
        , Just m <- fromIntegral <$> decodeBase64Char b
        = Just $ 64*n + m
    decodePause _ _ = Nothing
    decodeBase64Char :: Char -> Maybe Int
    decodeBase64Char a | n <- fromEnum a - fromEnum 'A', 0 <= n && n < 26 = Just n
    decodeBase64Char a | n <- fromEnum a - fromEnum 'a', 0 <= n && n < 26 = Just $ 26 + n
    decodeBase64Char a | n <- fromEnum a - fromEnum '0', 0 <= n && n < 10 = Just $ 52 + n
    decodeBase64Char '+' = Just 62
    decodeBase64Char '/' = Just 63
    decodeBase64Char _ = Nothing
    unpad = BL.filter (/= 0)