{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications  #-}

-- |
-- Module      : AOC.Run.Load
-- Copyright   : (c) Justin Le 2018
-- License     : BSD3
--
-- Maintainer  : justin@jle.im
-- Stability   : experimental
-- Portability : non-portable
--
-- Loading challenge data and prompts.
--

module AOC.Run.Load (
    ChallengePaths(..), challengePaths
  , ChallengeData(..), challengeData
  , Day(..)
  , countdownConsole
  , countdownWithPrint
  , timeToRelease
  , showNominalDiffTime
  , charPart
  , showAoCError
  , htmlToMarkdown
  , mkDay, mkDay_, dayInt
  , TestMeta(..)
  -- * Parsers
  , parseMeta
  , parseTests
  ) where

import           AOC.Challenge
import           AOC.Util
import           Advent
import           Control.Applicative
import           Control.Concurrent
import           Control.DeepSeq
import           Control.Exception
import           Control.Monad
import           Control.Monad.Except
import           Data.Bifunctor
import           Data.Char
import           Data.Dynamic
import           Data.Foldable
import           Data.Map                  (Map)
import           Data.Maybe
import           Data.Text                 (Text)
import           Data.Time hiding          (Day)
import           Data.Void
import           System.Console.ANSI       as ANSI
import           System.Directory
import           System.FilePath
import           System.IO
import           System.IO.Error
import           Text.Printf
import           Text.Read                 (readMaybe)
import qualified Control.Monad.Combinators as MP
import qualified Data.Map                  as M
import qualified Data.Text                 as T
import qualified Data.Text.IO              as T
import qualified Text.Megaparsec           as MP
import qualified Text.Megaparsec.Char      as MP
import qualified Text.Pandoc               as P

-- | A record of paths corresponding to a specific challenge.
data ChallengePaths = CP { ChallengePaths -> String
_cpPrompt    :: !FilePath
                         , ChallengePaths -> String
_cpInput     :: !FilePath
                         , ChallengePaths -> String
_cpAnswer    :: !FilePath
                         , ChallengePaths -> String
_cpTests     :: !FilePath
                         , ChallengePaths -> String
_cpLog       :: !FilePath
                         }
  deriving Int -> ChallengePaths -> String -> String
[ChallengePaths] -> String -> String
ChallengePaths -> String
(Int -> ChallengePaths -> String -> String)
-> (ChallengePaths -> String)
-> ([ChallengePaths] -> String -> String)
-> Show ChallengePaths
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ChallengePaths] -> String -> String
$cshowList :: [ChallengePaths] -> String -> String
show :: ChallengePaths -> String
$cshow :: ChallengePaths -> String
showsPrec :: Int -> ChallengePaths -> String -> String
$cshowsPrec :: Int -> ChallengePaths -> String -> String
Show

-- | A record of data (test inputs, answers) corresponding to a specific
-- challenge.
data ChallengeData = CD { ChallengeData -> Either [String] Text
_cdPrompt :: !(Either [String] Text  )
                        , ChallengeData -> Either [String] String
_cdInput  :: !(Either [String] String)
                        , ChallengeData -> Maybe String
_cdAnswer :: !(Maybe String)
                        , ChallengeData -> [(String, TestMeta)]
_cdTests  :: ![(String, TestMeta)]
                        }

-- | Generate a 'ChallengePaths' from a specification of a challenge.
challengePaths :: Integer -> ChallengeSpec -> ChallengePaths
challengePaths :: Integer -> ChallengeSpec -> ChallengePaths
challengePaths Integer
y (CS Day
d Part
p) = CP :: String -> String -> String -> String -> String -> ChallengePaths
CP
    { _cpPrompt :: String
_cpPrompt    = String
"prompt"          String -> String -> String
</> String -> Integer -> Char -> String
forall r. PrintfType r => String -> r
printf String
"%02d%c" Integer
d' Char
p' String -> String -> String
<.> String
"md"
    , _cpInput :: String
_cpInput     = String
"data"            String -> String -> String
</> String -> Integer -> String
forall r. PrintfType r => String -> r
printf String
"%02d" Integer
d'      String -> String -> String
<.> String
"txt"
    , _cpAnswer :: String
_cpAnswer    = String
"data/ans"        String -> String -> String
</> String -> Integer -> Char -> String
forall r. PrintfType r => String -> r
printf String
"%02d%c" Integer
d' Char
p' String -> String -> String
<.> String
"txt"
    , _cpTests :: String
_cpTests     = String
"test-data"       String -> String -> String
</> String -> Integer -> Integer -> Char -> String
forall r. PrintfType r => String -> r
printf String
"%04d/%02d%c" Integer
y Integer
d' Char
p' String -> String -> String
<.> String
"txt"
    , _cpLog :: String
_cpLog       = String
"logs/submission" String -> String -> String
</> String -> Integer -> Char -> String
forall r. PrintfType r => String -> r
printf String
"%02d%c" Integer
d' Char
p' String -> String -> String
<.> String
"txt"
    }
  where
    d' :: Integer
d' = Day -> Integer
dayInt Day
d
    p' :: Char
p' = Part -> Char
partChar Part
p

makeChallengeDirs :: ChallengePaths -> IO ()
makeChallengeDirs :: ChallengePaths -> IO ()
makeChallengeDirs 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
..} =
    (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
takeDirectory)
          [String
_cpPrompt, String
_cpInput, String
_cpAnswer, String
_cpTests, String
_cpLog]

-- | Load data associated with a challenge from a given specification.
-- Will fetch answers online and cache if required (and if giten a session
-- token).
challengeData
    :: Maybe String   -- ^ session key
    -> Integer        -- ^ year
    -> ChallengeSpec
    -> IO ChallengeData
challengeData :: Maybe String -> Integer -> ChallengeSpec -> IO ChallengeData
challengeData Maybe String
sess Integer
yr ChallengeSpec
spec = do
    ChallengePaths -> IO ()
makeChallengeDirs ChallengePaths
ps
    Either [String] String
inp   <- ExceptT [String] IO String -> IO (Either [String] String)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT [String] IO String -> IO (Either [String] String))
-> ([ExceptT [String] IO String] -> ExceptT [String] IO String)
-> [ExceptT [String] IO String]
-> IO (Either [String] String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ExceptT [String] IO String] -> ExceptT [String] IO String
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([ExceptT [String] IO String] -> IO (Either [String] String))
-> [ExceptT [String] IO String] -> IO (Either [String] String)
forall a b. (a -> b) -> a -> b
$
      [ [String] -> Maybe String -> ExceptT [String] IO String
forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
maybeToEither [String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Input file not found at %s" String
_cpInput]
          (Maybe String -> ExceptT [String] IO String)
-> ExceptT [String] IO (Maybe String) -> ExceptT [String] IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Maybe String) -> ExceptT [String] IO (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO (Maybe String)
readFileMaybe String
_cpInput)
      , ExceptT [String] IO String
fetchInput
      ]
    Either [String] Text
prompt <- ExceptT [String] IO Text -> IO (Either [String] Text)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT [String] IO Text -> IO (Either [String] Text))
-> ([ExceptT [String] IO Text] -> ExceptT [String] IO Text)
-> [ExceptT [String] IO Text]
-> IO (Either [String] Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ExceptT [String] IO Text] -> ExceptT [String] IO Text
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([ExceptT [String] IO Text] -> IO (Either [String] Text))
-> [ExceptT [String] IO Text] -> IO (Either [String] Text)
forall a b. (a -> b) -> a -> b
$
      [ [String] -> Maybe Text -> ExceptT [String] IO Text
forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
maybeToEither [String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Prompt file not found at %s" String
_cpPrompt]
          (Maybe Text -> ExceptT [String] IO Text)
-> ExceptT [String] IO (Maybe Text) -> ExceptT [String] IO Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Maybe Text) -> ExceptT [String] IO (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (Maybe String -> Maybe Text)
-> IO (Maybe String) -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
readFileMaybe String
_cpPrompt)
      , ExceptT [String] IO Text
fetchPrompt
      ]
    Maybe String
ans    <- String -> IO (Maybe String)
readFileMaybe String
_cpAnswer
    [(String, TestMeta)]
ts     <- String -> IO (Maybe String)
readFileMaybe String
_cpTests IO (Maybe String)
-> (Maybe String -> IO [(String, TestMeta)])
-> IO [(String, TestMeta)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Maybe String
Nothing  -> [(String, TestMeta)] -> IO [(String, TestMeta)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
                Just String
str -> case Parsec Void String [(String, TestMeta)]
-> String
-> String
-> Either (ParseErrorBundle String Void) [(String, TestMeta)]
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
MP.parse Parsec Void String [(String, TestMeta)]
parseTests String
_cpTests String
str of
                  Left ParseErrorBundle String Void
e  -> [] [(String, TestMeta)] -> IO () -> IO [(String, TestMeta)]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> IO ()
putStrLn (ParseErrorBundle String Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
MP.errorBundlePretty ParseErrorBundle String Void
e)
                  Right [(String, TestMeta)]
r -> [(String, TestMeta)] -> IO [(String, TestMeta)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(String, TestMeta)]
r
    return CD :: Either [String] Text
-> Either [String] String
-> Maybe String
-> [(String, TestMeta)]
-> ChallengeData
CD
      { _cdPrompt :: Either [String] Text
_cdPrompt = Either [String] Text
prompt
      , _cdInput :: Either [String] String
_cdInput  = Either [String] String
inp
      , _cdAnswer :: Maybe String
_cdAnswer = Maybe String
ans
      , _cdTests :: [(String, TestMeta)]
_cdTests  = [(String, TestMeta)]
ts
      }
  where
    ps :: ChallengePaths
ps@CP{String
_cpLog :: String
_cpTests :: String
_cpAnswer :: String
_cpPrompt :: String
_cpInput :: String
_cpLog :: ChallengePaths -> String
_cpTests :: ChallengePaths -> String
_cpAnswer :: ChallengePaths -> String
_cpInput :: ChallengePaths -> String
_cpPrompt :: ChallengePaths -> String
..} = Integer -> ChallengeSpec -> ChallengePaths
challengePaths Integer
yr ChallengeSpec
spec
    readFileMaybe :: FilePath -> IO (Maybe String)
    readFileMaybe :: String -> IO (Maybe String)
readFileMaybe =
        ((String -> IO String) -> Maybe String -> IO (Maybe String)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (String -> IO String
forall a. a -> IO a
evaluate (String -> IO String) -> (String -> String) -> String -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. NFData a => a -> a
force) (Maybe String -> IO (Maybe String))
-> (Either () String -> Maybe String)
-> Either () String
-> IO (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either () String -> Maybe String
forall (m :: * -> *) e a. Alternative m => Either e a -> m a
eitherToMaybe (Either () String -> IO (Maybe String))
-> IO (Either () String) -> IO (Maybe String)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)
       (IO (Either () String) -> IO (Maybe String))
-> (String -> IO (Either () String)) -> String -> IO (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IOError -> Maybe ()) -> IO String -> IO (Either () String)
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> IO (Either b a)
tryJust (Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> (IOError -> Bool) -> IOError -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> Bool
isDoesNotExistError)
       (IO String -> IO (Either () String))
-> (String -> IO String) -> String -> IO (Either () String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO String
readFile
    fetchInput :: ExceptT [String] IO String
    fetchInput :: ExceptT [String] IO String
fetchInput = do
        String
s <- [String] -> Maybe String -> ExceptT [String] IO String
forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
maybeToEither [String
"Session key needed to fetch input"]
              Maybe String
sess
        let opts :: AoCOpts
opts = Integer -> String -> AoCOpts
defaultAoCOpts Integer
yr String
s
        String
inp <- Either [String] String -> ExceptT [String] IO String
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either [String] String -> ExceptT [String] IO String)
-> (Either AoCError Text -> Either [String] String)
-> Either AoCError Text
-> ExceptT [String] IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AoCError -> [String])
-> (Text -> String)
-> Either AoCError Text
-> Either [String] String
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap AoCError -> [String]
showAoCError Text -> String
T.unpack
           (Either AoCError Text -> ExceptT [String] IO String)
-> ExceptT [String] IO (Either AoCError Text)
-> ExceptT [String] IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Either AoCError Text)
-> ExceptT [String] IO (Either AoCError Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (AoCOpts -> AoC Text -> IO (Either AoCError Text)
forall a. AoCOpts -> AoC a -> IO (Either AoCError a)
runAoC AoCOpts
opts AoC Text
a)
        IO () -> ExceptT [String] IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT [String] IO ())
-> IO () -> ExceptT [String] IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
writeFile String
_cpInput String
inp
        pure String
inp
      where
        a :: AoC Text
a = Day -> AoC Text
AoCInput (Day -> AoC Text) -> Day -> AoC Text
forall a b. (a -> b) -> a -> b
$ ChallengeSpec -> Day
_csDay ChallengeSpec
spec
    fetchPrompt :: ExceptT [String] IO Text
    fetchPrompt :: ExceptT [String] IO Text
fetchPrompt = do
        Map Part Text
prompts <- Either [String] (Map Part Text)
-> ExceptT [String] IO (Map Part Text)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either [String] (Map Part Text)
 -> ExceptT [String] IO (Map Part Text))
-> (Either AoCError (Map Part Text)
    -> Either [String] (Map Part Text))
-> Either AoCError (Map Part Text)
-> ExceptT [String] IO (Map Part Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AoCError -> [String])
-> Either AoCError (Map Part Text)
-> Either [String] (Map Part Text)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first AoCError -> [String]
showAoCError
               (Either AoCError (Map Part Text)
 -> ExceptT [String] IO (Map Part Text))
-> ExceptT [String] IO (Either AoCError (Map Part Text))
-> ExceptT [String] IO (Map Part Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Either AoCError (Map Part Text))
-> ExceptT [String] IO (Either AoCError (Map Part Text))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (AoCOpts
-> AoC (Map Part Text) -> IO (Either AoCError (Map Part Text))
forall a. AoCOpts -> AoC a -> IO (Either AoCError a)
runAoC AoCOpts
opts AoC (Map Part Text)
a)
        Text
promptH  <- [String] -> Maybe Text -> ExceptT [String] IO Text
forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
maybeToEither [String
e]
                 (Maybe Text -> ExceptT [String] IO Text)
-> (Map Part Text -> Maybe Text)
-> Map Part Text
-> ExceptT [String] IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Part -> Map Part Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (ChallengeSpec -> Part
_csPart ChallengeSpec
spec)
                 (Map Part Text -> ExceptT [String] IO Text)
-> Map Part Text -> ExceptT [String] IO Text
forall a b. (a -> b) -> a -> b
$ Map Part Text
prompts
        Text
prompt   <- Either [String] Text -> ExceptT [String] IO Text
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either [String] Text -> ExceptT [String] IO Text)
-> Either [String] Text -> ExceptT [String] IO Text
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> Either [String] Text
htmlToMarkdown Bool
True Text
promptH
        IO () -> ExceptT [String] IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT [String] IO ())
-> IO () -> ExceptT [String] IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
_cpPrompt Text
prompt
        pure Text
prompt
      where
        opts :: AoCOpts
opts = Integer -> String -> AoCOpts
defaultAoCOpts Integer
yr (String -> AoCOpts) -> String -> AoCOpts
forall a b. (a -> b) -> a -> b
$ Maybe String -> String
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Maybe String
sess
        a :: AoC (Map Part Text)
a = Day -> AoC (Map Part Text)
AoCPrompt (Day -> AoC (Map Part Text)) -> Day -> AoC (Map Part Text)
forall a b. (a -> b) -> a -> b
$ ChallengeSpec -> Day
_csDay ChallengeSpec
spec
        e :: String
e = case Maybe String
sess of
          Just String
_  -> String
"Part not yet released"
          Maybe String
Nothing -> String
"Part not yet released, or may require session key"
      -- where
      --   go (inp:meta:xs) =

        -- go [] = []
    -- parseTests xs = case break (">>>" `isPrefixOf`) xs of
    --   (inp,[])
    --     | null (strip (unlines inp))  -> []
    --     | otherwise -> [(unlines inp, Nothing)]
    --   (inp,(strip.drop 4->ans):rest)
    --     | null (strip (unlines inp))  -> parseTests rest
    --     | otherwise ->
    --         let ans' = ans <$ guard (not (null ans))
    --         in  (unlines inp, ans') : parseTests rest


showAoCError :: AoCError -> [String]
showAoCError :: AoCError -> [String]
showAoCError = \case
    AoCClientError ClientError
e -> [ String
"Error contacting Advent of Code server to fetch input"
                        , String
"Possible invalid session key"
                        , String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Server response: %s" (ClientError -> String
forall a. Show a => a -> String
show ClientError
e)
                        ]
    AoCReleaseError NominalDiffTime
t -> [ String
"Challenge not yet released!"
                         , String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Please wait %s" (NominalDiffTime -> String
showNominalDiffTime NominalDiffTime
t)
                         ]
    AoCError
AoCThrottleError  -> [ String
"Too many requests at a time.  Please slow down." ]

-- | Pretty-print a 'NominalDiffTime'
showNominalDiffTime :: NominalDiffTime -> String
showNominalDiffTime :: NominalDiffTime -> String
showNominalDiffTime (forall a b. (RealFrac a, Integral b) => a -> b
round @Double @Int (Double -> Int)
-> (NominalDiffTime -> Double) -> NominalDiffTime -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac -> Int
rawSecs) =
    String -> Int -> Int -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%02dd %02d:%02d:%02d" Int
days Int
hours Int
mins Int
secs
  where
    (Int
rawMins , Int
secs ) = Int
rawSecs  Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
60
    (Int
rawHours, Int
mins ) = Int
rawMins  Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
60
    (Int
days    , Int
hours) = Int
rawHours Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
24

-- | Run a countdown on the console.
countdownConsole
    :: MonadIO m
    => Integer          -- ^ year of challenge
    -> Day              -- ^ day to count down to
    -> m a              -- ^ callback on release
    -> m a
countdownConsole :: forall (m :: * -> *) a. MonadIO m => Integer -> Day -> m a -> m a
countdownConsole Integer
yr Day
d = m NominalDiffTime -> Int -> String -> m a -> m a
forall (m :: * -> *) a.
MonadIO m =>
m NominalDiffTime -> Int -> String -> m a -> m a
countdownWithPrint
    (IO NominalDiffTime -> m NominalDiffTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NominalDiffTime -> m NominalDiffTime)
-> IO NominalDiffTime -> m NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> IO NominalDiffTime
timeToRelease Integer
yr Day
d)
    Int
250000
    (String -> Integer -> String
forall r. PrintfType r => String -> r
printf String
"Day %d release" (Day -> Integer
dayInt Day
d))

countdownWithPrint
    :: MonadIO m
    => m NominalDiffTime
    -> Int
    -> String
    -> m a
    -> m a
countdownWithPrint :: forall (m :: * -> *) a.
MonadIO m =>
m NominalDiffTime -> Int -> String -> m a -> m a
countdownWithPrint m NominalDiffTime
getNDT Int
delay String
cbstr = m NominalDiffTime -> Int -> (NominalDiffTime -> m ()) -> m a -> m a
forall (m :: * -> *) a.
MonadIO m =>
m NominalDiffTime -> Int -> (NominalDiffTime -> m ()) -> m a -> m a
countdownWith m NominalDiffTime
getNDT Int
delay ((NominalDiffTime -> m ()) -> m a -> m a)
-> (NominalDiffTime -> m ()) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ \NominalDiffTime
ttr -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    IO ()
ANSI.clearFromCursorToScreenEnd
    String -> String -> String -> IO ()
forall r. PrintfType r => String -> r
printf String
"> %s in: %s" String
cbstr (NominalDiffTime -> String
showNominalDiffTime NominalDiffTime
ttr)
    Int -> IO ()
ANSI.setCursorColumn Int
0
    Handle -> IO ()
hFlush Handle
stdout

-- | Run a countdown with a given callback on each tick.
countdownWith
    :: MonadIO m
    => m NominalDiffTime            -- ^ get time
    -> Int                          -- ^ interval (milliseconds)
    -> (NominalDiffTime -> m ())    -- ^ callback on each tick
    -> m a                          -- ^ callback on finish
    -> m a
countdownWith :: forall (m :: * -> *) a.
MonadIO m =>
m NominalDiffTime -> Int -> (NominalDiffTime -> m ()) -> m a -> m a
countdownWith m NominalDiffTime
getNDT Int
delay NominalDiffTime -> m ()
callback m a
release = m a
go
  where
    go :: m a
go = do
      NominalDiffTime
ttr <- m NominalDiffTime
getNDT
      if NominalDiffTime
ttr NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<= NominalDiffTime
0
        then m a
release
        else do
          NominalDiffTime -> m ()
callback NominalDiffTime
ttr
          IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
delay
          m a
go


htmlToMarkdown :: Bool -> Text -> Either [String] T.Text
htmlToMarkdown :: Bool -> Text -> Either [String] Text
htmlToMarkdown Bool
pretty Text
html = (PandocError -> [String])
-> Either PandocError Text -> Either [String] Text
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])
-> (PandocError -> String) -> PandocError -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocError -> String
forall a. Show a => a -> String
show) (Either PandocError Text -> Either [String] Text)
-> (PandocPure Text -> Either PandocError Text)
-> PandocPure Text
-> Either [String] Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocPure Text -> Either PandocError Text
forall a. PandocPure a -> Either PandocError a
P.runPure (PandocPure Text -> Either [String] Text)
-> PandocPure Text -> Either [String] Text
forall a b. (a -> b) -> a -> b
$ do
    Pandoc
p <- ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
P.readHtml (ReaderOptions
forall a. Default a => a
P.def { readerExtensions :: Extensions
P.readerExtensions = Extensions
exts })
            Text
html
    WriterOptions -> Pandoc -> PandocPure Text
writer (WriterOptions
forall a. Default a => a
P.def { writerExtensions :: Extensions
P.writerExtensions = Extensions
exts }) Pandoc
p
  where
    writer :: WriterOptions -> Pandoc -> PandocPure Text
writer
      | Bool
pretty    = WriterOptions -> Pandoc -> PandocPure Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
P.writeMarkdown
      | Bool
otherwise = WriterOptions -> Pandoc -> PandocPure Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
P.writePlain
    exts :: Extensions
exts = Extension -> Extensions -> Extensions
P.disableExtension Extension
P.Ext_header_attributes
         (Extensions -> Extensions)
-> (Extensions -> Extensions) -> Extensions -> Extensions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> Extensions -> Extensions
P.disableExtension Extension
P.Ext_smart
         (Extensions -> Extensions) -> Extensions -> Extensions
forall a b. (a -> b) -> a -> b
$ Extensions
P.pandocExtensions






type Parser = MP.Parsec Void String






data TestMeta = TM { TestMeta -> Maybe String
_tmAnswer :: Maybe String
                   , TestMeta -> Map String Dynamic
_tmData   :: Map String Dynamic
                   }
  deriving Int -> TestMeta -> String -> String
[TestMeta] -> String -> String
TestMeta -> String
(Int -> TestMeta -> String -> String)
-> (TestMeta -> String)
-> ([TestMeta] -> String -> String)
-> Show TestMeta
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [TestMeta] -> String -> String
$cshowList :: [TestMeta] -> String -> String
show :: TestMeta -> String
$cshow :: TestMeta -> String
showsPrec :: Int -> TestMeta -> String -> String
$cshowsPrec :: Int -> TestMeta -> String -> String
Show

data MetaLine = MLData   String Dynamic
              | MLAnswer String
  deriving Int -> MetaLine -> String -> String
[MetaLine] -> String -> String
MetaLine -> String
(Int -> MetaLine -> String -> String)
-> (MetaLine -> String)
-> ([MetaLine] -> String -> String)
-> Show MetaLine
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [MetaLine] -> String -> String
$cshowList :: [MetaLine] -> String -> String
show :: MetaLine -> String
$cshow :: MetaLine -> String
showsPrec :: Int -> MetaLine -> String -> String
$cshowsPrec :: Int -> MetaLine -> String -> String
Show


parseTests :: Parser [(String, TestMeta)]
parseTests :: Parsec Void String [(String, TestMeta)]
parseTests = ParsecT Void String Identity (String, TestMeta)
-> Parsec Void String [(String, TestMeta)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.many ParsecT Void String Identity (String, TestMeta)
parseTest Parsec Void String [(String, TestMeta)]
-> ParsecT Void String Identity ()
-> Parsec Void String [(String, TestMeta)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void String Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
MP.eof
  where
    parseTest :: ParsecT Void String Identity (String, TestMeta)
parseTest = do
      String
inp <- ParsecT Void String Identity Char
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
MP.manyTill ParsecT Void String Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
MP.anySingle (ParsecT Void String Identity String
 -> ParsecT Void String Identity String)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.lookAhead (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.string Tokens String
">>>")
      Maybe TestMeta
met <- ParsecT Void String Identity TestMeta
-> ParsecT Void String Identity (Maybe TestMeta)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void String Identity TestMeta
-> ParsecT Void String Identity TestMeta
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try ParsecT Void String Identity TestMeta
parseMeta) ParsecT Void String Identity (Maybe TestMeta)
-> String -> ParsecT Void String Identity (Maybe TestMeta)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
MP.<?> String
"Metadata Block"
      pure (String
inp, TestMeta -> Maybe TestMeta -> TestMeta
forall a. a -> Maybe a -> a
fromMaybe (Maybe String -> Map String Dynamic -> TestMeta
TM Maybe String
forall a. Maybe a
Nothing Map String Dynamic
forall k a. Map k a
M.empty) Maybe TestMeta
met)

parseMeta :: Parser TestMeta
parseMeta :: ParsecT Void String Identity TestMeta
parseMeta = do
    [(String, Dynamic)]
dats <- ParsecT Void String Identity (String, Dynamic)
-> ParsecT Void String Identity [(String, Dynamic)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.many (ParsecT Void String Identity (String, Dynamic)
-> ParsecT Void String Identity (String, Dynamic)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try ParsecT Void String Identity (String, Dynamic)
parseData) ParsecT Void String Identity [(String, Dynamic)]
-> String -> ParsecT Void String Identity [(String, Dynamic)]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
MP.<?> String
"Data Block"
    Maybe String
ans  <- ParsecT Void String Identity String
-> ParsecT Void String Identity (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try ParsecT Void String Identity String
parseAnswer) ParsecT Void String Identity (Maybe String)
-> String -> ParsecT Void String Identity (Maybe String)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
MP.<?> String
"Expected Answer"
    pure $ Maybe String -> Map String Dynamic -> TestMeta
TM Maybe String
ans ([(String, Dynamic)] -> Map String Dynamic
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(String, Dynamic)]
dats)
  where
    parseAnswer :: ParsecT Void String Identity String
parseAnswer = Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.string Tokens String
">>>"
               ParsecT Void String Identity (Tokens String)
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MP.space1
               ParsecT Void String Identity ()
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.many ([Token String] -> ParsecT Void String Identity (Token String)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
MP.noneOf [Char
'\n'])
               ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void String Identity String
"\n"
    parseData :: ParsecT Void String Identity (String, Dynamic)
parseData = do
      Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.string Tokens String
">>>"
      String
sym <- ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
MP.manyTill (ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try ParsecT Void String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
MP.letterChar)   (ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MP.char Char
Token String
':'))
      String
val <- ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
MP.manyTill (ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try ParsecT Void String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
MP.alphaNumChar) (ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try (Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MP.char Char
Token String
':'))
      String
typ <- ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.many     (ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try ParsecT Void String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
MP.letterChar)
      ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MP.space
      case Char -> Char
toLower (Char -> Char) -> String -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
typ of
        String
"int"    -> ParsecT Void String Identity (String, Dynamic)
-> (Int -> ParsecT Void String Identity (String, Dynamic))
-> Maybe Int
-> ParsecT Void String Identity (String, Dynamic)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ParsecT Void String Identity (String, Dynamic)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Could not parse metadata value") ((String, Dynamic) -> ParsecT Void String Identity (String, Dynamic)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((String, Dynamic)
 -> ParsecT Void String Identity (String, Dynamic))
-> (Int -> (String, Dynamic))
-> Int
-> ParsecT Void String Identity (String, Dynamic)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
sym,) (Dynamic -> (String, Dynamic))
-> (Int -> Dynamic) -> Int -> (String, Dynamic)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn)
                  (Maybe Int -> ParsecT Void String Identity (String, Dynamic))
-> (String -> Maybe Int)
-> String
-> ParsecT Void String Identity (String, Dynamic)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Maybe a
readMaybe @Int
                  (String -> ParsecT Void String Identity (String, Dynamic))
-> String -> ParsecT Void String Identity (String, Dynamic)
forall a b. (a -> b) -> a -> b
$ String
val
        String
"string" -> (String, Dynamic) -> ParsecT Void String Identity (String, Dynamic)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
sym, String -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn String
val)
        String
"text"   -> (String, Dynamic) -> ParsecT Void String Identity (String, Dynamic)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
sym, Text -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn (String -> Text
T.pack String
val))
        String
_        -> String -> ParsecT Void String Identity (String, Dynamic)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ParsecT Void String Identity (String, Dynamic))
-> String -> ParsecT Void String Identity (String, Dynamic)
forall a b. (a -> b) -> a -> b
$ String
"Unrecognized type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
typ