main :: IO ()
main = withManager defaultManagerSettings $ \m -> do
    args <- getArgs
    token <- readFile "/auth-token"
    (filepath, alias) <-
        case args of
            [x, y] -> return (x, y)
            _ -> do
                pn <- getProgName
                putStrLn $ concat
                    [ "Usage: "
                    , pn
                    , " <filepath> <alias name>"
                    ]
                exitFailure

    let uploadDocs = "exclusive" `isInfixOf` alias
        uploadHackageDistro = alias == "unstable-ghc78-exclusive"

    putStrLn $ concat
        [ "Uploading "
        , filepath
        , " as "
        , alias
        ]

    req1 <- parseUrl "http://www.stackage.org/upload"
    let formData =
            [ partBS "alias" $ S8.pack alias
            , partFileSource "stackage" filepath
            ]
    req2 <- formDataBody formData req1
    let req3 = req2
            { method = "PUT"
            , requestHeaders =
                [ ("Authorization", S8.pack token)
                , ("Accept", "application/json")
                ] ++ requestHeaders req2
            , redirectCount = 0
            , checkStatus = \_ _ _ -> Nothing
            }
    res <- httpLbs req3 m

    snapid <-
        case lookup "x-stackage-ident" $ responseHeaders res of
            Just snapid -> do
                putStrLn $ "New ident: " ++ S8.unpack snapid
                return snapid
            Nothing -> error $ "An error occurred: " ++ show res

    when uploadDocs $ do
        putStrLn "Generating index file"
        let root = takeDirectory filepath </> "haddock"
        contents <- getDirectoryContents root
        dirs <- filterM (\n -> doesDirectoryExist $ root </> n)
              $ filter (not . ("." `isPrefixOf`))
              $ sort contents
        writeFile (root </> "index.html") $ mkIndex (S8.unpack snapid) dirs
        writeFile (root </> "style.css") styleCss

        putStrLn "Creating tarball"
        (Nothing, Nothing, Nothing, ph) <- createProcess
            (proc "tar" $ "cJf" : "haddock.tar.xz" : "index.html" : "style.css" : dirs)
                { cwd = Just root
                }
        ec <- waitForProcess ph
        if ec == ExitSuccess
            then putStrLn "Haddock tarball generated"
            else error "Error generating Haddock tarball"

        putStrLn "Uploading Haddocks"

        req1 <- parseUrl $ "http://www.stackage.org/upload-haddock/"
                        ++ S8.unpack snapid
        let formData =
                [ partFileSource "tarball" $ root </> "haddock.tar.xz"
                ]
        req2 <- formDataBody formData req1
        let req3 = req2
                { method = "PUT"
                , requestHeaders =
                    [ ("Authorization", S8.pack token)
                    , ("Accept", "application/json")
                    ] ++ requestHeaders req2
                , redirectCount = 0
                , checkStatus = \_ _ _ -> Nothing
                }
        httpLbs req3 m >>= print

    when uploadHackageDistro $ do
        lbs <- L.readFile $ takeDirectory filepath </> "build-plan.csv"
        let req = "http://hackage.haskell.org/distro/Stackage/packages.csv"
                { requestHeaders = [("Content-Type", "text/csv")]
                , requestBody = RequestBodyLBS $ L.intercalate "\n" $ L8.lines lbs
                , checkStatus = \_ _ _ -> Nothing
                , method = "PUT"
                }
        httpLbs req m >>= print
main :: IO ()
main = withManager defaultManagerSettings $ \m -> do
    args <- getArgs
    token <- readFile "/auth-token"
    (filepath, alias) <-
        case args of
            [x, y] -> return (x, y)
            _ -> do
                pn <- getProgName
                putStrLn $ concat
                    [ "Usage: "
                    , pn
                    , " <filepath> <alias name>"
                    ]
                exitFailure

    let uploadDocs = "exclusive" `isInfixOf` alias
        uploadHackageDistro = alias == "unstable-ghc78-exclusive"

    putStrLn $ concat
        [ "Uploading "
        , filepath
        , " as "
        , alias
        ]

    req1 <- parseUrl "http://www.stackage.org/upload"
    let formData =
            [ partBS "alias" $ S8.pack alias
            , partFileSource "stackage" filepath
            ]
    req2 <- formDataBody formData req1
    let req3 = req2
            { method = "PUT"
            , requestHeaders =
                [ ("Authorization", S8.pack token)
                , ("Accept", "application/json")
                ] ++ requestHeaders req2
            , redirectCount = 0
            , checkStatus = \_ _ _ -> Nothing
            }
    res <- httpLbs req3 m

    snapid <-
        case lookup "x-stackage-ident" $ responseHeaders res of
            Just snapid -> do
                putStrLn $ "New ident: " ++ S8.unpack snapid
                return snapid
            Nothing -> error $ "An error occurred: " ++ show res

    when uploadDocs $ do
        putStrLn "Generating index file"
        let root = takeDirectory filepath </> "haddock"
        contents <- getDirectoryContents root
        dirs <- filterM (\n -> doesDirectoryExist $ root </> n)
              $ filter (not . ("." `isPrefixOf`))
              $ sort contents
        writeFile (root </> "index.html") $ mkIndex (S8.unpack snapid) dirs
        writeFile (root </> "style.css") styleCss

        putStrLn "Creating tarball"
        (Nothing, Nothing, Nothing, ph) <- createProcess
            (proc "tar" $ "cJf" : "haddock.tar.xz" : "index.html" : "style.css" : dirs)
                { cwd = Just root
                }
        ec <- waitForProcess ph
        if ec == ExitSuccess
            then putStrLn "Haddock tarball generated"
            else error "Error generating Haddock tarball"

        putStrLn "Uploading Haddocks"

        req1 <- parseUrl $ "http://www.stackage.org/upload-haddock/"
                        ++ S8.unpack snapid
        let formData =
                [ partFileSource "tarball" $ root </> "haddock.tar.xz"
                ]
        req2 <- formDataBody formData req1
        let req3 = req2
                { method = "PUT"
                , requestHeaders =
                    [ ("Authorization", S8.pack token)
                    , ("Accept", "application/json")
                    ] ++ requestHeaders req2
                , redirectCount = 0
                , checkStatus = \_ _ _ -> Nothing
                }
        httpLbs req3 m >>= print

    when uploadHackageDistro $ do
        lbs <- L.readFile $ takeDirectory filepath </> "build-plan.csv"
        let req = "http://hackage.haskell.org/distro/Stackage/packages.csv"
                { requestHeaders = [("Content-Type", "text/csv")]
                , requestBody = RequestBodyLBS $ L.intercalate "\n" $ L8.lines lbs
                , checkStatus = \_ _ _ -> Nothing
                , method = "PUT"
                }
        httpLbs req m >>= print
main = withManager defaultManagerSettings $ \m -> do
    args <- getArgs
    token <- readFile "/auth-token"
    (filepath, alias) <-
        case args of
            [x, y] -> return (x, y)
            _ -> do
                pn <- getProgName
                putStrLn $ concat
                    [ "Usage: "
                    , pn
                    , " <filepath> <alias name>"
                    ]
                exitFailure

    let uploadDocs = "exclusive" `isInfixOf` alias
        uploadHackageDistro = alias == "unstable-ghc78-exclusive"

    putStrLn $ concat
        [ "Uploading "
        , filepath
        , " as "
        , alias
        ]

    req1 <- parseUrl "http://www.stackage.org/upload"
    let formData =
            [ partBS "alias" $ S8.pack alias
            , partFileSource "stackage" filepath
            ]
    req2 <- formDataBody formData req1
    let req3 = req2
            { method = "PUT"
            , requestHeaders =
                [ ("Authorization", S8.pack token)
                , ("Accept", "application/json")
                ] ++ requestHeaders req2
            , redirectCount = 0
            , checkStatus = \_ _ _ -> Nothing
            }
    res <- httpLbs req3 m

    snapid <-
        case lookup "x-stackage-ident" $ responseHeaders res of
            Just snapid -> do
                putStrLn $ "New ident: " ++ S8.unpack snapid
                return snapid
            Nothing -> error $ "An error occurred: " ++ show res

    when uploadDocs $ do
        putStrLn "Generating index file"
        let root = takeDirectory filepath </> "haddock"
        contents <- getDirectoryContents root
        dirs <- filterM (\n -> doesDirectoryExist $ root </> n)
              $ filter (not . ("." `isPrefixOf`))
              $ sort contents
        writeFile (root </> "index.html") $ mkIndex (S8.unpack snapid) dirs
        writeFile (root </> "style.css") styleCss

        putStrLn "Creating tarball"
        (Nothing, Nothing, Nothing, ph) <- createProcess
            (proc "tar" $ "cJf" : "haddock.tar.xz" : "index.html" : "style.css" : dirs)
                { cwd = Just root
                }
        ec <- waitForProcess ph
        if ec == ExitSuccess
            then putStrLn "Haddock tarball generated"
            else error "Error generating Haddock tarball"

        putStrLn "Uploading Haddocks"

        req1 <- parseUrl $ "http://www.stackage.org/upload-haddock/"
                        ++ S8.unpack snapid
        let formData =
                [ partFileSource "tarball" $ root </> "haddock.tar.xz"
                ]
        req2 <- formDataBody formData req1
        let req3 = req2
                { method = "PUT"
                , requestHeaders =
                    [ ("Authorization", S8.pack token)
                    , ("Accept", "application/json")
                    ] ++ requestHeaders req2
                , redirectCount = 0
                , checkStatus = \_ _ _ -> Nothing
                }
        httpLbs req3 m >>= print

    when uploadHackageDistro $ do
        lbs <- L.readFile $ takeDirectory filepath </> "build-plan.csv"
        let req = "http://hackage.haskell.org/distro/Stackage/packages.csv"
                { requestHeaders = [("Content-Type", "text/csv")]
                , requestBody = RequestBodyLBS $ L.intercalate "\n" $ L8.lines lbs
                , checkStatus = \_ _ _ -> Nothing
                , method = "PUT"
                }
        httpLbs req m >>= print