{-# 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