sak-0.1.2.0: src/Main.hs

{-# LANGUAGE OverloadedStrings #-}

module Main ( main ) where

import           Compression
import           Control.Concurrent.ParallelIO.Global (parallel_, stopGlobalPool)
import qualified Data.ByteString.Lazy                 as BSL
import           Data.Semigroup                       ((<>))
import           Options.Applicative
import           System.Directory                     (getSymbolicLinkTarget, pathIsSymbolicLink)
import           Version                              (allVersionsString)

reifyPath :: FilePath -> IO FilePath
reifyPath fp = do
    isSym <- pathIsSymbolicLink fp
    if isSym
        then getSymbolicLinkTarget fp
        else pure fp

data Command = Decompress !FilePath !(Maybe FilePath)
    | Compress !FilePath !FilePath !CompressionLevel
    | Transcode !FilePath !FilePath !CompressionLevel
    | Verify !FilePath
    | Matrix !FilePath !CompressionLevel

decompressFile :: FilePath -- ^ Compressed file
               -> FilePath -- ^ Output
               -> IO ()
decompressFile inp o = BSL.writeFile o =<< f inp
    where f = toFileDecompressor (detectCompression inp)

compressFile :: CompressionLevel
             -> FilePath -- ^ Input file
             -> FilePath -- ^ Compressed output
             -> IO ()
compressFile lvl inp o = BSL.writeFile o =<< f inp
    where f = toFileCompressor (detectCompression o) lvl

compressMatrix :: CompressionLevel
               -> FilePath
               -> Compression
               -> IO ()
compressMatrix lvl inp c =
    BSL.writeFile (inp ++ ext c) =<< toFileCompressor c lvl inp

run :: Command -> IO ()
run (Decompress i Nothing)      = flip decompressFile (uncompressedExt i) =<< reifyPath i
run (Decompress i (Just o))     = flip decompressFile o =<< reifyPath i
run (Compress i o lvl)          = flip (compressFile lvl) o =<< reifyPath i
run (Transcode i o lvl)         = do
    let cO = detectCompression o
    guessSz <- case cO of
        Lzip -> Just . (8*) . fromIntegral <$> fileSize i
        _    -> pure Nothing
    BSL.writeFile o . toCompressor cO lvl guessSz =<< toFileDecompressor (detectCompression i) =<< reifyPath i
run (Verify i)                  = check (detectCompression i) =<< BSL.readFile =<< reifyPath i
run (Matrix inp lvl)            =
    parallel_ (compressMatrix lvl inp <$> [Lzma .. Lz4]) *>
    stopGlobalPool

fileCompletions :: HasCompleter f => Mod f a
fileCompletions = completer (bashCompleter "file -o plusdirs")

inpFile :: Parser FilePath
inpFile = fileHelp "Input file"

verify :: Parser Command
verify = Verify <$> inpFile

compressionLevel :: Parser CompressionLevel
compressionLevel =
        compressCustom
    <|> compressBest
    <|> compressFast
    <|> flag Default Default mempty

compressCustom :: Parser CompressionLevel
compressCustom =
    Custom <$>
        option auto
        (long "compression-level"
        <> short 'l'
        <> metavar "LVL"
        <> help "Compression level (usually 0-9)"
        <> completer (listCompleter (show <$> [(0::Int)..22]))
        )

compressBest :: Parser CompressionLevel
compressBest =
    flag' Best (long "best")

compressFast :: Parser CompressionLevel
compressFast =
    flag' Fastest (long "fastest")

transcode :: Parser Command
transcode = Transcode
    <$> inpFile
    <*> fileHelp "Output"
    <*> compressionLevel

decompress :: Parser Command
decompress = Decompress
    <$> fileHelp "File to decompress"
    <*> optional outFile

outFile :: Parser FilePath
outFile = fileHelp "Decompressed output"

matrix :: Parser Command
matrix = Matrix
    <$> fileHelp "File to compress"
    <*> compressionLevel

compress :: Parser Command
compress = Compress
    <$> fileHelp "File to compress"
    <*> fileHelp "Compressed output"
    <*> compressionLevel

fileHelp :: String -> Parser FilePath
fileHelp helpTxt =
    argument str
    (metavar "FILE"
    <> fileCompletions
    <> help helpTxt)

cmd :: Parser Command
cmd = hsubparser
    (command "decompress" (info decompress (progDesc "Decompress a file"))
    <> command "compress" (info compress (progDesc "Compress a file"))
    <> command "transcode" (info transcode (progDesc "Convert a file's compression"))
    <> command "verify" (info verify (progDesc "Check the integrity of a compressed file"))
    <> command "matrix" (info matrix (progDesc "Compress a file to all available formats"))
    )

versionMod :: Parser (a -> a)
versionMod = infoOption allVersionsString (short 'V' <> long "version" <> help "Show version")

topLevel :: ParserInfo Command
topLevel = info (helper <*> versionMod <*> cmd)
    (fullDesc
    <> progDesc "A Haskell compressor tool"
    <> header "sak - a Swiss-army knife for compression")

main :: IO ()
main = run =<< execParser topLevel