Fetch.hs

{-# LANGUAGE OverloadedStrings #-}

module Text.Madlibs.Packaging.Fetch ( fetchGithub
                                    , fetchPackages
                                    , cleanPackages
                                    , installVimPlugin
                                    ) where

import qualified Codec.Archive.Tar       as Tar
import           Codec.Archive.Zip       (ZipOption (..), extractFilesFromArchive, toArchive)
import           Codec.Compression.GZip  (decompress)
import           Control.Monad           (unless)
import           Data.Foldable           (traverse_)
import           Network.HTTP.Client     hiding (decompress)
import           Network.HTTP.Client.TLS (tlsManagerSettings)
import           System.Directory        (getAppUserDataDirectory, removeFile, renameDirectory, withCurrentDirectory)
import           System.Environment      (getEnv)
import           System.FilePath         (pathSeparator, (</>))
import           System.Info             (os)

invalid :: String -> Bool
invalid = not . (pathSeparator `elem`)

-- | As an example, `vmchale/some-library` would be valid input.
fetchGithub :: String -> IO ()
fetchGithub s = unless (invalid s) $ do

    putStrLn $ "fetching library at " ++ s

    manager <- newManager tlsManagerSettings
    initialRequest <- parseRequest $ "https://github.com/" ++ s ++ "/archive/master.zip"
    response <- responseBody <$> httpLbs (initialRequest { method = "GET" }) manager

    putStrLn "unpacking libraries..."
    packageDir <- getAppUserDataDirectory "madlang"
    let options = OptDestination packageDir
    extractFilesFromArchive [options] (toArchive response)

    let repoName = filter (/='/') . dropWhile (/='/') $ s
    renameDirectory (packageDir ++ "/" ++ repoName ++ "-master") (packageDir ++ "/" ++ repoName)

installVimPlugin :: IO ()
installVimPlugin = do

    putStrLn "fetching latest vim plugin..."
    manager <- newManager defaultManagerSettings
    initialRequest <- parseRequest "http://vmchale.com/static/vim.zip"
    response <- responseBody <$> httpLbs (initialRequest { method = "GET" }) manager

    putStrLn "installing locally..."
    home <- getEnv "HOME"
    let packageDir = if os /= "mingw32" then home ++ "/.vim" else home ++ "\\vimfiles"
    let options = OptDestination packageDir
    withCurrentDirectory packageDir $
        extractFilesFromArchive [options] (toArchive response)

    putStrLn "cleaning junk..."

    traverse_ removeFile [ packageDir </> "TODO.md", packageDir </> "vim-screenshot.png", packageDir </> "README.md", packageDir </> "LICENSE" ]

-- TODO set remote package url flexibly
fetchPackages :: IO ()
fetchPackages = do

    putStrLn "fetching libraries..."
    manager <- newManager defaultManagerSettings
    initialRequest <- parseRequest "http://vmchale.com/static/packages.tar.gz"
    response <- responseBody <$> httpLbs (initialRequest { method = "GET" }) manager

    putStrLn "unpacking libraries..."
    packageDir <- getAppUserDataDirectory "madlang"
    Tar.unpack packageDir . Tar.read . decompress $ response

cleanPackages :: IO ()
cleanPackages =
    putStrLn "done."