{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE MultiWayIf                 #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TupleSections              #-}

module HS.Cmd.Dump (cmdDump) where

import           Data.Maybe
import qualified Data.Text.IO       as T
import           Fmt
import           HS.Cfg.CfgFile
import           HS.Types
import           System.Directory
import           System.FilePath
import           Text.Enum.Text


-- | command driver to write the `cabal` wrappers out to @~/.hs/bin@
cmdDump :: Cfg -> Maybe InstallMode -> IO ()
cmdDump :: Cfg -> Maybe InstallMode -> IO ()
cmdDump Cfg
cfg Maybe InstallMode
mb = do
    FilePath
bin <- Cfg -> IO FilePath
bin_dir Cfg
cfg
    Builder -> IO ()
forall b. FromBuilder b => Builder -> b
fmtLn (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ Builder
"writing to "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|FilePath
binFilePath -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
":"
    [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
      [ Cfg
-> FilePath -> InstallMode -> ToolName -> CompilerVersion -> IO ()
write_wrapper Cfg
cfg FilePath
bin InstallMode
im ToolName
tnm CompilerVersion
vrn
        | CompilerVersion
vrn <- [CompilerVersion]
versions
        , ToolName
tnm <- [ToolName
forall a. Bounded a => a
minBound..ToolName
forall a. Bounded a => a
maxBound]
        ]
  where
    im :: InstallMode
im = InstallMode -> Maybe InstallMode -> InstallMode
forall a. a -> Maybe a -> a
fromMaybe (Cfg -> InstallMode
_cfg_mode Cfg
cfg) Maybe InstallMode
mb

write_wrapper :: Cfg -> FilePath -> InstallMode -> ToolName -> CompilerVersion -> IO ()
write_wrapper :: Cfg
-> FilePath -> InstallMode -> ToolName -> CompilerVersion -> IO ()
write_wrapper Cfg
_ FilePath
dir InstallMode
imd ToolName
tn CompilerVersion
cv = do
    Builder -> IO ()
forall b. FromBuilder b => Builder -> b
fmtLn (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ Builder
" "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|Builder
tlBuilder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
""
    FilePath -> Text -> IO ()
T.writeFile FilePath
fp (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Builder -> Text
forall b. FromBuilder b => Builder -> b
fmt (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF
      [ Builder
"#!/usr/bin/env bash"
      , Builder
"hs run "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|Builder
tlBuilder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
" --"Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|InstallMode
imdInstallMode -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
" -- \"$@\""    :: Builder
      ]
    FilePath -> Permissions -> IO ()
setPermissions FilePath
fp (Permissions -> IO ())
-> (Permissions -> Permissions) -> Permissions -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Permissions -> Permissions
setOwnerExecutable Bool
True (Permissions -> IO ()) -> IO Permissions -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO Permissions
getPermissions FilePath
fp
  where
    fp :: FilePath
fp = FilePath
dir FilePath -> FilePath -> FilePath
</> Builder -> FilePath
forall b. FromBuilder b => Builder -> b
fmt Builder
tl
    tl :: Builder
tl = Builder
""Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|ToolName
tnToolName -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
"-"Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|CompilerVersion
cvCompilerVersion -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
"" :: Builder

bin_dir :: Cfg -> IO FilePath
bin_dir :: Cfg -> IO FilePath
bin_dir Cfg
_ = FilePath -> IO FilePath
mk (FilePath -> IO FilePath) -> IO FilePath -> IO FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO FilePath
dotHs
  where
    mk :: FilePath -> IO FilePath
mk FilePath
dh = FilePath -> () -> FilePath
forall a b. a -> b -> a
const FilePath
bin (() -> FilePath) -> IO () -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
bin
      where
        bin :: FilePath
bin = FilePath
dh FilePath -> FilePath -> FilePath
</> FilePath
"bin"

versions :: [CompilerVersion]
versions :: [CompilerVersion]
versions = (FilePath -> [CompilerVersion])
-> ([CompilerVersion] -> [CompilerVersion])
-> Either FilePath [CompilerVersion]
-> [CompilerVersion]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> [CompilerVersion]
forall a. HasCallStack => FilePath -> a
error [CompilerVersion] -> [CompilerVersion]
forall a. a -> a
id (Either FilePath [CompilerVersion] -> [CompilerVersion])
-> Either FilePath [CompilerVersion] -> [CompilerVersion]
forall a b. (a -> b) -> a -> b
$ (Text -> Either FilePath CompilerVersion)
-> [Text] -> Either FilePath [CompilerVersion]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> Either FilePath CompilerVersion
forall a. TextParsable a => Text -> Possibly a
parseText
  [ Text
"9.2.1"

  , Text
"9.0.2"
  , Text
"9.0.1"

  , Text
"8.10.6"
  , Text
"8.10.5"
  , Text
"8.10.4"
  , Text
"8.10.3"
  , Text
"8.10.2"
  , Text
"8.10.1"

  , Text
"8.8.4"
  , Text
"8.8.3"
  , Text
"8.8.2"
  , Text
"8.8.1"

  , Text
"8.6.5"
  , Text
"8.6.4"
  , Text
"8.6.3"
  , Text
"8.6.2"
  , Text
"8.6.1"

  , Text
"8.4.4"
  , Text
"8.4.3"
  , Text
"8.4.2"
  , Text
"8.4.1"

  , Text
"8.2.2"
  , Text
"8.2.1"

  , Text
"8.0.2"
  , Text
"8.0.1"

  , Text
"7.10.3"
  , Text
"7.10.2"
  , Text
"7.10.1"

  , Text
"7.8.4"
  , Text
"7.8.3"
  , Text
"7.8.2"
  , Text
"7.8.1"

  , Text
"7.6.3"
  , Text
"7.6.2"
  , Text
"7.6.1"

  , Text
"7.4.2"
  , Text
"7.4.1"

  , Text
"7.2.2"
  , Text
"7.2.1"

  , Text
"7.0.4"
  , Text
"7.0.3"
  , Text
"7.0.2"
  , Text
"7.0.1"

  , Text
"6.12.3"
  , Text
"6.12.2"
  , Text
"6.12.1"
  ]