1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
|
{- This Source Code Form is subject to the terms of the Mozilla Public License,
v. 2.0. If a copy of the MPL was not distributed with this file, You can
obtain one at https://mozilla.org/MPL/2.0/. -}
module Main
( main
) where
import Control.Monad.Catch (MonadThrow(..), handle)
import Control.Monad.IO.Class (MonadIO(..))
import qualified Data.Map as Map
import Options.Applicative (execParser)
import SlackBuilder.CommandLine
import SlackBuilder.Config
import SlackBuilder.Trans
import SlackBuilder.LatestVersionCheck
import SlackBuilder.Update
import qualified Toml
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import Control.Monad.Trans.Reader (ReaderT(..), asks)
import SlackBuilder.Package (PackageDescription(..), renderTextWithVersion)
import qualified SlackBuilder.Package as Package
import Data.Foldable (find, traverse_)
import GHC.Records (HasField(..))
import System.Console.ANSI
( setSGR
, SGR(..)
, ColorIntensity(..)
, Color(..)
, ConsoleLayer(..)
)
import Data.Maybe (mapMaybe)
import qualified Text.URI as URI
import System.Directory (listDirectory)
import qualified Data.HashMap.Strict as HashMap
import SlackBuilder.Info (readInfoFile)
autoUpdatable :: [PackageSettings] -> [PackageDescription]
autoUpdatable = mapMaybe go
where
go PackageSettings{ downloader = setting, downloaders } = do
latest' <- packageUpdaterFromSettings setting
pure $ PackageDescription
{ latest = latest'
, name = getField @"name" setting
, downloaders = Map.fromList $ mapMaybe forDownloader downloaders
}
forDownloader downloaderSettings@DownloaderSettings{ name } =
(name,) <$> packageUpdaterFromSettings downloaderSettings
packageUpdaterFromSettings :: DownloaderSettings -> Maybe Package.Updater
packageUpdaterFromSettings DownloaderSettings{..} = do
getVersion' <- getVersionSettings
detectLatest' <- detectLatestSettings
Just Package.Updater
{ detectLatest = detectLatest'
, getVersion = getVersion'
, is64 = is64
}
where
detectLatestSettings
| Just githubSettings <- github =
let ghArguments = uncurry PackageOwner githubSettings
in Just $ latestGitHub ghArguments version
| Just packagistSettings <- packagist =
let packagistArguments = uncurry PackageOwner packagistSettings
in Just $ latestPackagist packagistArguments
| Just textSettings <- text =
let textArguments = uncurry TextArguments textSettings
in Just $ latestText textArguments version
| otherwise = Nothing
getVersionSettings
| Just template' <- template =
Just $ repackageWithTemplate repackage $ Package.DownloadTemplate template'
| Just CloneSettings{..} <- clone
= flip cloneFromGit (renderTextWithVersion tagTemplate version)
<$> URI.mkURI remote
| otherwise = Nothing
up2Date :: Maybe Text -> SlackBuilderT ()
up2Date selectedPackage = do
packages' <- SlackBuilderT $ asks (getField @"packages")
case selectedPackage of
Nothing -> traverse_ (handle handleException . go) $ autoUpdatable packages'
Just packageName
| Just foundPackage <- find ((packageName ==) . getField @"name") (autoUpdatable packages') ->
go foundPackage
| otherwise -> throwM $ UpdaterNotFound packageName
where
go package = getAndLogLatest package
>>= mapM_ updatePackageIfRequired
>> liftIO (putStrLn "")
check :: SlackBuilderT ()
check = SlackBuilderT (asks (getField @"packages"))
>>= traverse_ (handle handleException . go) . autoUpdatable
where
go package = getAndLogLatest package
>>= mapM_ checkUpdateAvailability
>> liftIO (putStrLn "")
installed :: SlackBuilderT ()
installed = do
listing <- listRepository
database <- foldr createDataBase HashMap.empty . mapMaybe createEntry
<$> liftIO (listDirectory "/var/lib/pkgtools/packages")
traverse_ findInfo $ HashMap.intersectionWith (,) database listing
where
findInfo (installed'@Package.DataBaseEntry{ name }, fromRepository) = do
_ <- readInfoFile fromRepository name
liftIO $ print installed'
createDataBase entry@Package.DataBaseEntry{ name } =
HashMap.insert name entry
createEntry filename = createEntryFromChunks
$ Text.split (== '-')
$ Text.reverse
$ Text.pack filename
createEntryFromChunks (build : arch : version : name) = Just
Package.DataBaseEntry
{ arch = Text.reverse arch
, build = Text.reverse build
, version = Text.reverse version
, name = Text.reverse (Text.intercalate "-" name)
}
createEntryFromChunks _ = Nothing
main :: IO ()
main = execParser slackBuilderParser
>>= handle handleException . withCommandLine
where
withCommandLine programCommand = do
settingsResult <- Toml.decodeFileEither settingsCodec configurationFile
case settingsResult of
Right settings -> flip runReaderT settings
$ runSlackBuilderT
$ executeCommand programCommand
Left settingsErrors
-> setSGR [SetColor Foreground Dull Red]
>> putStrLn (configurationFile <> " parsing failed.")
>> setSGR [Reset]
>> Text.putStr (Toml.prettyTomlDecodeErrors settingsErrors)
configurationFile = "config/config.toml"
executeCommand = \case
CheckCommand -> check
Up2DateCommand packageName -> up2Date packageName
InstalledCommand -> installed
|
