{-# 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 -> [Char]
drvHash :: String -- ^ Computed sha256 hash
  , FixedDerivation -> [Char]
drvPath :: String -- ^ Nix store path of the derivation
  , FixedDerivation -> [Char]
drvUrl :: String -- ^ URL to the tarball
  , FixedDerivation -> [Char]
drvName :: String
  , FixedDerivation -> [Char]
drvVersion :: String
  } deriving (Int -> FixedDerivation -> ShowS
[FixedDerivation] -> ShowS
FixedDerivation -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [FixedDerivation] -> ShowS
$cshowList :: [FixedDerivation] -> ShowS
show :: FixedDerivation -> [Char]
$cshow :: FixedDerivation -> [Char]
showsPrec :: Int -> FixedDerivation -> ShowS
$cshowsPrec :: Int -> FixedDerivation -> ShowS
Show, FixedDerivation -> FixedDerivation -> Bool
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 :: [Char] -> [Char] -> IO FixedDerivation
prefetch [Char]
name [Char]
version = do
  (Maybe Handle
Nothing, Just Handle
stdoutH, Maybe Handle
_, ProcessHandle
processH) <-
    CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess ([Char] -> [[Char]] -> CreateProcess
proc [Char]
"nix-prefetch-url" [[Char]]
args) { env :: Maybe [([Char], [Char])]
env     = 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
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"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 forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
ls of
        Int
0 -> forall a. HasCallStack => [Char] -> a
error [Char]
"unknown nix-prefetch-url output"
        Int
2 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char] -> [Char] -> [Char] -> FixedDerivation
FixedDerivation (ByteString -> [Char]
BS.unpack forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [ByteString]
ls)
                                       (ByteString -> [Char]
BS.unpack forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
tail [ByteString]
ls)
                                       [Char]
url
                                       [Char]
name
                                       [Char]
version
        Int
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"unknown nix-prefetch-url output"
  where
  url :: String
  url :: [Char]
url =
    [Char]
"https://github.com/"
      forall a. [a] -> [a] -> [a]
++ [Char]
name
      forall a. [a] -> [a] -> [a]
++ [Char]
"/archive/"
      forall a. [a] -> [a] -> [a]
++ [Char]
version
      forall a. [a] -> [a] -> [a]
++ [Char]
".tar.gz"
  args :: [String]
  args :: [[Char]]
args = [[Char]
"--print-path", [Char]
url]