170 lines
5.2 KiB
Haskell
170 lines
5.2 KiB
Haskell
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
{-# LANGUAGE QuasiQuotes #-}
|
|
|
|
-- TODO: handle SIGTERM, SIGUSR
|
|
module GHCup where
|
|
|
|
import Control.Applicative
|
|
import Data.Strict.Maybe
|
|
import Data.Version
|
|
import GHCup.Prelude
|
|
import GHCup.Bash
|
|
import GHCup.File
|
|
import GHCup.Types
|
|
import GHCup.Types.Optics
|
|
import HPath
|
|
import HPath.IO
|
|
import Network.URL
|
|
import qualified Data.ByteString.Lazy.UTF8 as UTF8
|
|
import Optics
|
|
import Prelude hiding ( abs
|
|
, Maybe
|
|
, Just
|
|
, Nothing
|
|
)
|
|
import System.Info
|
|
|
|
import qualified Data.Map.Strict as Map
|
|
import qualified GHC.Exts as GE
|
|
import qualified Prelude as P
|
|
import qualified System.Posix.Process.ByteString
|
|
as SPPB
|
|
|
|
|
|
|
|
availableDownloads :: AvailableDownloads
|
|
availableDownloads = Map.fromList
|
|
[ ( GHC
|
|
, Map.fromList
|
|
[ ( mkV [8, 6, 5]
|
|
, Map.fromList
|
|
[ ( A_64
|
|
, Map.fromList
|
|
[ ( Linux UnknownLinux
|
|
, mkGHCUrl "~ghc/8.6.5/ghc-8.6.5-x86_64-fedora27-linux.tar.xz"
|
|
)
|
|
]
|
|
)
|
|
]
|
|
)
|
|
]
|
|
)
|
|
]
|
|
where
|
|
mkV = makeVersion
|
|
mkGHCUrl path = URL
|
|
{ url_type = Absolute $ Host (HTTP True) "downloads.haskell.org" P.Nothing
|
|
, url_path = path
|
|
, url_params = []
|
|
}
|
|
|
|
downloadURL :: Tool
|
|
-> Version
|
|
-> Architecture
|
|
-> Platform
|
|
-> AvailableDownloads
|
|
-> Maybe URL
|
|
downloadURL t v a p dls = with_distro <|> without_ver <|> without_distro
|
|
|
|
where
|
|
with_distro = distro_preview id
|
|
without_distro = distro_preview withoutDistro
|
|
without_ver = distro_preview withoutVer
|
|
|
|
distro_preview f =
|
|
toStrictMaybe $ preview (atJust t % atJust v % atJust a % atJust (f p)) dls
|
|
atJust x = at x % _Just
|
|
|
|
-- | If we can't find a version with the given distro,
|
|
-- then just try with the platform.
|
|
withoutDistro :: Platform -> Platform
|
|
withoutDistro (Linux _) = Linux UnknownLinux
|
|
withoutDistro Darwin = Darwin
|
|
withoutDistro (FreeBSD _) = FreeBSD Nothing
|
|
|
|
-- | If we can't find a match with the given distro version,
|
|
-- we gotta try without it.
|
|
withoutVer :: Platform -> Platform
|
|
withoutVer (Linux (Debian _) ) = Linux $ Debian Nothing
|
|
withoutVer (Linux (Ubuntu _) ) = Linux $ Ubuntu Nothing
|
|
withoutVer (Linux (Mint _) ) = Linux $ Mint Nothing
|
|
withoutVer (Linux (Fedora _) ) = Linux $ Fedora Nothing
|
|
withoutVer (Linux UnknownLinux) = Linux $ UnknownLinux
|
|
withoutVer Darwin = Darwin
|
|
withoutVer (FreeBSD _) = FreeBSD Nothing
|
|
|
|
|
|
getArchitecture :: IO Architecture
|
|
getArchitecture = case arch of
|
|
"x86_64" -> pure A_64
|
|
"i386" -> pure A_32
|
|
what -> fail ("Could not find compatible architecture. Was: " <> what)
|
|
|
|
|
|
|
|
getPlatform :: IO Platform
|
|
getPlatform = case os of
|
|
"linux" -> do
|
|
distro <- getLinuxDistro
|
|
pure $ Linux distro
|
|
-- TODO: these are not verified
|
|
"darwin" -> pure $ Darwin
|
|
"freebsd" -> do
|
|
ver <- getFreeBSDVersion
|
|
pure $ FreeBSD ver
|
|
what -> fail ("Could not find compatible platform. Was: " <> what)
|
|
|
|
where
|
|
getLinuxDistro :: IO LinuxDistro
|
|
getLinuxDistro = do
|
|
let os_release = [abs|/etc/os-release|]
|
|
lsb_release = [abs|/etc/lsb-release|]
|
|
redhat_release = [abs|/etc/redhat-release|]
|
|
debian_version = [abs|/etc/debian_version|]
|
|
|
|
pure undefined
|
|
|
|
getFreeBSDVersion = pure Nothing
|
|
|
|
-- Try various methods for getting distro name and version.
|
|
-- Failure is signalled with an IO exception.
|
|
try_os_release :: IO (String, P.Maybe String)
|
|
try_os_release = do
|
|
name <- getAssignmentValueFor [abs|/etc/os-release|] "NAME" >>= \case
|
|
P.Just s -> pure $ s
|
|
P.Nothing -> fail "No value found"
|
|
version <- getAssignmentValueFor [abs|/etc/os-release|] "VERSION_ID"
|
|
pure (name, version)
|
|
|
|
try_lsb_release_cmd :: IO (String, P.Maybe String)
|
|
try_lsb_release_cmd = findExecutable ([fn|lsb_release|] :: Path Fn) >>= \case
|
|
P.Nothing -> fail "lsb_release not found"
|
|
P.Just path -> do
|
|
name <- executeOut ([fn|lsb_release|] :: Path Fn) [fS "-si"] >>= \case
|
|
P.Just (out, _) -> pure out
|
|
_ -> fail "Barfed output of lsb_release"
|
|
version <- (fmap . fmap) (UTF8.toString . fst)
|
|
$ executeOut ([fn|lsb_release|] :: Path Fn) [fS "-si"]
|
|
pure (UTF8.toString name, version)
|
|
|
|
|
|
|
|
|
|
-- download :: URL -> Path Abs -> IO (Path Abs)
|
|
-- download = undefined
|
|
|
|
-- unpack :: Path Abs -> IO (Path Abs)
|
|
-- unpack = undefined
|
|
|
|
-- install :: DownloadURL -> IO (Path Abs)
|
|
-- install = undefined
|
|
|
|
-- parseAvailableDownloads :: Maybe (Path Abs) -> IO AvailableDownloads
|
|
-- parseAvailableDownloads = undefined
|