Skip to content

Commit 9fce98a

Browse files
IndecisionTreeIndecisionTree
authored
Initial commit
0 parents  commit 9fce98a

36 files changed

+918
-0
lines changed

‎.env.example

+2
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
SESSION=YOUR_SESSION_COOKIE
2+
YEAR=2022

‎.gitignore

+4
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
dist*
2+
.env
3+
.inputs/
4+
data/

‎LICENSE

+29
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,29 @@
1+
BSD 3-Clause License
2+
3+
Copyright (c) 2022, IndecisionTree
4+
All rights reserved.
5+
6+
Redistribution and use in source and binary forms, with or without
7+
modification, are permitted provided that the following conditions are met:
8+
9+
1. Redistributions of source code must retain the above copyright notice, this
10+
list of conditions and the following disclaimer.
11+
12+
2. Redistributions in binary form must reproduce the above copyright notice,
13+
this list of conditions and the following disclaimer in the documentation
14+
and/or other materials provided with the distribution.
15+
16+
3. Neither the name of the copyright holder nor the names of its
17+
contributors may be used to endorse or promote products derived from
18+
this software without specific prior written permission.
19+
20+
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
21+
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22+
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
23+
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
24+
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
25+
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
26+
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
27+
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
28+
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
29+
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

‎advent-of-haskell.cabal

+95
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,95 @@
1+
cabal-version: 3.0
2+
name: advent-of-haskell
3+
version: 0.1.0.0
4+
synopsis: Framework for AoC
5+
description: Run, submit, test, and benchmark Advent of Code solutions.
6+
license: BSD-3-Clause
7+
license-file: LICENSE
8+
author: IndecisionTree
9+
build-type: Simple
10+
11+
common common
12+
default-language: GHC2021
13+
ghc-options: -Wall
14+
default-extensions: RecordWildCards
15+
16+
executable runner
17+
import: common
18+
main-is: Main.hs
19+
build-depends:
20+
, aoc
21+
, base ^>=4.16.3.0
22+
, containers ^>=0.6.5
23+
, directory ^>=1.3.6
24+
, dotenv ^>=0.9.0
25+
, filepath ^>=1.4.2
26+
, megaparsec ^>=9.3.0
27+
, optparse-applicative ^>=0.17.0
28+
, solutions
29+
, tasty ^>=1.4.2
30+
, tasty-bench ^>=0.3.2
31+
, tasty-hunit ^>=0.10.0
32+
, text ^>=2.0
33+
34+
other-modules: Tests
35+
hs-source-dirs: runner
36+
37+
library aoc
38+
import: common
39+
exposed-modules: AOC
40+
other-modules:
41+
AOC.API
42+
AOC.Types
43+
44+
build-depends:
45+
, base ^>=4.16.3.0
46+
, bytestring ^>=0.11.3
47+
, http-api-data ^>=0.5
48+
, http-client ^>=0.7.13
49+
, http-client-tls ^>=0.3.6
50+
, http-media ^>=0.8.0
51+
, servant ^>=0.19.1
52+
, servant-client ^>=0.19
53+
, text ^>=2.0
54+
, time ^>=1.11.1
55+
56+
hs-source-dirs: aoc
57+
58+
library solutions
59+
import: common
60+
61+
-- cabal-fmt: expand solutions
62+
exposed-modules:
63+
Days.Day01
64+
Days.Day02
65+
Days.Day03
66+
Days.Day04
67+
Days.Day05
68+
Days.Day06
69+
Days.Day07
70+
Days.Day08
71+
Days.Day09
72+
Days.Day10
73+
Days.Day11
74+
Days.Day12
75+
Days.Day13
76+
Days.Day14
77+
Days.Day15
78+
Days.Day16
79+
Days.Day17
80+
Days.Day18
81+
Days.Day19
82+
Days.Day20
83+
Days.Day21
84+
Days.Day22
85+
Days.Day23
86+
Days.Day24
87+
Solutions
88+
89+
build-depends:
90+
, aoc
91+
, base ^>=4.16.3.0
92+
, containers ^>=0.6.5
93+
, text ^>=2.0
94+
95+
hs-source-dirs: solutions

‎aoc/AOC.hs

+7
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
module AOC (
2+
module AOC.Types,
3+
mkAocClient
4+
) where
5+
6+
import AOC.Types
7+
import AOC.API

‎aoc/AOC/API.hs

+101
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,101 @@
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE OverloadedStrings #-}
3+
{-# LANGUAGE TypeOperators #-}
4+
5+
module AOC.API (
6+
mkAocClient,
7+
) where
8+
9+
import AOC.Types
10+
import Control.Monad ((>=>))
11+
import Data.ByteString qualified as BS
12+
import Data.Proxy (Proxy (..))
13+
import Data.Text qualified as T
14+
import Data.Text.Encoding qualified as T
15+
import Data.Time.Clock (addUTCTime, getCurrentTime)
16+
import GHC.Conc (atomically, newTVar)
17+
import Network.HTTP.Client (Cookie (..), createCookieJar)
18+
import Network.HTTP.Client.TLS (newTlsManager)
19+
import Network.HTTP.Media ((//), (/:))
20+
import Servant.API
21+
import Servant.Client hiding ((//), (/:))
22+
23+
mkAocClient :: String -> Int -> Int -> IO (IO T.Text, Submission -> IO Answer)
24+
mkAocClient session year day = do
25+
env <- mkAocEnv session
26+
let aocInput :<|> aocSubmit = aocClient year day
27+
f = flip runClientM env >=> pure . either (error . show) id
28+
aocInput' = f aocInput
29+
aocSubmit' = f . aocSubmit
30+
return (aocInput', aocSubmit')
31+
32+
mkAocEnv :: String -> IO ClientEnv
33+
mkAocEnv session = do
34+
current <- getCurrentTime
35+
manager <- newTlsManager
36+
let
37+
base = BaseUrl Https "adventofcode.com" 443 ""
38+
env = mkClientEnv manager base
39+
year = 60 * 60 * 24 * 365
40+
expiry = addUTCTime year current
41+
cookie =
42+
Cookie
43+
{ cookie_name = "session",
44+
cookie_value = T.encodeUtf8 . T.pack $ session,
45+
cookie_expiry_time = expiry,
46+
cookie_domain = T.encodeUtf8 . T.pack $ baseUrlHost base,
47+
cookie_path = "/",
48+
cookie_creation_time = current,
49+
cookie_last_access_time = current,
50+
cookie_persistent = True,
51+
cookie_host_only = True,
52+
cookie_secure_only = True,
53+
cookie_http_only = True
54+
}
55+
cookies <- atomically $ newTVar (createCookieJar [cookie])
56+
return $ env {cookieJar = Just cookies}
57+
58+
aocClient :: Int -> Int -> (ClientM T.Text :<|> (Submission -> ClientM Answer))
59+
aocClient = client (Proxy @API)
60+
61+
type API =
62+
Capture "year" Int :>
63+
("day" :> Capture "day" Int :>
64+
(
65+
-- GET /:year/day/:day/input
66+
("input" :> Get '[RawPlainText] T.Text) :<|>
67+
-- POST /:year/day/:day/answer level=<1|2>&answer=_
68+
("answer" :> ReqBody '[FormUrlEncoded] Submission :> Post '[HTML] Answer)
69+
)
70+
)
71+
72+
-- This is silly: https://github.com/haskell-servant/servant/issues/1002
73+
data RawPlainText
74+
75+
instance Accept RawPlainText where
76+
contentType _ = "text" // "plain"
77+
78+
instance MimeUnrender RawPlainText T.Text where
79+
mimeUnrender _ = Right . T.decodeUtf8 . BS.toStrict
80+
81+
-- TODO implement marshalling from HTML to 'Day', 'Year', and 'Answer'
82+
-- types which extracts yearly calendars, day prompts, and
83+
-- pre-existing correct answer submissions via scraping the received
84+
-- HTML.
85+
86+
data HTML
87+
88+
instance Accept HTML where
89+
contentType _ = "text" // "html" /: ("charset", "utf-8")
90+
91+
data Answer = Correct | Low | High | Empty
92+
93+
instance MimeUnrender HTML Answer where
94+
mimeUnrender _ bs
95+
| "correct" `BS.isInfixOf` bs' = Right Correct
96+
| "low" `BS.isInfixOf` bs' = Right Low
97+
| "high" `BS.isInfixOf` bs' = Right High
98+
| "provide an answer" `BS.isInfixOf` bs' = Right Empty
99+
| otherwise = Left "Unknown answer response"
100+
where
101+
bs' = BS.toStrict bs

‎aoc/AOC/Types.hs

+19
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,19 @@
1+
{-# language GADTs #-}
2+
module AOC.Types (
3+
Solution (..),
4+
Submission (..)
5+
) where
6+
7+
import Data.Text (Text)
8+
import GHC.Generics (Generic)
9+
import Web.Internal.FormUrlEncoded (ToForm)
10+
11+
data Solution where
12+
Solution :: Show b => (Text -> a) -> (a -> b) -> (a -> b) -> Solution
13+
14+
data Submission = Submission {
15+
part :: Int,
16+
answer :: String
17+
} deriving (Generic)
18+
19+
instance ToForm Submission

‎cabal.project

+3
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
with-compiler: ghc-9.2.4
2+
3+
packages: .

‎runner/Main.hs

+112
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,112 @@
1+
module Main where
2+
3+
import AOC (Solution (..), mkAocClient)
4+
import Configuration.Dotenv (defaultConfig, loadFile)
5+
import Control.Exception (IOException, catch)
6+
import Control.Monad (when)
7+
import Data.Functor (void)
8+
import Data.IntMap.Strict qualified as M
9+
import Data.Text qualified as T
10+
import Data.Text.IO qualified as T
11+
import Options.Applicative
12+
import Solutions (solutions)
13+
import System.Directory (createDirectoryIfMissing)
14+
import System.Environment (getEnv)
15+
import Tests (test)
16+
import Text.Printf (printf)
17+
18+
-- | CLI Options
19+
data Options = Option
20+
{ _command :: Action,
21+
_day :: Int,
22+
_part :: Maybe Int
23+
}
24+
25+
-- | CLI Commands
26+
data Action = Run | Test | Bench | Submit
27+
deriving (Show)
28+
29+
main :: IO ()
30+
main = do
31+
void $ loadFile defaultConfig
32+
33+
session <- getEnv "SESSION"
34+
year <- read <$> getEnv "YEAR"
35+
36+
Option {..} <- customExecParser (prefs showHelpOnEmpty) opts
37+
38+
when (_day < 1 || _day > 24) $ do
39+
fail $ printf "Day '%d' is out of range (1-24)" _day
40+
41+
(aocInput, aocSubmit) <- mkAocClient session year _day
42+
43+
input <- getPuzzleInput _day aocInput
44+
let day = solutions M.! _day
45+
46+
case _command of
47+
Run -> putStr $ run day _part input
48+
Test -> test day _day _part
49+
a -> fail $ "Unimplemented: " ++ show a
50+
51+
-- | Retrieve puzzle input for a given day from a file. If no file is
52+
-- found, hit the api.
53+
getPuzzleInput :: Int -> IO T.Text -> IO T.Text
54+
getPuzzleInput day aocInput =
55+
T.readFile fp `catch` \(_ :: IOException) -> fetchInput
56+
where
57+
fp = printf ".inputs/%d.txt" day
58+
59+
fetchInput = do
60+
input <- aocInput
61+
createDirectoryIfMissing True ".inputs"
62+
T.writeFile fp input
63+
return input
64+
65+
-- | Run solution (optionally just part) on input and return the
66+
-- result as a string ready for submission
67+
run :: Solution -> Maybe Int -> T.Text -> String
68+
run (Solution pInput part1 part2) part input =
69+
case part of
70+
Nothing -> printf "Part 1: %s\nPart 2: %s\n" part1' part2'
71+
Just n -> printf "Part %d: %s\n" n $ if n == 1 then part1' else part2'
72+
where
73+
parsed = pInput input
74+
part1' = show $ part1 parsed
75+
part2' = show $ part2 parsed
76+
77+
-- | CLI parser
78+
opts :: ParserInfo Options
79+
opts =
80+
info
81+
(commands <**> helper)
82+
( fullDesc
83+
<> progDesc "Run, benchmark, test, or submit an AOC day"
84+
<> header "runner - an AOC solution runner"
85+
)
86+
where
87+
commands = subparser $ runCmd <> testCmd <> benchCmd <> submitCmd
88+
runCmd =
89+
mkCmd
90+
"run"
91+
(Option Run <$> day <*> optional part)
92+
"Run a given day, optionally specifying which part"
93+
testCmd =
94+
mkCmd
95+
"test"
96+
(Option Test <$> day <*> optional part)
97+
"Test a given day, optionally specifying which part"
98+
benchCmd =
99+
mkCmd
100+
"bench"
101+
(Option Bench <$> day <*> optional part)
102+
"Benchmark a given day, optionally specifying which part"
103+
submitCmd =
104+
mkCmd
105+
"submit"
106+
(Option Submit <$> day <*> (Just <$> part))
107+
"Run and submit the answer to a given day and part"
108+
109+
day = argument auto (metavar "DAY")
110+
part = argument auto (metavar "PART")
111+
112+
mkCmd cmd f desc = command cmd (info f (progDesc desc))

0 commit comments

Comments
 (0)