-- | Variants for handling @GZIP@ compressed data.
module Sound.Analysis.Spear.PTPF.GZ where

import qualified Codec.Compression.GZip as Z {- zlib -}
import qualified Data.ByteString.Lazy.Char8 as C {- bytestring -}
import Sound.Analysis.Spear.PTPF

-- | Variant of 'parse_ptpf' running 'Z.decompress'.
parse_ptpf_gz :: C.ByteString -> Either String PTPF
parse_ptpf_gz = parse_ptpf . Z.decompress

-- | Load compressed spear data.
load_ptpf_gz :: FilePath -> IO (Either String PTPF)
load_ptpf_gz = fmap parse_ptpf_gz . C.readFile

-- | Apply /f/ at 'Right', else 'id'.
at_right :: (a -> b) -> Either t a -> Either t b
at_right f = either (Left . id) (Right . f)

-- | Variant of 'load_ptpf_gz' transforming with 'ptpf_time_asc'.
load_ptpf_gz_time_asc :: FilePath -> IO (Either String [(Double, [Node])])
load_ptpf_gz_time_asc = fmap (at_right ptpf_time_asc) . load_ptpf_gz