{-# LANGUAGE OverloadedStrings #-}
module Elm2Nix.FixedOutput
  ( FixedDerivation(..)
  , prefetch
  ) where

import System.Exit
import System.Process
import qualified Data.ByteString.Lazy.Char8 as BS


-- fixed output derivation metadata
data FixedDerivation = FixedDerivation
  { FixedDerivation -> String
drvHash :: String -- ^ Computed sha256 hash
  , FixedDerivation -> String
drvPath :: String -- ^ Nix store path of the derivation
  , FixedDerivation -> String
drvUrl :: String -- ^ URL to the tarball
  , FixedDerivation -> String
drvName :: String
  , FixedDerivation -> String
drvVersion :: String
  } deriving (Int -> FixedDerivation -> ShowS
[FixedDerivation] -> ShowS
FixedDerivation -> String
(Int -> FixedDerivation -> ShowS)
-> (FixedDerivation -> String)
-> ([FixedDerivation] -> ShowS)
-> Show FixedDerivation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FixedDerivation] -> ShowS
$cshowList :: [FixedDerivation] -> ShowS
show :: FixedDerivation -> String
$cshow :: FixedDerivation -> String
showsPrec :: Int -> FixedDerivation -> ShowS
$cshowsPrec :: Int -> FixedDerivation -> ShowS
Show, FixedDerivation -> FixedDerivation -> Bool
(FixedDerivation -> FixedDerivation -> Bool)
-> (FixedDerivation -> FixedDerivation -> Bool)
-> Eq FixedDerivation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FixedDerivation -> FixedDerivation -> Bool
$c/= :: FixedDerivation -> FixedDerivation -> Bool
== :: FixedDerivation -> FixedDerivation -> Bool
$c== :: FixedDerivation -> FixedDerivation -> Bool
Eq)

-- | Use nix-prefetch-url to obtain resulting path and it's hash
-- | Partially taken from cabal2nix/src/Distribution/Nixpkgs/Fetch.hs
prefetch :: String -> String -> IO FixedDerivation
prefetch :: String -> String -> IO FixedDerivation
prefetch String
name String
version = do
  (Maybe Handle
Nothing, Just Handle
stdoutH, Maybe Handle
_, ProcessHandle
processH) <-
    CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess (String -> [String] -> CreateProcess
proc String
"nix-prefetch-url" [String]
args) { env :: Maybe [(String, String)]
env     = Maybe [(String, String)]
forall a. Maybe a
Nothing
                                                 , std_in :: StdStream
std_in  = StdStream
Inherit
                                                 , std_err :: StdStream
std_err = StdStream
Inherit
                                                 , std_out :: StdStream
std_out = StdStream
CreatePipe
                                                 }
  ExitCode
exitCode <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
processH
  case ExitCode
exitCode of
    ExitFailure Int
_ -> String -> IO FixedDerivation
forall a. HasCallStack => String -> a
error String
"nix-prefetch-url exited with non-zero"
    ExitCode
ExitSuccess   -> do
      ByteString
buf <- Handle -> IO ByteString
BS.hGetContents Handle
stdoutH
      let ls :: [ByteString]
ls = ByteString -> [ByteString]
BS.lines ByteString
buf
      case [ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
ls of
        Int
0 -> String -> IO FixedDerivation
forall a. HasCallStack => String -> a
error String
"unknown nix-prefetch-url output"
        Int
2 -> FixedDerivation -> IO FixedDerivation
forall (m :: * -> *) a. Monad m => a -> m a
return (FixedDerivation -> IO FixedDerivation)
-> FixedDerivation -> IO FixedDerivation
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String -> String -> FixedDerivation
FixedDerivation (ByteString -> String
BS.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
forall a. [a] -> a
head [ByteString]
ls)
                                       (ByteString -> String
BS.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
forall a. [a] -> a
head ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
forall a. [a] -> [a]
tail [ByteString]
ls)
                                       String
url
                                       String
name
                                       String
version
        Int
_ -> String -> IO FixedDerivation
forall a. HasCallStack => String -> a
error String
"unknown nix-prefetch-url output"
  where
  url :: String
  url :: String
url =
    String
"https://github.com/"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/archive/"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
version
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".tar.gz"
  args :: [String]
  args :: [String]
args = [String
"--print-path", String
url]