hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Print alternative day if day not found

Browse Source
This commit is contained in:
Julian Ospald 2023-05-14 21:34:50 +08:00
parent 210816769a
commit aed478153d
No known key found for this signature in database
GPG Key ID: CCC85C0E40C06A8C
3 changed files with 21 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
app/ghcup/GHCup/OptParse/Common.hs
View File

@ -724,7 +724,9 @@ fromVersion' (SetToolTag Latest) tool = do
bimap mkTVer Just <$> getLatest dls tool ?? TagNotFound Latest tool
fromVersion' (SetToolDay day) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getByReleaseDay dls tool day ?? DayNotFound day tool
bimap mkTVer Just <$> case getByReleaseDay dls tool day of
Left ad -> throwE $ DayNotFound day tool ad
Right v -> pure v
fromVersion' (SetToolTag LatestPrerelease) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getLatestPrerelease dls tool ?? TagNotFound LatestPrerelease tool

7
lib/GHCup/Errors.hs
View File

@ -314,12 +314,15 @@ instance HFErrorProject TagNotFound where
eDesc _ = "Unable to find a tag of a tool"
-- | Unable to find a release day of a tool
data DayNotFound = DayNotFound Day Tool
data DayNotFound = DayNotFound Day Tool (Maybe Day)
deriving Show
instance Pretty DayNotFound where
pPrint (DayNotFound day tool) =
pPrint (DayNotFound day tool Nothing) =
text "Unable to find release date" <+> text (show day) <+> text "of tool" <+> pPrint tool
pPrint (DayNotFound day tool (Just alternateDay)) =
text "Unable to find release date" <+> text (show day) <+> text "of tool" <+> pPrint tool <+>
text "but found an alternative date" <+> text (show alternateDay)
instance HFErrorProject DayNotFound where
eBase _ = 95

16
lib/GHCup/Utils.hs
View File

@ -94,7 +94,8 @@ import qualified Streamly.Prelude as S
import Control.DeepSeq (force)
import GHC.IO (evaluate)
import System.Environment (getEnvironment, setEnv)
import Data.Time (Day)
import Data.Time (Day(..), diffDays, addDays)
import Debug.Trace
-- $setup
@ -890,8 +891,17 @@ getTagged tag =
to (Map.toDescList . Map.filter (\VersionInfo {..} -> tag `elem` _viTags))
% folding id
getByReleaseDay :: GHCupDownloads -> Tool -> Day -> Maybe (Version, VersionInfo)
getByReleaseDay av tool day = headOf (ix tool % getByReleaseDayFold day) av
getByReleaseDay :: GHCupDownloads -> Tool -> Day -> Either (Maybe Day) (Version, VersionInfo)
getByReleaseDay av tool day = let mvv = fromMaybe mempty $ headOf (ix tool) av
mdv = Map.foldrWithKey (\k vi@VersionInfo{..} m ->
maybe m (\d -> let diff = diffDays d day
in Map.insert (abs diff) (diff, (k, vi)) m) _viReleaseDay)
Map.empty mvv
in case headMay (Map.toAscList mdv) of
Nothing -> Left Nothing
Just (absDiff, (diff, (k, vi)))
| absDiff == 0 -> Right (k, vi)
| otherwise -> Left (Just (addDays diff day))
getByReleaseDayFold :: Day -> Fold (Map.Map Version VersionInfo) (Version, VersionInfo)
getByReleaseDayFold day = to (Map.toDescList . Map.filter (\VersionInfo {..} -> Just day == _viReleaseDay)) % folding id