2 2
{-# LANGUAGE DeriveGeneric #-}
3 3
{-# LANGUAGE FlexibleContexts #-}
4 4
{-# LANGUAGE FlexibleInstances #-}
5 -
{-# LANGUAGE FunctionalDependencies #-}
6 5
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
7 6
{-# LANGUAGE LambdaCase #-}
8 7
{-# LANGUAGE MultiParamTypeClasses #-}
9 8
{-# LANGUAGE OverloadedStrings #-}
9 +
{-# LANGUAGE PatternSynonyms #-}
10 10
{-# LANGUAGE RecordWildCards #-}
11 11
{-# LANGUAGE ScopedTypeVariables #-}
12 -
{-# LANGUAGE TupleSections #-}
13 -
{-# LANGUAGE TypeApplications #-}
14 12
{-# LANGUAGE TypeInType #-}
15 13
{-# LANGUAGE TypeOperators #-}
16 14
{-# LANGUAGE ViewPatterns #-}
@@ -45,8 +43,10 @@ module Advent.Types (
45 43
, GlobalLeaderboardMember(..)
46 44
-- * Util
47 45
, mkDay, mkDay_, dayInt
46 +
, _DayInt, pattern DayInt
48 47
, partInt
49 48
, partChar
49 +
, fullDailyBoard
50 50
-- * Internal
51 51
, parseSubmitRes
52 52
) where
@@ -61,6 +61,7 @@ import Data.Functor.Classes
61 61
import Data.List.NonEmpty (NonEmpty(..))
62 62
import Data.Map (Map)
63 63
import Data.Maybe
64 +
import Data.Profunctor
64 65
import Data.Text (Text)
65 66
import Data.Time.Clock
66 67
import Data.Time.Clock.POSIX
@@ -70,6 +71,7 @@ import GHC.Generics
70 71
import Servant.API
71 72
import Text.Printf
72 73
import Text.Read (readMaybe)
74 +
import qualified Data.Map as M
73 75
import qualified Data.Text as T
74 76
import qualified Text.HTML.TagSoup as H
75 77
import qualified Text.Megaparsec as P
@@ -96,8 +98,6 @@ instance Show Day where
96 98
--
97 99
-- You can usually get 'Part1' (if it is already released) with a nonsense
98 100
-- session key, but 'Part2' always requires a valid session key.
99 -
--
100 -
-- Note also that Challenge #25 typically only has a single part.
101 101
data Part = Part1 | Part2
102 102
deriving (Show, Read, Eq, Ord, Enum, Bounded, Typeable, Generic)
103 103
@@ -400,9 +400,43 @@ mkDay_ = fromMaybe e . mkDay
400 400
where
401 401
e = errorWithoutStackTrace "Advent.mkDay_: Date out of range (1 - 25)"
402 402 403 +
-- | This is a @Prism' 'Integer' 'Day'@ , to treat an 'Integer' as if it
404 +
-- were a 'Day'.
405 +
--
406 +
-- @since 0.2.4.0
407 +
_DayInt :: (Choice p, Applicative f) => p Day (f Day) -> p Integer (f Integer)
408 +
_DayInt = dimap a b . right'
409 +
where
410 +
a i = maybe (Left i) Right . mkDay $ i
411 +
b = either pure (fmap dayInt)
412 + 413 +
-- | Pattern synonym allowing you to match on an 'Integer' as if it were
414 +
-- a 'Day':
415 +
--
416 +
-- @
417 +
-- case myInt of
418 +
-- DayInt d -> ...
419 +
-- _ -> ...
420 +
-- @
421 +
--
422 +
-- Will fail if the integer is out of bounds (outside of 1-25)
423 +
--
424 +
-- @since 0.2.4.0
425 +
pattern DayInt :: Day -> Integer
426 +
pattern DayInt d <- (mkDay->Just d)
427 +
where
428 +
DayInt d = dayInt d
429 + 403 430
-- | A character associated with a given part. 'Part1' is associated with
404 431
-- @\'a\'@, and 'Part2' is associated with @\'b\'@
405 432
partChar :: Part -> Char
406 433
partChar Part1 = 'a'
407 434
partChar Part2 = 'b'
408 435 436 +
-- | Check if a 'DailyLeaderboard' is filled up or not.
437 +
--
438 +
-- @since 0.2.4.0
439 +
fullDailyBoard
440 +
:: DailyLeaderboard
441 +
-> Bool
442 +
fullDailyBoard DLB{..} = (M.size dlbStar1 + M.size dlbStar2) >= 200
RetroSearch is an open source project built by @garambo | Open a GitHub Issue
Search and Browse the WWW like it's 1997 | Search results from DuckDuckGo
HTML:
3.2
| Encoding:
UTF-8
| Version:
0.7.4