{-# LANGUAGE ImplicitParams    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}

-- |
-- Module      : AOC.Interactive
-- Copyright   : (c) Justin Le 2018
-- License     : BSD3
--
-- Maintainer  : justin@jle.im
-- Stability   : experimental
-- Portability : non-portable
--
-- Run actions regarding challenges, solutions, tests, submissions, viewing
-- prompts, etc.
--
-- Essentially implements the functionality of the main app.
--

module AOC.Run (
  -- * Options
    TestSpec(..)
  -- * Runners
  -- ** Run solutions, tests, benchmarks
  , MainRunOpts(..), HasMainRunOpts(..), mainRun, defaultMRO
  -- ** View prompts
  , MainViewOpts(..), HasMainViewOpts(..), mainView, defaultMVO
  -- ** Submit answers
  , MainSubmitOpts(..), HasMainSubmitOpts(..), mainSubmit, defaultMSO
  -- * Util
  , withColor
  ) where

import           AOC.Challenge
import           AOC.Run.Config
import           AOC.Run.Load
import           AOC.Solver
import           AOC.Util
import           Advent
import           Control.Applicative
import           Control.Concurrent
import           Control.DeepSeq
import           Control.Exception
import           Control.Lens
import           Control.Monad
import           Control.Monad.Except
import           Criterion
import           Data.Bifunctor
import           Data.Char
import           Data.Map                 (Map)
import           Data.Maybe
import           Data.Text                (Text)
import           Data.Time hiding         (Day)
import           Text.Printf
import qualified Data.Map                 as M
import qualified Data.Set                 as S
import qualified Data.Text                as T
import qualified Data.Text.IO             as T
import qualified System.Console.ANSI      as ANSI
import qualified System.Console.Haskeline as H

-- | Specification of parts to test and run
data TestSpec = TSAll
              | TSDayAll  { TestSpec -> Day
_tsDay  :: Day           }
              | TSDayPart { TestSpec -> ChallengeSpec
_tsSpec :: ChallengeSpec }
  deriving Int -> TestSpec -> ShowS
[TestSpec] -> ShowS
TestSpec -> String
(Int -> TestSpec -> ShowS)
-> (TestSpec -> String) -> ([TestSpec] -> ShowS) -> Show TestSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestSpec] -> ShowS
$cshowList :: [TestSpec] -> ShowS
show :: TestSpec -> String
$cshow :: TestSpec -> String
showsPrec :: Int -> TestSpec -> ShowS
$cshowsPrec :: Int -> TestSpec -> ShowS
Show

-- | Options for 'mainRun'.
data MainRunOpts = MRO { MainRunOpts -> TestSpec
_mroSpec   :: !TestSpec
                       , MainRunOpts -> Bool
_mroActual :: !Bool     -- ^ Run input?  (Defualt: True
                       , MainRunOpts -> Bool
_mroTest   :: !Bool     -- ^ Run tests?  (Default: False)
                       , MainRunOpts -> Bool
_mroBench  :: !Bool     -- ^ Benchmark?  (Default: False)
                       , MainRunOpts -> Bool
_mroLock   :: !Bool     -- ^ Lock in answer as correct?  (Default: False)
                       , MainRunOpts -> Day -> Part -> IO (Maybe String)
_mroInput  :: !(Day -> Part -> IO (Maybe String))   -- ^ Manually supply input (Default: always return Nothing)
                       }

makeClassy ''MainRunOpts

-- | Options for 'mainView'.
data MainViewOpts = MVO { MainViewOpts -> TestSpec
_mvoSpec :: !TestSpec
                        , MainViewOpts -> Bool
_mvoWait :: !Bool
                        }
  deriving Int -> MainViewOpts -> ShowS
[MainViewOpts] -> ShowS
MainViewOpts -> String
(Int -> MainViewOpts -> ShowS)
-> (MainViewOpts -> String)
-> ([MainViewOpts] -> ShowS)
-> Show MainViewOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MainViewOpts] -> ShowS
$cshowList :: [MainViewOpts] -> ShowS
show :: MainViewOpts -> String
$cshow :: MainViewOpts -> String
showsPrec :: Int -> MainViewOpts -> ShowS
$cshowsPrec :: Int -> MainViewOpts -> ShowS
Show

makeClassy ''MainViewOpts

-- | Options for 'mainSubmit'
data MainSubmitOpts = MSO { MainSubmitOpts -> ChallengeSpec
_msoSpec  :: !ChallengeSpec
                          , MainSubmitOpts -> Bool
_msoTest  :: !Bool    -- ^ Run tests before submitting?  (Default: True)
                          , MainSubmitOpts -> Bool
_msoForce :: !Bool    -- ^ Force submission even if bad?  (Default: False)
                          , MainSubmitOpts -> Bool
_msoLock  :: !Bool    -- ^ Lock answer if submission succeeded?  (Default: True)
                          , MainSubmitOpts -> Bool
_msoRetry :: !Bool    -- ^ If a wait is received after submission, try again automatically (Default: False)
                          }
  deriving Int -> MainSubmitOpts -> ShowS
[MainSubmitOpts] -> ShowS
MainSubmitOpts -> String
(Int -> MainSubmitOpts -> ShowS)
-> (MainSubmitOpts -> String)
-> ([MainSubmitOpts] -> ShowS)
-> Show MainSubmitOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MainSubmitOpts] -> ShowS
$cshowList :: [MainSubmitOpts] -> ShowS
show :: MainSubmitOpts -> String
$cshow :: MainSubmitOpts -> String
showsPrec :: Int -> MainSubmitOpts -> ShowS
$cshowsPrec :: Int -> MainSubmitOpts -> ShowS
Show

makeClassy ''MainSubmitOpts

-- | Default options for 'mainRun'.
defaultMRO :: TestSpec -> MainRunOpts
defaultMRO :: TestSpec -> MainRunOpts
defaultMRO TestSpec
ts = MRO :: TestSpec
-> Bool
-> Bool
-> Bool
-> Bool
-> (Day -> Part -> IO (Maybe String))
-> MainRunOpts
MRO { _mroSpec :: TestSpec
_mroSpec   = TestSpec
ts
                    , _mroActual :: Bool
_mroActual = Bool
True
                    , _mroTest :: Bool
_mroTest   = Bool
False
                    , _mroBench :: Bool
_mroBench  = Bool
False
                    , _mroLock :: Bool
_mroLock   = Bool
False
                    , _mroInput :: Day -> Part -> IO (Maybe String)
_mroInput  = \Day
_ Part
_ -> Maybe String -> IO (Maybe String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing
                    }

-- | Default options for 'mainView'.
defaultMVO :: TestSpec -> MainViewOpts
defaultMVO :: TestSpec -> MainViewOpts
defaultMVO TestSpec
ts = MVO :: TestSpec -> Bool -> MainViewOpts
MVO { _mvoSpec :: TestSpec
_mvoSpec = TestSpec
ts
                    , _mvoWait :: Bool
_mvoWait = Bool
False
                    }

-- | Default options for 'mainSubmit'.
defaultMSO :: ChallengeSpec -> MainSubmitOpts
defaultMSO :: ChallengeSpec -> MainSubmitOpts
defaultMSO ChallengeSpec
cs = MSO :: ChallengeSpec -> Bool -> Bool -> Bool -> Bool -> MainSubmitOpts
MSO { _msoSpec :: ChallengeSpec
_msoSpec  = ChallengeSpec
cs
                    , _msoTest :: Bool
_msoTest  = Bool
True
                    , _msoForce :: Bool
_msoForce = Bool
False
                    , _msoLock :: Bool
_msoLock  = Bool
True
                    , _msoRetry :: Bool
_msoRetry = Bool
False
                    }

filterChallengeMap :: TestSpec -> Either String ChallengeMap
filterChallengeMap :: TestSpec -> Either String ChallengeMap
filterChallengeMap = \case
    TestSpec
TSAll      -> ChallengeMap -> Either String ChallengeMap
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChallengeMap
challengeMap
    TSDayAll Day
d -> String -> Maybe ChallengeMap -> Either String ChallengeMap
forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
maybeToEither (String -> Integer -> String
forall r. PrintfType r => String -> r
printf String
"Day not yet avaiable: %d" (Day -> Integer
dayInt Day
d)) (Maybe ChallengeMap -> Either String ChallengeMap)
-> Maybe ChallengeMap -> Either String ChallengeMap
forall a b. (a -> b) -> a -> b
$
                     Day -> Map Part SomeSolution -> ChallengeMap
forall k a. k -> a -> Map k a
M.singleton Day
d (Map Part SomeSolution -> ChallengeMap)
-> Maybe (Map Part SomeSolution) -> Maybe ChallengeMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Day -> ChallengeMap -> Maybe (Map Part SomeSolution)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Day
d ChallengeMap
challengeMap
    TSDayPart (CS Day
d Part
p) -> do
      Map Part SomeSolution
ps <- String
-> Maybe (Map Part SomeSolution)
-> Either String (Map Part SomeSolution)
forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
maybeToEither (String -> Integer -> String
forall r. PrintfType r => String -> r
printf String
"Day not yet available: %d" (Day -> Integer
dayInt Day
d)) (Maybe (Map Part SomeSolution)
 -> Either String (Map Part SomeSolution))
-> Maybe (Map Part SomeSolution)
-> Either String (Map Part SomeSolution)
forall a b. (a -> b) -> a -> b
$
              Day -> ChallengeMap -> Maybe (Map Part SomeSolution)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Day
d ChallengeMap
challengeMap
      SomeSolution
c  <- String -> Maybe SomeSolution -> Either String SomeSolution
forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
maybeToEither (String -> Char -> String
forall r. PrintfType r => String -> r
printf String
"Part not found: %c" (Part -> Char
partChar Part
p)) (Maybe SomeSolution -> Either String SomeSolution)
-> Maybe SomeSolution -> Either String SomeSolution
forall a b. (a -> b) -> a -> b
$
              Part -> Map Part SomeSolution -> Maybe SomeSolution
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Part
p Map Part SomeSolution
ps
      pure $ Day -> Map Part SomeSolution -> ChallengeMap
forall k a. k -> a -> Map k a
M.singleton Day
d (Part -> SomeSolution -> Map Part SomeSolution
forall k a. k -> a -> Map k a
M.singleton Part
p SomeSolution
c)

-- | Run, test, bench.
mainRun
    :: (MonadIO m, MonadError [String] m)
    => Config
    -> MainRunOpts
    -> m (Map Day (Map Part (Maybe Bool, Either [String] String)))  -- whether or not passed tests, and result
mainRun :: forall (m :: * -> *).
(MonadIO m, MonadError [String] m) =>
Config
-> MainRunOpts
-> m (Map Day (Map Part (Maybe Bool, Either [String] String)))
mainRun Cfg{Integer
Maybe String
_cfgYear :: Config -> Integer
_cfgSession :: Config -> Maybe String
_cfgYear :: Integer
_cfgSession :: Maybe String
..} MRO{Bool
TestSpec
Day -> Part -> IO (Maybe String)
_mroInput :: Day -> Part -> IO (Maybe String)
_mroLock :: Bool
_mroBench :: Bool
_mroTest :: Bool
_mroActual :: Bool
_mroSpec :: TestSpec
_mroInput :: MainRunOpts -> Day -> Part -> IO (Maybe String)
_mroLock :: MainRunOpts -> Bool
_mroBench :: MainRunOpts -> Bool
_mroTest :: MainRunOpts -> Bool
_mroActual :: MainRunOpts -> Bool
_mroSpec :: MainRunOpts -> TestSpec
..} =  do
    ChallengeMap
toRun <- Either [String] ChallengeMap -> m ChallengeMap
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either [String] ChallengeMap -> m ChallengeMap)
-> (TestSpec -> Either [String] ChallengeMap)
-> TestSpec
-> m ChallengeMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [String])
-> Either String ChallengeMap -> Either [String] ChallengeMap
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[]) (Either String ChallengeMap -> Either [String] ChallengeMap)
-> (TestSpec -> Either String ChallengeMap)
-> TestSpec
-> Either [String] ChallengeMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestSpec -> Either String ChallengeMap
filterChallengeMap (TestSpec -> m ChallengeMap) -> TestSpec -> m ChallengeMap
forall a b. (a -> b) -> a -> b
$ TestSpec
_mroSpec
    IO (Map Day (Map Part (Maybe Bool, Either [String] String)))
-> m (Map Day (Map Part (Maybe Bool, Either [String] String)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Map Day (Map Part (Maybe Bool, Either [String] String)))
 -> m (Map Day (Map Part (Maybe Bool, Either [String] String))))
-> ((SomeSolution
     -> Maybe String
     -> ChallengeData
     -> IO (Maybe Bool, Either [String] String))
    -> IO (Map Day (Map Part (Maybe Bool, Either [String] String))))
-> (SomeSolution
    -> Maybe String
    -> ChallengeData
    -> IO (Maybe Bool, Either [String] String))
-> m (Map Day (Map Part (Maybe Bool, Either [String] String)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String
-> Integer
-> Bool
-> (Day -> Part -> IO (Maybe String))
-> ChallengeMap
-> (SomeSolution
    -> Maybe String
    -> ChallengeData
    -> IO (Maybe Bool, Either [String] String))
-> IO (Map Day (Map Part (Maybe Bool, Either [String] String)))
forall a.
Maybe String
-> Integer
-> Bool
-> (Day -> Part -> IO (Maybe String))
-> ChallengeMap
-> (SomeSolution -> Maybe String -> ChallengeData -> IO a)
-> IO (Map Day (Map Part a))
runAll Maybe String
_cfgSession Integer
_cfgYear Bool
_mroLock Day -> Part -> IO (Maybe String)
_mroInput ChallengeMap
toRun ((SomeSolution
  -> Maybe String
  -> ChallengeData
  -> IO (Maybe Bool, Either [String] String))
 -> m (Map Day (Map Part (Maybe Bool, Either [String] String))))
-> (SomeSolution
    -> Maybe String
    -> ChallengeData
    -> IO (Maybe Bool, Either [String] String))
-> m (Map Day (Map Part (Maybe Bool, Either [String] String)))
forall a b. (a -> b) -> a -> b
$ \SomeSolution
c Maybe String
inp0 cd :: ChallengeData
cd@CD{[(String, TestMeta)]
Maybe String
Either [String] String
Either [String] Text
_cdTests :: ChallengeData -> [(String, TestMeta)]
_cdAnswer :: ChallengeData -> Maybe String
_cdInput :: ChallengeData -> Either [String] String
_cdPrompt :: ChallengeData -> Either [String] Text
_cdTests :: [(String, TestMeta)]
_cdAnswer :: Maybe String
_cdInput :: Either [String] String
_cdPrompt :: Either [String] Text
..} -> do
      Maybe Bool
testRes <- (Maybe (Maybe Bool) -> Maybe Bool)
-> IO (Maybe (Maybe Bool)) -> IO (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe Bool) -> Maybe Bool
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (Maybe (Maybe Bool)) -> IO (Maybe Bool))
-> ((() -> IO (Maybe Bool)) -> IO (Maybe (Maybe Bool)))
-> (() -> IO (Maybe Bool))
-> IO (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe () -> (() -> IO (Maybe Bool)) -> IO (Maybe (Maybe Bool))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
_mroTest) ((() -> IO (Maybe Bool)) -> IO (Maybe Bool))
-> (() -> IO (Maybe Bool)) -> IO (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ \()
_ ->
        SomeSolution -> ChallengeData -> IO (Maybe Bool)
runTestSuite SomeSolution
c ChallengeData
cd

      let inp1 :: Either [String] String
inp1 = ShowS
strip ShowS -> Either [String] String -> Either [String] String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either [String] String
-> (String -> Either [String] String)
-> Maybe String
-> Either [String] String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Either [String] String
_cdInput  String -> Either [String] String
forall a b. b -> Either a b
Right           Maybe String
inp0
          ans1 :: Maybe String
ans1 = ShowS
strip ShowS -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
-> (String -> Maybe String) -> Maybe String -> Maybe String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe String
_cdAnswer (Maybe String -> String -> Maybe String
forall a b. a -> b -> a
const Maybe String
forall a. Maybe a
Nothing) Maybe String
inp0
      case Either [String] String
inp1 of
        Right String
inp
          | Bool
_mroBench -> do
              String
_ <- String -> IO String
forall a. a -> IO a
evaluate (ShowS
forall a. NFData a => a -> a
force String
inp)
              let res :: (Maybe Bool, Either [String] String)
res    = (Maybe Bool
testRes, [String] -> Either [String] String
forall a b. a -> Either a b
Left [String
"Ran benchmark, so no result"])
              (Maybe Bool, Either [String] String)
res (Maybe Bool, Either [String] String)
-> IO () -> IO (Maybe Bool, Either [String] String)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ case SomeSolution
c of
                MkSomeSolWH a :~> b
_         ->
                      Benchmarkable -> IO ()
benchmark ((String -> Either SolutionError String) -> String -> Benchmarkable
forall b a. NFData b => (a -> b) -> a -> Benchmarkable
nf (SomeSolution -> String -> Either SolutionError String
runSomeSolution SomeSolution
c) String
inp)
                MkSomeSolNF MkSol{b -> String
(?dyno::DynoMap) => a -> Maybe b
String -> Maybe a
sShow :: forall a b. (a :~> b) -> b -> String
sSolve :: forall a b. (a :~> b) -> (?dyno::DynoMap) => a -> Maybe b
sParse :: forall a b. (a :~> b) -> String -> Maybe a
sShow :: b -> String
sSolve :: (?dyno::DynoMap) => a -> Maybe b
sParse :: String -> Maybe a
..}
                  | Just a
x <- String -> Maybe a
sParse String
inp -> do
                      a
_ <- a -> IO a
forall a. a -> IO a
evaluate (a -> a
forall a. NFData a => a -> a
force a
x)
                      Benchmarkable -> IO ()
benchmark ((a -> Maybe b) -> a -> Benchmarkable
forall b a. NFData b => (a -> b) -> a -> Benchmarkable
nf (let ?dyno = ?dyno::DynoMap
forall a. Monoid a => a
mempty in a -> Maybe b
(?dyno::DynoMap) => a -> Maybe b
sSolve) a
x)
                      String -> IO ()
putStrLn String
"* parsing and formatting times excluded"
                      String -> IO ()
putStrLn String
""
                  | Bool
otherwise            ->
                      String -> IO ()
putStrLn String
"(No parse)"
          | Bool
_mroActual -> ((Either SolutionError String -> Either [String] String)
-> (Maybe Bool, Either SolutionError String)
-> (Maybe Bool, Either [String] String)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Either SolutionError String -> Either [String] String)
 -> (Maybe Bool, Either SolutionError String)
 -> (Maybe Bool, Either [String] String))
-> ((SolutionError -> [String])
    -> Either SolutionError String -> Either [String] String)
-> (SolutionError -> [String])
-> (Maybe Bool, Either SolutionError String)
-> (Maybe Bool, Either [String] String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SolutionError -> [String])
-> Either SolutionError String -> Either [String] String
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first) ((String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[]) (String -> [String])
-> (SolutionError -> String) -> SolutionError -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SolutionError -> String
forall a. Show a => a -> String
show) ((Maybe Bool, Either SolutionError String)
 -> (Maybe Bool, Either [String] String))
-> IO (Maybe Bool, Either SolutionError String)
-> IO (Maybe Bool, Either [String] String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> SomeSolution
-> String
-> TestMeta
-> IO (Maybe Bool, Either SolutionError String)
testCase Bool
False SomeSolution
c String
inp (Maybe String -> Map String Dynamic -> TestMeta
TM Maybe String
ans1 Map String Dynamic
forall k a. Map k a
M.empty)
          | Bool
otherwise   -> (Maybe Bool, Either [String] String)
-> IO (Maybe Bool, Either [String] String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Bool
testRes, [String] -> Either [String] String
forall a b. a -> Either a b
Left [String
"Actual input skipped"])
        Left [String]
e
          | Bool
_mroTest  -> (Maybe Bool, Either [String] String)
-> IO (Maybe Bool, Either [String] String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Bool
testRes, [String] -> Either [String] String
forall a b. a -> Either a b
Left [String
"Ran tests, so no result"])
          | Bool
otherwise -> (Maybe Bool
testRes, [String] -> Either [String] String
forall a b. a -> Either a b
Left [String]
e) (Maybe Bool, Either [String] String)
-> IO () -> IO (Maybe Bool, Either [String] String)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> IO ()
putStrLn String
"[INPUT ERROR]" IO (Maybe Bool, Either [String] String)
-> IO () -> IO (Maybe Bool, Either [String] String)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
putStrLn [String]
e

-- | View prompt
mainView
    :: (MonadIO m, MonadError [String] m)
    => Config
    -> MainViewOpts
    -> m (Map Day (Map Part Text))
mainView :: forall (m :: * -> *).
(MonadIO m, MonadError [String] m) =>
Config -> MainViewOpts -> m (Map Day (Map Part Text))
mainView Cfg{Integer
Maybe String
_cfgYear :: Integer
_cfgSession :: Maybe String
_cfgYear :: Config -> Integer
_cfgSession :: Config -> Maybe String
..} MVO{Bool
TestSpec
_mvoWait :: Bool
_mvoSpec :: TestSpec
_mvoWait :: MainViewOpts -> Bool
_mvoSpec :: MainViewOpts -> TestSpec
..} = do
    let toRun :: Set (Day, Part)
toRun = Set (Day, Part)
-> (ChallengeMap -> Set (Day, Part))
-> Maybe ChallengeMap
-> Set (Day, Part)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set (Day, Part)
forall a. Set a
S.empty (Map (Day, Part) SomeSolution -> Set (Day, Part)
forall k a. Map k a -> Set k
M.keysSet (Map (Day, Part) SomeSolution -> Set (Day, Part))
-> (ChallengeMap -> Map (Day, Part) SomeSolution)
-> ChallengeMap
-> Set (Day, Part)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChallengeMap -> Map (Day, Part) SomeSolution
forall a b c. Map a (Map b c) -> Map (a, b) c
pullMap)
              (Maybe ChallengeMap -> Set (Day, Part))
-> (TestSpec -> Maybe ChallengeMap) -> TestSpec -> Set (Day, Part)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String ChallengeMap -> Maybe ChallengeMap
forall (m :: * -> *) e a. Alternative m => Either e a -> m a
eitherToMaybe
              (Either String ChallengeMap -> Maybe ChallengeMap)
-> (TestSpec -> Either String ChallengeMap)
-> TestSpec
-> Maybe ChallengeMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestSpec -> Either String ChallengeMap
filterChallengeMap
              (TestSpec -> Set (Day, Part)) -> TestSpec -> Set (Day, Part)
forall a b. (a -> b) -> a -> b
$ TestSpec
_mvoSpec
        allRun :: Set (Day, Part)
allRun = ((Day, Part) -> Set (Day, Part))
-> Maybe (Day, Part) -> Set (Day, Part)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Day, Part) -> Set (Day, Part)
forall a. a -> Set a
S.singleton Maybe (Day, Part)
singleTest Set (Day, Part) -> Set (Day, Part) -> Set (Day, Part)
forall a. Semigroup a => a -> a -> a
<> Set (Day, Part)
toRun
    (Map (Day, Part) Text -> Map Day (Map Part Text))
-> m (Map (Day, Part) Text) -> m (Map Day (Map Part Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map (Day, Part) Text -> Map Day (Map Part Text)
forall a b c. Eq a => Map (a, b) c -> Map a (Map b c)
pushMap (m (Map (Day, Part) Text) -> m (Map Day (Map Part Text)))
-> (((Day, Part) -> m Text) -> m (Map (Day, Part) Text))
-> ((Day, Part) -> m Text)
-> m (Map Day (Map Part Text))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (Day, Part) (m Text) -> m (Map (Day, Part) Text)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (Map (Day, Part) (m Text) -> m (Map (Day, Part) Text))
-> (((Day, Part) -> m Text) -> Map (Day, Part) (m Text))
-> ((Day, Part) -> m Text)
-> m (Map (Day, Part) Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Day, Part) -> m Text)
 -> Set (Day, Part) -> Map (Day, Part) (m Text))
-> Set (Day, Part)
-> ((Day, Part) -> m Text)
-> Map (Day, Part) (m Text)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Day, Part) -> m Text)
-> Set (Day, Part) -> Map (Day, Part) (m Text)
forall k a. (k -> a) -> Set k -> Map k a
M.fromSet Set (Day, Part)
allRun (((Day, Part) -> m Text) -> m (Map Day (Map Part Text)))
-> ((Day, Part) -> m Text) -> m (Map Day (Map Part Text))
forall a b. (a -> b) -> a -> b
$ \(Day
d,Part
p) -> do
      Text
pmpt   <- Day -> m Text -> m Text
waitFunc Day
d (m Text -> m Text) -> m Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
        CD{[(String, TestMeta)]
Maybe String
Either [String] String
Either [String] Text
_cdTests :: [(String, TestMeta)]
_cdAnswer :: Maybe String
_cdInput :: Either [String] String
_cdPrompt :: Either [String] Text
_cdTests :: ChallengeData -> [(String, TestMeta)]
_cdAnswer :: ChallengeData -> Maybe String
_cdInput :: ChallengeData -> Either [String] String
_cdPrompt :: ChallengeData -> Either [String] Text
..} <- IO ChallengeData -> m ChallengeData
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ChallengeData -> m ChallengeData)
-> IO ChallengeData -> m ChallengeData
forall a b. (a -> b) -> a -> b
$ Maybe String -> Integer -> ChallengeSpec -> IO ChallengeData
challengeData Maybe String
_cfgSession Integer
_cfgYear (Day -> Part -> ChallengeSpec
CS Day
d Part
p)
        Either [String] Text -> m Text
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either [String] Text -> m Text)
-> (Either [String] Text -> Either [String] Text)
-> Either [String] Text
-> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> [String])
-> Either [String] Text -> Either [String] Text
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String
"[PROMPT ERROR]"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:) (Either [String] Text -> m Text) -> Either [String] Text -> m Text
forall a b. (a -> b) -> a -> b
$ Either [String] Text
_cdPrompt
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        ColorIntensity -> Color -> IO () -> IO ()
withColor ColorIntensity
ANSI.Dull Color
ANSI.Blue (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          String -> Integer -> Char -> IO ()
forall r. PrintfType r => String -> r
printf String
">> Day %02d%c\n" (Day -> Integer
dayInt Day
d) (Part -> Char
partChar Part
p)
        Text -> IO ()
T.putStrLn Text
pmpt
        String -> IO ()
putStrLn String
""
      pure Text
pmpt
  where
    waitFunc :: Day -> m Text -> m Text
waitFunc Day
d
      | Bool
_mvoWait  = Integer -> Day -> m Text -> m Text
forall (m :: * -> *) a. MonadIO m => Integer -> Day -> m a -> m a
countdownConsole Integer
_cfgYear Day
d (m Text -> m Text) -> (m Text -> m Text) -> m Text -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Int -> IO ()
threadDelay Int
500000) m () -> m Text -> m Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>)
      | Bool
otherwise = m Text -> m Text
forall a. a -> a
id
    singleTest :: Maybe (Day, Part)
singleTest = case TestSpec
_mvoSpec of
      TestSpec
TSAll        -> Maybe (Day, Part)
forall a. Maybe a
Nothing
      TSDayAll Day
d   -> (Day, Part) -> Maybe (Day, Part)
forall a. a -> Maybe a
Just (Day
d, Part
Part1)
      TSDayPart ChallengeSpec
cs -> (Day, Part) -> Maybe (Day, Part)
forall a. a -> Maybe a
Just (ChallengeSpec -> Day
_csDay ChallengeSpec
cs, ChallengeSpec -> Part
_csPart ChallengeSpec
cs)

-- | Submit and analyze result
mainSubmit
    :: (MonadIO m, MonadError [String] m)
    => Config
    -> MainSubmitOpts
    -> m (Text, SubmitRes)
mainSubmit :: forall (m :: * -> *).
(MonadIO m, MonadError [String] m) =>
Config -> MainSubmitOpts -> m (Text, SubmitRes)
mainSubmit Cfg{Integer
Maybe String
_cfgYear :: Integer
_cfgSession :: Maybe String
_cfgYear :: Config -> Integer
_cfgSession :: Config -> Maybe String
..} MSO{Bool
ChallengeSpec
_msoRetry :: Bool
_msoLock :: Bool
_msoForce :: Bool
_msoTest :: Bool
_msoSpec :: ChallengeSpec
_msoRetry :: MainSubmitOpts -> Bool
_msoLock :: MainSubmitOpts -> Bool
_msoForce :: MainSubmitOpts -> Bool
_msoTest :: MainSubmitOpts -> Bool
_msoSpec :: MainSubmitOpts -> ChallengeSpec
..} = do
    cd :: ChallengeData
cd@CD{[(String, TestMeta)]
Maybe String
Either [String] String
Either [String] Text
_cdTests :: [(String, TestMeta)]
_cdAnswer :: Maybe String
_cdInput :: Either [String] String
_cdPrompt :: Either [String] Text
_cdTests :: ChallengeData -> [(String, TestMeta)]
_cdAnswer :: ChallengeData -> Maybe String
_cdInput :: ChallengeData -> Either [String] String
_cdPrompt :: ChallengeData -> Either [String] Text
..} <- IO ChallengeData -> m ChallengeData
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ChallengeData -> m ChallengeData)
-> IO ChallengeData -> m ChallengeData
forall a b. (a -> b) -> a -> b
$ Maybe String -> Integer -> ChallengeSpec -> IO ChallengeData
challengeData Maybe String
_cfgSession Integer
_cfgYear ChallengeSpec
_msoSpec
    Map Part SomeSolution
dMap      <- [String]
-> Maybe (Map Part SomeSolution) -> m (Map Part SomeSolution)
forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
maybeToEither [String -> Integer -> String
forall r. PrintfType r => String -> r
printf String
"Day not yet available: %d" Integer
d'] (Maybe (Map Part SomeSolution) -> m (Map Part SomeSolution))
-> Maybe (Map Part SomeSolution) -> m (Map Part SomeSolution)
forall a b. (a -> b) -> a -> b
$
                   Day -> ChallengeMap -> Maybe (Map Part SomeSolution)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Day
_csDay ChallengeMap
challengeMap
    SomeSolution
c         <- [String] -> Maybe SomeSolution -> m SomeSolution
forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
maybeToEither [String -> Char -> String
forall r. PrintfType r => String -> r
printf String
"Part not found: %c" (Part -> Char
partChar Part
_csPart)] (Maybe SomeSolution -> m SomeSolution)
-> Maybe SomeSolution -> m SomeSolution
forall a b. (a -> b) -> a -> b
$
                   Part -> Map Part SomeSolution -> Maybe SomeSolution
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Part
_csPart Map Part SomeSolution
dMap
    String
inp       <- Either [String] String -> m String
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either [String] String -> m String)
-> (Either [String] String -> Either [String] String)
-> Either [String] String
-> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> [String])
-> Either [String] String -> Either [String] String
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String
"[PROMPT ERROR]"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:) (Either [String] String -> m String)
-> Either [String] String -> m String
forall a b. (a -> b) -> a -> b
$ Either [String] String
_cdInput
    AoCOpts
opts      <- Integer -> String -> AoCOpts
defaultAoCOpts Integer
_cfgYear (String -> AoCOpts) -> m String -> m AoCOpts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                    [String] -> Maybe String -> m String
forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
maybeToEither [String
"ERROR: Session Key Required to Submit"]
                      Maybe String
_cfgSession

    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
_msoTest (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      Maybe Bool
testRes <- IO (Maybe Bool) -> m (Maybe Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Bool) -> m (Maybe Bool))
-> IO (Maybe Bool) -> m (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ SomeSolution -> ChallengeData -> IO (Maybe Bool)
runTestSuite SomeSolution
c ChallengeData
cd
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and Maybe Bool
testRes) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        if Bool
_msoForce
          then IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"Proceeding with submission despite test failures (--force)"
          else do
            Maybe Char
conf <- IO (Maybe Char) -> m (Maybe Char)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Char) -> m (Maybe Char))
-> (InputT IO (Maybe Char) -> IO (Maybe Char))
-> InputT IO (Maybe Char)
-> m (Maybe Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Settings IO -> InputT IO (Maybe Char) -> IO (Maybe Char)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Settings m -> InputT m a -> m a
H.runInputT Settings IO
forall (m :: * -> *). MonadIO m => Settings m
H.defaultSettings (InputT IO (Maybe Char) -> m (Maybe Char))
-> InputT IO (Maybe Char) -> m (Maybe Char)
forall a b. (a -> b) -> a -> b
$
              String -> InputT IO (Maybe Char)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m (Maybe Char)
H.getInputChar String
"Some tests failed. Are you sure you wish to proceed? y/(n) "
            case Char -> Char
toLower (Char -> Char) -> Maybe Char -> Maybe Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Char
conf of
              Just Char
'y' -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
              Maybe Char
_        -> [String] -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError [String
"Submission aborted."]

    Either SolutionError String
resEither <- IO (Either SolutionError String) -> m (Either SolutionError String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SolutionError String)
 -> m (Either SolutionError String))
-> (String -> IO (Either SolutionError String))
-> String
-> m (Either SolutionError String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either SolutionError String -> IO (Either SolutionError String)
forall a. a -> IO a
evaluate (Either SolutionError String -> IO (Either SolutionError String))
-> (String -> Either SolutionError String)
-> String
-> IO (Either SolutionError String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either SolutionError String -> Either SolutionError String
forall a. NFData a => a -> a
force (Either SolutionError String -> Either SolutionError String)
-> (String -> Either SolutionError String)
-> String
-> Either SolutionError String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeSolution -> String -> Either SolutionError String
runSomeSolution SomeSolution
c (String -> m (Either SolutionError String))
-> String -> m (Either SolutionError String)
forall a b. (a -> b) -> a -> b
$ String
inp
    String
res       <- Either [String] String -> m String
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either [String] String -> m String)
-> (Either SolutionError String -> Either [String] String)
-> Either SolutionError String
-> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SolutionError -> [String])
-> Either SolutionError String -> Either [String] String
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((String
"[SOLUTION ERROR]"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:) ([String] -> [String])
-> (SolutionError -> [String]) -> SolutionError -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[]) (String -> [String])
-> (SolutionError -> String) -> SolutionError -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SolutionError -> String
forall a. Show a => a -> String
show) (Either SolutionError String -> m String)
-> Either SolutionError String -> m String
forall a b. (a -> b) -> a -> b
$ Either SolutionError String
resEither
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
forall r. PrintfType r => String -> r
printf String
"Submitting solution: %s\n" String
res

    let submitter :: m (Either AoCError (Text, SubmitRes))
submitter
          | Bool
_msoRetry = AoCOpts
-> Day -> Part -> String -> m (Either AoCError (Text, SubmitRes))
forall (m :: * -> *).
MonadIO m =>
AoCOpts
-> Day -> Part -> String -> m (Either AoCError (Text, SubmitRes))
submitRetry AoCOpts
opts Day
_csDay Part
_csPart String
res
          | Bool
otherwise = IO (Either AoCError (Text, SubmitRes))
-> m (Either AoCError (Text, SubmitRes))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either AoCError (Text, SubmitRes))
 -> m (Either AoCError (Text, SubmitRes)))
-> IO (Either AoCError (Text, SubmitRes))
-> m (Either AoCError (Text, SubmitRes))
forall a b. (a -> b) -> a -> b
$ AoCOpts
-> AoC (Text, SubmitRes) -> IO (Either AoCError (Text, SubmitRes))
forall a. AoCOpts -> AoC a -> IO (Either AoCError a)
runAoC AoCOpts
opts (Day -> Part -> String -> AoC (Text, SubmitRes)
AoCSubmit Day
_csDay Part
_csPart String
res)
    output :: (Text, SubmitRes)
output@(Text
resp, SubmitRes
status) <- Either [String] (Text, SubmitRes) -> m (Text, SubmitRes)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either [String] (Text, SubmitRes) -> m (Text, SubmitRes))
-> (Either AoCError (Text, SubmitRes)
    -> Either [String] (Text, SubmitRes))
-> Either AoCError (Text, SubmitRes)
-> m (Text, SubmitRes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AoCError -> [String])
-> Either AoCError (Text, SubmitRes)
-> Either [String] (Text, SubmitRes)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first AoCError -> [String]
showAoCError (Either AoCError (Text, SubmitRes) -> m (Text, SubmitRes))
-> m (Either AoCError (Text, SubmitRes)) -> m (Text, SubmitRes)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (Either AoCError (Text, SubmitRes))
submitter
    let resp' :: String
resp' = [Text] -> String
formatResp
              ([Text] -> String) -> (Text -> [Text]) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> [Text])
-> (Text -> [Text]) -> Either [String] Text -> [Text]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack) Text -> [Text]
T.lines
              (Either [String] Text -> [Text])
-> (Text -> Either [String] Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Text -> Either [String] Text
htmlToMarkdown Bool
False
              (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
resp
        (Color
color, Bool
lock, String
out) = SubmitRes -> (Color, Bool, String)
displayStatus SubmitRes
status
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      ColorIntensity -> Color -> IO () -> IO ()
withColor ColorIntensity
ANSI.Vivid Color
color (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> IO ()
putStrLn String
out
      String -> IO ()
putStrLn String
resp'
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
lock (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        if Bool
_msoLock
          then String -> IO ()
putStrLn String
"Locking correct answer." IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> String -> IO ()
writeFile String
_cpAnswer String
res
          else String -> IO ()
putStrLn String
"Not locking correct answer (--no-lock)"
      ZonedTime
zt <- IO ZonedTime
getZonedTime
      String -> String -> IO ()
appendFile String
_cpLog (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String -> Text -> ShowS
forall r. PrintfType r => String -> r
printf String
logFmt (ZonedTime -> String
forall a. Show a => a -> String
show ZonedTime
zt) String
res (SubmitRes -> String
showSubmitRes SubmitRes
status) Text
resp String
resp'
    pure (Text, SubmitRes)
output
  where
    CS{Day
Part
_csPart :: Part
_csDay :: Day
_csPart :: ChallengeSpec -> Part
_csDay :: ChallengeSpec -> Day
..} = ChallengeSpec
_msoSpec
    CP{String
_cpLog :: ChallengePaths -> String
_cpTests :: ChallengePaths -> String
_cpAnswer :: ChallengePaths -> String
_cpInput :: ChallengePaths -> String
_cpPrompt :: ChallengePaths -> String
_cpTests :: String
_cpInput :: String
_cpPrompt :: String
_cpLog :: String
_cpAnswer :: String
..} = Integer -> ChallengeSpec -> ChallengePaths
challengePaths Integer
_cfgYear ChallengeSpec
_msoSpec
    d' :: Integer
d' = Day -> Integer
dayInt Day
_csDay
    formatResp :: [Text] -> String
formatResp = Text -> String
T.unpack (Text -> String) -> ([Text] -> Text) -> [Text] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
"> " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
    logFmt :: String
logFmt = [String] -> String
unlines [ String
"[%s]"
                     , String
"Submission: %s"
                     , String
"Status: %s"
                     , String
"Raw: %s"
                     , String
"%s"
                     ]

submitRetry
    :: MonadIO m
    => AoCOpts
    -> Day
    -> Part
    -> String
    -> m (Either AoCError (Text, SubmitRes))
submitRetry :: forall (m :: * -> *).
MonadIO m =>
AoCOpts
-> Day -> Part -> String -> m (Either AoCError (Text, SubmitRes))
submitRetry AoCOpts
opts Day
d Part
p String
ans = ExceptT AoCError m (Text, SubmitRes)
-> m (Either AoCError (Text, SubmitRes))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT AoCError m (Text, SubmitRes)
go
  where
    go :: ExceptT AoCError m (Text, SubmitRes)
go = do
      out :: (Text, SubmitRes)
out@(Text
_, SubmitRes
status) <- m (Either AoCError (Text, SubmitRes))
-> ExceptT AoCError m (Text, SubmitRes)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either AoCError (Text, SubmitRes))
 -> ExceptT AoCError m (Text, SubmitRes))
-> (IO (Either AoCError (Text, SubmitRes))
    -> m (Either AoCError (Text, SubmitRes)))
-> IO (Either AoCError (Text, SubmitRes))
-> ExceptT AoCError m (Text, SubmitRes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either AoCError (Text, SubmitRes))
-> m (Either AoCError (Text, SubmitRes))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either AoCError (Text, SubmitRes))
 -> ExceptT AoCError m (Text, SubmitRes))
-> IO (Either AoCError (Text, SubmitRes))
-> ExceptT AoCError m (Text, SubmitRes)
forall a b. (a -> b) -> a -> b
$ AoCOpts
-> AoC (Text, SubmitRes) -> IO (Either AoCError (Text, SubmitRes))
forall a. AoCOpts -> AoC a -> IO (Either AoCError a)
runAoC AoCOpts
opts (Day -> Part -> String -> AoC (Text, SubmitRes)
AoCSubmit Day
d Part
p String
ans)
      case SubmitRes
status of
        SubWait Int
i -> do
          IO () -> ExceptT AoCError m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT AoCError m ())
-> (IO () -> IO ()) -> IO () -> ExceptT AoCError m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColorIntensity -> Color -> IO () -> IO ()
withColor ColorIntensity
ANSI.Vivid Color
ANSI.Yellow (IO () -> ExceptT AoCError m ()) -> IO () -> ExceptT AoCError m ()
forall a b. (a -> b) -> a -> b
$
              String -> Int -> IO ()
forall r. PrintfType r => String -> r
printf String
"Automatically waiting %d seconds to re-submit...\n" Int
i
          -- 0.1 to account for latency
          UTCTime
resubTime <- NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (Pico -> NominalDiffTime
secondsToNominalDiffTime (Int -> Pico
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Pico -> Pico -> Pico
forall a. Num a => a -> a -> a
- Pico
0.1)) (UTCTime -> UTCTime)
-> ExceptT AoCError m UTCTime -> ExceptT AoCError m UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime -> ExceptT AoCError m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
          ExceptT AoCError m NominalDiffTime
-> Int
-> String
-> ExceptT AoCError m (Text, SubmitRes)
-> ExceptT AoCError m (Text, SubmitRes)
forall (m :: * -> *) a.
MonadIO m =>
m NominalDiffTime -> Int -> String -> m a -> m a
countdownWithPrint
            ((UTCTime
resubTime UTCTime -> UTCTime -> NominalDiffTime
`diffUTCTime`) (UTCTime -> NominalDiffTime)
-> ExceptT AoCError m UTCTime -> ExceptT AoCError m NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime -> ExceptT AoCError m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime)
            Int
100000
            String
"Re-submit"
            ExceptT AoCError m (Text, SubmitRes)
go
        SubmitRes
_ -> (Text, SubmitRes) -> ExceptT AoCError m (Text, SubmitRes)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text, SubmitRes)
out

displayStatus :: SubmitRes -> (ANSI.Color, Bool, String)
displayStatus :: SubmitRes -> (Color, Bool, String)
displayStatus = \case
    SubCorrect Maybe Integer
r     -> ( Color
ANSI.Green  , Bool
True , Maybe Integer -> String
forall {p} {t}.
(IsString p, PrintfArg t, PrintfType p) =>
Maybe t -> p
correctMsg Maybe Integer
r     )
    SubIncorrect Int
t Maybe String
h -> ( Color
ANSI.Red    , Bool
False, Int -> Maybe String -> String
forall {t} {t} {t}.
(PrintfArg t, PrintfArg t, PrintfType t, Integral t) =>
t -> Maybe t -> t
incorrectMsg Int
t Maybe String
h )
    SubWait Int
t        -> let (Int
m, Int
s) = Int
t Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
60
                            resp :: String
resp   = String -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"Answer re-submitted too soon.  Please wait %dmin %dsec" Int
m Int
s
                        in  ( Color
ANSI.Yellow, Bool
False, String
resp )
    SubInvalid{}     -> ( Color
ANSI.Blue   , Bool
False
                        , String
"Submission was rejected.  Maybe not unlocked yet, or already answered?"
                        )
    SubUnknown{}     -> ( Color
ANSI.Magenta, Bool
False
                        , String
"Response from server was not recognized."
                        )
  where
    correctMsg :: Maybe t -> p
correctMsg Maybe t
Nothing  = p
"Answer was correct!"
    correctMsg (Just t
r) =
        String -> t -> p
forall r. PrintfType r => String -> r
printf String
"Answer was correct, and you made the global leaderboard at rank %d !!"
          t
r
    incorrectMsg :: t -> Maybe t -> t
incorrectMsg t
t Maybe t
h =
        String -> String -> t -> t
forall r. PrintfType r => String -> r
printf String
"Answer was incorrect!%s  Please wait %d before submitting again"
          String
hintStr
          (t
t t -> t -> t
forall a. Integral a => a -> a -> a
`div` t
60)
      where
        hintStr :: String
        hintStr :: String
hintStr = case Maybe t
h of
          Maybe t
Nothing -> String
""
          Just t
s  -> String -> t -> String
forall r. PrintfType r => String -> r
printf String
"  Hint: Answer was %s." t
s

runAll
    :: Maybe String                         -- ^ session key
    -> Integer                              -- ^ year
    -> Bool                                 -- ^ run and lock answer
    -> (Day -> Part -> IO (Maybe String))   -- ^ replacements
    -> ChallengeMap
    -> (SomeSolution -> Maybe String -> ChallengeData -> IO a)  -- ^ callback. given solution, "replacement" input, and data
    -> IO (Map Day (Map Part a))
runAll :: forall a.
Maybe String
-> Integer
-> Bool
-> (Day -> Part -> IO (Maybe String))
-> ChallengeMap
-> (SomeSolution -> Maybe String -> ChallengeData -> IO a)
-> IO (Map Day (Map Part a))
runAll Maybe String
sess Integer
yr Bool
lock Day -> Part -> IO (Maybe String)
rep ChallengeMap
cm SomeSolution -> Maybe String -> ChallengeData -> IO a
f = ((Day -> Map Part SomeSolution -> IO (Map Part a))
 -> ChallengeMap -> IO (Map Day (Map Part a)))
-> ChallengeMap
-> (Day -> Map Part SomeSolution -> IO (Map Part a))
-> IO (Map Day (Map Part a))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Day -> Map Part SomeSolution -> IO (Map Part a))
-> ChallengeMap -> IO (Map Day (Map Part a))
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
M.traverseWithKey ChallengeMap
cm ((Day -> Map Part SomeSolution -> IO (Map Part a))
 -> IO (Map Day (Map Part a)))
-> (Day -> Map Part SomeSolution -> IO (Map Part a))
-> IO (Map Day (Map Part a))
forall a b. (a -> b) -> a -> b
$ \Day
d ->
                               (Part -> SomeSolution -> IO a)
-> Map Part SomeSolution -> IO (Map Part a)
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
M.traverseWithKey ((Part -> SomeSolution -> IO a)
 -> Map Part SomeSolution -> IO (Map Part a))
-> (Part -> SomeSolution -> IO a)
-> Map Part SomeSolution
-> IO (Map Part a)
forall a b. (a -> b) -> a -> b
$ \Part
p SomeSolution
c -> do
    let CP{String
_cpLog :: String
_cpTests :: String
_cpAnswer :: String
_cpInput :: String
_cpPrompt :: String
_cpLog :: ChallengePaths -> String
_cpTests :: ChallengePaths -> String
_cpAnswer :: ChallengePaths -> String
_cpInput :: ChallengePaths -> String
_cpPrompt :: ChallengePaths -> String
..} = Integer -> ChallengeSpec -> ChallengePaths
challengePaths Integer
yr (Day -> Part -> ChallengeSpec
CS Day
d Part
p)
    Maybe String
inp0 <- Day -> Part -> IO (Maybe String)
rep Day
d Part
p
    ColorIntensity -> Color -> IO () -> IO ()
withColor ColorIntensity
ANSI.Dull Color
ANSI.Blue (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      String -> Integer -> Char -> IO ()
forall r. PrintfType r => String -> r
printf String
">> Day %02d%c\n" (Day -> Integer
dayInt Day
d) (Part -> Char
partChar Part
p)
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
lock (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      CD{[(String, TestMeta)]
Maybe String
Either [String] String
Either [String] Text
_cdTests :: [(String, TestMeta)]
_cdAnswer :: Maybe String
_cdInput :: Either [String] String
_cdPrompt :: Either [String] Text
_cdTests :: ChallengeData -> [(String, TestMeta)]
_cdAnswer :: ChallengeData -> Maybe String
_cdInput :: ChallengeData -> Either [String] String
_cdPrompt :: ChallengeData -> Either [String] Text
..} <- Maybe String -> Integer -> ChallengeSpec -> IO ChallengeData
challengeData Maybe String
sess Integer
yr (Day -> Part -> ChallengeSpec
CS Day
d Part
p)
      Maybe String -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Maybe String
inp0 Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Either [String] String -> Maybe String
forall (m :: * -> *) e a. Alternative m => Either e a -> m a
eitherToMaybe Either [String] String
_cdInput) ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
inp ->
        (String -> IO ()) -> Either SolutionError String -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> String -> IO ()
writeFile String
_cpAnswer) (Either SolutionError String -> IO ())
-> IO (Either SolutionError String) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either SolutionError String -> IO (Either SolutionError String)
forall a. a -> IO a
evaluate (Either SolutionError String -> Either SolutionError String
forall a. NFData a => a -> a
force (SomeSolution -> String -> Either SolutionError String
runSomeSolution SomeSolution
c String
inp))
    SomeSolution -> Maybe String -> ChallengeData -> IO a
f SomeSolution
c Maybe String
inp0 (ChallengeData -> IO a) -> IO ChallengeData -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe String -> Integer -> ChallengeSpec -> IO ChallengeData
challengeData Maybe String
sess Integer
yr (Day -> Part -> ChallengeSpec
CS Day
d Part
p)

runTestSuite :: SomeSolution -> ChallengeData -> IO (Maybe Bool)
runTestSuite :: SomeSolution -> ChallengeData -> IO (Maybe Bool)
runTestSuite SomeSolution
c CD{[(String, TestMeta)]
Maybe String
Either [String] String
Either [String] Text
_cdTests :: [(String, TestMeta)]
_cdAnswer :: Maybe String
_cdInput :: Either [String] String
_cdPrompt :: Either [String] Text
_cdTests :: ChallengeData -> [(String, TestMeta)]
_cdAnswer :: ChallengeData -> Maybe String
_cdInput :: ChallengeData -> Either [String] String
_cdPrompt :: ChallengeData -> Either [String] Text
..} = do
    [Bool]
testRes <- ((Maybe Bool, Either SolutionError String) -> Maybe Bool)
-> [(Maybe Bool, Either SolutionError String)] -> [Bool]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Maybe Bool, Either SolutionError String) -> Maybe Bool
forall a b. (a, b) -> a
fst ([(Maybe Bool, Either SolutionError String)] -> [Bool])
-> IO [(Maybe Bool, Either SolutionError String)] -> IO [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((String, TestMeta)
 -> IO (Maybe Bool, Either SolutionError String))
-> [(String, TestMeta)]
-> IO [(Maybe Bool, Either SolutionError String)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((String
 -> TestMeta -> IO (Maybe Bool, Either SolutionError String))
-> (String, TestMeta)
-> IO (Maybe Bool, Either SolutionError String)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Bool
-> SomeSolution
-> String
-> TestMeta
-> IO (Maybe Bool, Either SolutionError String)
testCase Bool
True SomeSolution
c)) [(String, TestMeta)]
_cdTests
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Bool] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Bool]
testRes) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      let (Char
mark, Color
color)
              | [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
testRes = (Char
'✓', Color
ANSI.Green)
              | Bool
otherwise   = (Char
'✗', Color
ANSI.Red  )
      ColorIntensity -> Color -> IO () -> IO ()
withColor ColorIntensity
ANSI.Vivid Color
color (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> Char -> Int -> Int -> IO ()
forall r. PrintfType r => String -> r
printf String
"[%c] Passed %d out of %d test(s)\n"
            Char
mark
            ([Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Bool -> Bool) -> [Bool] -> [Bool]
forall a. (a -> Bool) -> [a] -> [a]
filter Bool -> Bool
forall a. a -> a
id [Bool]
testRes))
            ([Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
testRes)
    pure $ [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
testRes Bool -> Maybe () -> Maybe Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not ([Bool] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Bool]
testRes))


-- | Run a single test case
testCase
    :: Bool             -- ^ is just an example
    -> SomeSolution
    -> String
    -> TestMeta
    -> IO (Maybe Bool, Either SolutionError String)
testCase :: Bool
-> SomeSolution
-> String
-> TestMeta
-> IO (Maybe Bool, Either SolutionError String)
testCase Bool
emph SomeSolution
c String
inp TM{Maybe String
Map String Dynamic
_tmData :: TestMeta -> Map String Dynamic
_tmAnswer :: TestMeta -> Maybe String
_tmData :: Map String Dynamic
_tmAnswer :: Maybe String
..} = do
    ColorIntensity -> Color -> IO () -> IO ()
withColor ColorIntensity
ANSI.Dull Color
color (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      String -> Char -> IO ()
forall r. PrintfType r => String -> r
printf String
"[%c]" Char
mark
    if Bool
emph
      then String -> String -> IO ()
forall r. PrintfType r => String -> r
printf String
" (%s)\n" String
resStr
      else String -> String -> IO ()
forall r. PrintfType r => String -> r
printf String
" %s\n"   String
resStr
    Maybe String -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe String
showAns ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
a ->
      ColorIntensity -> Color -> IO () -> IO ()
withColor ColorIntensity
ANSI.Vivid Color
ANSI.Red (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> String -> IO ()
forall r. PrintfType r => String -> r
printf String
"(Expected: %s)\n" String
a
    return (Maybe Bool
status, Either SolutionError String
res)
  where
    res :: Either SolutionError String
res = Map String Dynamic
-> SomeSolution -> String -> Either SolutionError String
runSomeSolutionWith Map String Dynamic
_tmData SomeSolution
c String
inp
    resStr :: String
resStr = case Either SolutionError String
res of
      Right String
r -> String
r
      Left SolutionError
SEParse -> String
"ERROR: No parse"
      Left SolutionError
SESolve -> String
"ERROR: No solution"
    (Char
mark, Maybe String
showAns, Maybe Bool
status) = case Maybe String
_tmAnswer of
      Just String
ex    -> case Either SolutionError String
res of
        Right (ShowS
strip->String
r)
          | String
r String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
ex   -> (Char
'✓', Maybe String
forall a. Maybe a
Nothing, Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True )
          | Bool
otherwise -> (Char
'✗', String -> Maybe String
forall a. a -> Maybe a
Just String
ex, Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False)
        Left SolutionError
_        -> (Char
'✗', String -> Maybe String
forall a. a -> Maybe a
Just String
ex, Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False)
      Maybe String
Nothing         -> (Char
'?', Maybe String
forall a. Maybe a
Nothing, Maybe Bool
forall a. Maybe a
Nothing   )
    color :: Color
color = case Maybe Bool
status of
      Just Bool
True  -> Color
ANSI.Green
      Just Bool
False -> Color
ANSI.Red
      Maybe Bool
Nothing    -> Color
ANSI.Blue

-- | Do the action with a given ANSI foreground color and intensity.
withColor
    :: ANSI.ColorIntensity
    -> ANSI.Color
    -> IO ()
    -> IO ()
withColor :: ColorIntensity -> Color -> IO () -> IO ()
withColor ColorIntensity
ci Color
c IO ()
act = do
    [SGR] -> IO ()
ANSI.setSGR [ ConsoleLayer -> ColorIntensity -> Color -> SGR
ANSI.SetColor ConsoleLayer
ANSI.Foreground ColorIntensity
ci Color
c ]
    IO ()
act
    [SGR] -> IO ()
ANSI.setSGR [ SGR
ANSI.Reset ]

pullMap
    :: Map a (Map b c)
    -> Map (a, b) c
pullMap :: forall a b c. Map a (Map b c) -> Map (a, b) c
pullMap = [((a, b), c)] -> Map (a, b) c
forall k a. [(k, a)] -> Map k a
M.fromDistinctAscList
        ([((a, b), c)] -> Map (a, b) c)
-> (Map a (Map b c) -> [((a, b), c)])
-> Map a (Map b c)
-> Map (a, b) c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Map b c) -> [((a, b), c)]) -> [(a, Map b c)] -> [((a, b), c)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((a -> [(b, c)] -> [((a, b), c)]) -> (a, [(b, c)]) -> [((a, b), c)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> [(b, c)] -> [((a, b), c)]
forall {p :: * -> * -> *} {t} {a} {c}.
Bifunctor p =>
t -> [p a c] -> [p (t, a) c]
go ((a, [(b, c)]) -> [((a, b), c)])
-> ((a, Map b c) -> (a, [(b, c)])) -> (a, Map b c) -> [((a, b), c)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map b c -> [(b, c)]) -> (a, Map b c) -> (a, [(b, c)])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Map b c -> [(b, c)]
forall k a. Map k a -> [(k, a)]
M.toAscList)
        ([(a, Map b c)] -> [((a, b), c)])
-> (Map a (Map b c) -> [(a, Map b c)])
-> Map a (Map b c)
-> [((a, b), c)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a (Map b c) -> [(a, Map b c)]
forall k a. Map k a -> [(k, a)]
M.toAscList
  where
    go :: t -> [p a c] -> [p (t, a) c]
go t
x = ((p a c -> p (t, a) c) -> [p a c] -> [p (t, a) c]
forall a b. (a -> b) -> [a] -> [b]
map ((p a c -> p (t, a) c) -> [p a c] -> [p (t, a) c])
-> ((a -> (t, a)) -> p a c -> p (t, a) c)
-> (a -> (t, a))
-> [p a c]
-> [p (t, a) c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (t, a)) -> p a c -> p (t, a) c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first) (t
x,)

pushMap
    :: Eq a
    => Map (a, b) c
    -> Map a (Map b c)
pushMap :: forall a b c. Eq a => Map (a, b) c -> Map a (Map b c)
pushMap = ([(b, c)] -> Map b c) -> Map a [(b, c)] -> Map a (Map b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(b, c)] -> Map b c
forall k a. [(k, a)] -> Map k a
M.fromDistinctAscList
        (Map a [(b, c)] -> Map a (Map b c))
-> (Map (a, b) c -> Map a [(b, c)])
-> Map (a, b) c
-> Map a (Map b c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(b, c)] -> [(b, c)] -> [(b, c)])
-> [(a, [(b, c)])] -> Map a [(b, c)]
forall k a. Eq k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromAscListWith (([(b, c)] -> [(b, c)] -> [(b, c)])
-> [(b, c)] -> [(b, c)] -> [(b, c)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [(b, c)] -> [(b, c)] -> [(b, c)]
forall a. [a] -> [a] -> [a]
(++))
        ([(a, [(b, c)])] -> Map a [(b, c)])
-> (Map (a, b) c -> [(a, [(b, c)])])
-> Map (a, b) c
-> Map a [(b, c)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((a, b), c) -> (a, [(b, c)])) -> [((a, b), c)] -> [(a, [(b, c)])]
forall a b. (a -> b) -> [a] -> [b]
map (((a, b) -> c -> (a, [(b, c)])) -> ((a, b), c) -> (a, [(b, c)])
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (a, b) -> c -> (a, [(b, c)])
forall {a} {a} {b}. (a, a) -> b -> (a, [(a, b)])
go)
        ([((a, b), c)] -> [(a, [(b, c)])])
-> (Map (a, b) c -> [((a, b), c)])
-> Map (a, b) c
-> [(a, [(b, c)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (a, b) c -> [((a, b), c)]
forall k a. Map k a -> [(k, a)]
M.toAscList
  where
    go :: (a, a) -> b -> (a, [(a, b)])
go (a
x, a
y) b
z = (a
x, [(a
y, b
z)])