Compare commits
11 commits
90c48b3672
...
84d4f12f9b
Author | SHA1 | Date | |
---|---|---|---|
84d4f12f9b | |||
d030bd79c5 | |||
faaf42e66c | |||
5a2ffc1058 | |||
24285db686 | |||
32a8c6bd43 | |||
4683cd72b9 | |||
9d3eeacd4c | |||
a294515c1d | |||
0c7c4d7c48 | |||
091cd61e95 |
29 changed files with 1529 additions and 102 deletions
2
.gitignore
vendored
2
.gitignore
vendored
|
@ -4,3 +4,5 @@ inputs/
|
||||||
support/*.o
|
support/*.o
|
||||||
support/advent-support
|
support/advent-support
|
||||||
tmp/
|
tmp/
|
||||||
|
book/
|
||||||
|
index.html
|
||||||
|
|
25
README.md
25
README.md
|
@ -6,6 +6,9 @@ Idris files.
|
||||||
|
|
||||||
## Authors Note
|
## Authors Note
|
||||||
|
|
||||||
|
This entire book is a single literate code base, the source code is available at
|
||||||
|
<https://git.stranger.systems/Idris/advent>.
|
||||||
|
|
||||||
The solutions contained in this project are intended to be read in sequential
|
The solutions contained in this project are intended to be read in sequential
|
||||||
order, though can reasonably be read in any order if you have a good level of
|
order, though can reasonably be read in any order if you have a good level of
|
||||||
familiarity with more advanced functional programming topics.
|
familiarity with more advanced functional programming topics.
|
||||||
|
@ -22,7 +25,7 @@ mailing list on source hut.
|
||||||
While this project is intended to read more like a book, while it is still a
|
While this project is intended to read more like a book, while it is still a
|
||||||
work in progress, you can follow its development as a psuedo-blog by subscribing
|
work in progress, you can follow its development as a psuedo-blog by subscribing
|
||||||
to the rss feed for the repository in your feed reader:
|
to the rss feed for the repository in your feed reader:
|
||||||
https://git.stranger.systems/Idris/advent.rss
|
<https://git.stranger.systems/Idris/advent.rss>.
|
||||||
|
|
||||||
## Index of non-day modules
|
## Index of non-day modules
|
||||||
|
|
||||||
|
@ -56,6 +59,26 @@ solution.
|
||||||
Provider wrappers over the standard library `IOArray` type to make them more
|
Provider wrappers over the standard library `IOArray` type to make them more
|
||||||
ergonomic to use.
|
ergonomic to use.
|
||||||
|
|
||||||
|
- [Parser](src/Parser.md)
|
||||||
|
|
||||||
|
Effectful parser mini-library
|
||||||
|
|
||||||
|
- [Interface](src/Parser/Interface.md)
|
||||||
|
|
||||||
|
Effectful parser API
|
||||||
|
|
||||||
|
- [ParserState](src/Parser/ParserState.md)
|
||||||
|
|
||||||
|
Internal state of a parser
|
||||||
|
|
||||||
|
- [Numbers](src/Parser/Numbers.md)
|
||||||
|
|
||||||
|
Parsers for numerical values in multiple bases
|
||||||
|
|
||||||
|
- [JSON](src/Parser/JSON.md)
|
||||||
|
|
||||||
|
JSON Parser
|
||||||
|
|
||||||
## Index of years and days
|
## Index of years and days
|
||||||
|
|
||||||
- 2015
|
- 2015
|
||||||
|
|
|
@ -19,6 +19,7 @@ depends = base
|
||||||
, tailrec
|
, tailrec
|
||||||
, eff
|
, eff
|
||||||
, elab-util
|
, elab-util
|
||||||
|
, sop
|
||||||
, ansi
|
, ansi
|
||||||
, if-unsolved-implicit
|
, if-unsolved-implicit
|
||||||
, c-ffi
|
, c-ffi
|
||||||
|
@ -30,6 +31,10 @@ modules = Runner
|
||||||
, Util.Eff
|
, Util.Eff
|
||||||
, Util.Digits
|
, Util.Digits
|
||||||
, Array
|
, Array
|
||||||
|
, Parser
|
||||||
|
, Parser.Interface
|
||||||
|
, Parser.Numbers
|
||||||
|
, Parser.JSON
|
||||||
|
|
||||||
-- main file (i.e. file to load at REPL)
|
-- main file (i.e. file to load at REPL)
|
||||||
main = Main
|
main = Main
|
||||||
|
|
13
book.toml
Normal file
13
book.toml
Normal file
|
@ -0,0 +1,13 @@
|
||||||
|
[book]
|
||||||
|
authors = ["Nathan McCarty"]
|
||||||
|
language = "en"
|
||||||
|
multilingual = false
|
||||||
|
src = "src"
|
||||||
|
title = "Idris 2 by Highly Contrived Example"
|
||||||
|
|
||||||
|
[build]
|
||||||
|
create-missing = false
|
||||||
|
use-default-preprocessors = false
|
||||||
|
|
||||||
|
[output.html]
|
||||||
|
preferred-dark-theme = "ayu"
|
101
scripts/build-book
Executable file
101
scripts/build-book
Executable file
|
@ -0,0 +1,101 @@
|
||||||
|
#!/usr/bin/env raku
|
||||||
|
|
||||||
|
use File::Temp;
|
||||||
|
use Shell::Command;
|
||||||
|
use paths;
|
||||||
|
|
||||||
|
unit sub MAIN(Bool :$upload);
|
||||||
|
|
||||||
|
my $tempdir = tempdir.IO;
|
||||||
|
my $ttc-number = dir('build/ttc').first.basename;
|
||||||
|
my $ttc = "build/ttc/$ttc-number".IO;
|
||||||
|
|
||||||
|
# Filenames to ignore while processing source files
|
||||||
|
my Str:D @ignored = ["README.md", "SUMMARY.md"];
|
||||||
|
# Check to see if a filename is ignored
|
||||||
|
sub not-ignored($path) {
|
||||||
|
for @ignored -> $ignored {
|
||||||
|
return False if $path.ends-with: $ignored;
|
||||||
|
}
|
||||||
|
return True;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Copy a file from the current directory to the temporary directory, preserving
|
||||||
|
# realtive path. Resolves symlinks in source, but does not reflect symlink
|
||||||
|
# resoultion in the output path
|
||||||
|
sub cp-temp($src) {
|
||||||
|
my $src-path = do given $src {
|
||||||
|
when Str {
|
||||||
|
$src.IO
|
||||||
|
}
|
||||||
|
when IO::Path {
|
||||||
|
$src
|
||||||
|
}
|
||||||
|
default {
|
||||||
|
die "Invalid source $src, {$src.WHAT}"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
my $output-path = $tempdir.add($src-path.relative).IO;
|
||||||
|
# Create the parent directory if needed
|
||||||
|
if !$output-path.parent.d {
|
||||||
|
$output-path.parent.mkdir;
|
||||||
|
|
||||||
|
}
|
||||||
|
# Copy the file
|
||||||
|
$src-path.resolve.copy: $output-path;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Invoke katla on a source file, streaming its output to the temporary directory
|
||||||
|
sub katla($src, $ttc-src) {
|
||||||
|
# Run katla and collect the output
|
||||||
|
my $katla = run 'katla', 'markdown', $src, $ttc-src, :out;
|
||||||
|
my $output = $katla.out.slurp(:close);
|
||||||
|
# TODO: Post process them to set themeing correctly
|
||||||
|
$output ~~ s:g/'<style>' .* '</style>'//;
|
||||||
|
$output ~~ s:g/'<br />'//;
|
||||||
|
$output ~~ s:g/'<code'/<pre><code/;
|
||||||
|
$output ~~ s:g/'</code>'/<\/code><\/pre>/;
|
||||||
|
$output ~~ s:g/'class="IdrisKeyword"'/class="hljs-keyword"/;
|
||||||
|
$output ~~ s:g/'class="IdrisModule"'/class="hljs-symbol hljs-emphasis"/;
|
||||||
|
$output ~~ s:g/'class="IdrisComment"'/class="hljs-comment"/;
|
||||||
|
$output ~~ s:g/'class="IdrisFunction"'/class="hljs-symbol"/;
|
||||||
|
$output ~~ s:g/'class="IdrisBound"'/class="hljs-name"/;
|
||||||
|
$output ~~ s:g/'class="IdrisData"'/class="hljs-title"/;
|
||||||
|
$output ~~ s:g/'class="IdrisType"'/class="hljs-type"/;
|
||||||
|
$output ~~ s:g/'class="IdrisNamespace"'/class="hljs-symbol hljs-emphasis"/;
|
||||||
|
|
||||||
|
# Spurt the output to the temporary directory
|
||||||
|
my $output-path = $tempdir.add: $src;
|
||||||
|
if !$output-path.parent.d {
|
||||||
|
$output-path.parent.mkdir;
|
||||||
|
}
|
||||||
|
$output-path.spurt($output);
|
||||||
|
}
|
||||||
|
|
||||||
|
# Copy our metadata files
|
||||||
|
cp-temp "book.toml";
|
||||||
|
cp-temp "src/README.md";
|
||||||
|
cp-temp "src/SUMMARY.md";
|
||||||
|
|
||||||
|
# Katla over the source files
|
||||||
|
for paths("src", :file(*.¬-ignored)) -> $path {
|
||||||
|
my $ttc-path = $ttc.add($path.IO.relative: "src").extension: "ttm";
|
||||||
|
katla $path.IO.relative, $ttc-path.relative;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Build the book
|
||||||
|
|
||||||
|
indir $tempdir, {
|
||||||
|
my $mdbook = run <mdbook build>;
|
||||||
|
die "Ooops" unless $mdbook;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Copy it over
|
||||||
|
rm_rf "book";
|
||||||
|
cp $tempdir.add("book"), "book", :r;
|
||||||
|
|
||||||
|
if $upload {
|
||||||
|
my $rsync = run 'rsync', '-avzh', $tempdir.add("book").Str,
|
||||||
|
'ubuntu@static.stranger.systems:/var/www/static.stranger.systems/idris-by-contrived-example';
|
||||||
|
die "rsync went bad" unless $rsync;
|
||||||
|
}
|
|
@ -12,9 +12,9 @@ import Decidable.Equality
|
||||||
import Control.WellFounded
|
import Control.WellFounded
|
||||||
```
|
```
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
import System
|
import System
|
||||||
-->
|
```
|
||||||
|
|
||||||
```idris
|
```idris
|
||||||
%default total
|
%default total
|
||||||
|
@ -89,9 +89,9 @@ Iterable (LazyList a) a where
|
||||||
|
|
||||||
## Immutable arrays
|
## Immutable arrays
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
namespace Immutable
|
namespace Immutable
|
||||||
-->
|
```
|
||||||
|
|
||||||
Immutable arrays created from vectors that provide constant time indexing and
|
Immutable arrays created from vectors that provide constant time indexing and
|
||||||
slicing operations.
|
slicing operations.
|
||||||
|
|
|
@ -76,7 +76,7 @@ data Error : Type where
|
||||||
A `Show` implementation for `Error` is provided, hidden in this document for
|
A `Show` implementation for `Error` is provided, hidden in this document for
|
||||||
brevity.
|
brevity.
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
Show Error where
|
Show Error where
|
||||||
show (OptionsError errs) =
|
show (OptionsError errs) =
|
||||||
let errs = unlines . map (" " ++) . lines . joinBy "\n" $ errs
|
let errs = unlines . map (" " ++) . lines . joinBy "\n" $ errs
|
||||||
|
@ -98,7 +98,7 @@ Show Error where
|
||||||
show (SolveError year day part err) =
|
show (SolveError year day part err) =
|
||||||
let err = unlines . map (" " ++) . lines . show $ err
|
let err = unlines . map (" " ++) . lines . show $ err
|
||||||
in "Error solving day \{show day} part \{show part} of year \{show year}: \n" ++ err
|
in "Error solving day \{show day} part \{show part} of year \{show year}: \n" ++ err
|
||||||
-->
|
```
|
||||||
|
|
||||||
## Extract the year and day
|
## Extract the year and day
|
||||||
|
|
||||||
|
|
8
src/Parser.md
Normal file
8
src/Parser.md
Normal file
|
@ -0,0 +1,8 @@
|
||||||
|
# Parsing Utilties
|
||||||
|
|
||||||
|
```idris
|
||||||
|
module Parser
|
||||||
|
|
||||||
|
import public Parser.Interface as Parser
|
||||||
|
import public Parser.ParserState as Parser
|
||||||
|
```
|
332
src/Parser/Interface.md
Normal file
332
src/Parser/Interface.md
Normal file
|
@ -0,0 +1,332 @@
|
||||||
|
# The interface of a `Parser`
|
||||||
|
|
||||||
|
```idris
|
||||||
|
module Parser.Interface
|
||||||
|
|
||||||
|
import public Data.List1
|
||||||
|
|
||||||
|
import public Parser.ParserState
|
||||||
|
|
||||||
|
import public Control.Eff
|
||||||
|
|
||||||
|
export infixr 4 >|
|
||||||
|
export infixr 5 >&
|
||||||
|
```
|
||||||
|
|
||||||
|
## Parser Errors
|
||||||
|
|
||||||
|
Combine the parser state at time of error with an error message.
|
||||||
|
|
||||||
|
```idris
|
||||||
|
public export
|
||||||
|
data ParseError : Type where
|
||||||
|
-- TODO: Rename this constructor
|
||||||
|
MkParseError : (state : ParserInternal Id) -> (message : String) -> ParseError
|
||||||
|
BeforeParse : (message : String) -> ParseError
|
||||||
|
NestedErrors : (state : ParserInternal Id) -> (message : String)
|
||||||
|
-> (rest : List ParseError) -> ParseError
|
||||||
|
```
|
||||||
|
|
||||||
|
```idris hide
|
||||||
|
export
|
||||||
|
Show ParseError where
|
||||||
|
show (MkParseError state message) =
|
||||||
|
let (line, col) = positionPair state
|
||||||
|
(line, col) = (show line, show col)
|
||||||
|
position = show state.position.index
|
||||||
|
in "Error at line \{line}, column \{col} (\{position}): \{message}"
|
||||||
|
show (BeforeParse message) =
|
||||||
|
"Error before parsing: \{message}"
|
||||||
|
show (NestedErrors state message rest) =
|
||||||
|
let rest = assert_total $joinBy "\n" . map ((" " ++) . show) $ rest
|
||||||
|
(line, col) = positionPair state
|
||||||
|
(line, col) = (show line, show col)
|
||||||
|
position = show state.position.index
|
||||||
|
first = "Error at line \{line}, column \{col} (\{position}): \{message}"
|
||||||
|
in "\{first}\n\{rest}"
|
||||||
|
```
|
||||||
|
|
||||||
|
## Type Alias
|
||||||
|
|
||||||
|
```idris
|
||||||
|
public export
|
||||||
|
Parser : Type -> Type
|
||||||
|
Parser a = Eff [ParserState, Except ParseError] a
|
||||||
|
```
|
||||||
|
|
||||||
|
## Error Generation
|
||||||
|
|
||||||
|
Provide a few effectful actions to generate an error from an error message, and
|
||||||
|
either return it or throw it.
|
||||||
|
|
||||||
|
```idris
|
||||||
|
export
|
||||||
|
parseError : Has ParserState fs => (message : String) -> Eff fs ParseError
|
||||||
|
parseError message = do
|
||||||
|
state <- save
|
||||||
|
pure $ MkParseError state message
|
||||||
|
|
||||||
|
export
|
||||||
|
throwParseError : Has ParserState fs => Has (Except ParseError) fs =>
|
||||||
|
(message : String) -> Eff fs a
|
||||||
|
throwParseError message = do
|
||||||
|
err <- parseError message
|
||||||
|
throw err
|
||||||
|
|
||||||
|
export
|
||||||
|
guardMaybe : Has ParserState fs => Has (Except ParseError) fs =>
|
||||||
|
(message : String) -> Eff fs (Maybe a) -> Eff fs a
|
||||||
|
guardMaybe message x = do
|
||||||
|
Just x <- x
|
||||||
|
| _ => throwParseError message
|
||||||
|
pure x
|
||||||
|
|
||||||
|
export
|
||||||
|
replaceError : (message : String) -> Parser (a -> Parser b)
|
||||||
|
replaceError message = do
|
||||||
|
state <- save
|
||||||
|
pure (\_ => throw $ MkParseError state message)
|
||||||
|
```
|
||||||
|
|
||||||
|
## Running a parser
|
||||||
|
|
||||||
|
We will use the phrasing "rundown" to refer to running all the effects in the
|
||||||
|
parser effect stack except `ParserState`, which is left in the effect stack to
|
||||||
|
facilitate handling in the context of another monad or effect stack, since it
|
||||||
|
benefits from mutability.
|
||||||
|
|
||||||
|
Rundown a parser, accepting the first returning parse, which may be failing or
|
||||||
|
succeding, and automatically generating a "no valid parses" message in the event
|
||||||
|
no paths in the `Choice` effect produce a returning parse.
|
||||||
|
|
||||||
|
```idris
|
||||||
|
export
|
||||||
|
rundownFirst : (f : Parser a) -> Eff [ParserState] (Either ParseError a)
|
||||||
|
rundownFirst f =
|
||||||
|
runExcept f
|
||||||
|
```
|
||||||
|
|
||||||
|
Provide wrappers for `rundownFirst` for evaluating it in various contexts.
|
||||||
|
|
||||||
|
```idris
|
||||||
|
export
|
||||||
|
runFirstIO : (f : Parser a) -> String -> IO (Either ParseError a)
|
||||||
|
runFirstIO f str = do
|
||||||
|
Just state <- newInternalIO str
|
||||||
|
| _ => pure . Left $ BeforeParse "Empty input"
|
||||||
|
runEff (rundownFirst f) [handleParserStateIO state]
|
||||||
|
|
||||||
|
export
|
||||||
|
runFirstIODebug : (f : Parser a) -> String -> IO (Either ParseError a)
|
||||||
|
runFirstIODebug f str = do
|
||||||
|
Just state <- newInternalIO str
|
||||||
|
| _ => pure . Left $ BeforeParse "Empty input"
|
||||||
|
runEff (rundownFirst f) [handleParserStateIODebug state]
|
||||||
|
|
||||||
|
export
|
||||||
|
runFirst : (f : Parser a) -> String -> Eff fs (Either ParseError a)
|
||||||
|
runFirst f str = do
|
||||||
|
Just state <- pure $ newInternal str
|
||||||
|
| _ => pure . Left $ BeforeParse "Empty input"
|
||||||
|
(result, _) <- lift . runParserState state . rundownFirst $ f
|
||||||
|
pure result
|
||||||
|
|
||||||
|
export
|
||||||
|
runFirst' : (f : Parser a) -> String -> Either ParseError a
|
||||||
|
runFirst' f str = extract $ runFirst f str {fs = []}
|
||||||
|
```
|
||||||
|
|
||||||
|
## Utility functionality
|
||||||
|
|
||||||
|
### Parser combinators
|
||||||
|
|
||||||
|
Try to run a computation in the context of the `Parser` effect stack, if it
|
||||||
|
fails (via `Except`), reset the state and resort to the supplied callback
|
||||||
|
|
||||||
|
Also supply a version specialized to ignore the error value, returning `Just a`
|
||||||
|
if the parse succeeds, and `Nothing` if it fails.
|
||||||
|
|
||||||
|
```idris
|
||||||
|
export
|
||||||
|
try : (f : Parser a) -> (err : ParseError -> Parser a) -> Parser a
|
||||||
|
try f err = do
|
||||||
|
starting_state <- save
|
||||||
|
result <- lift . runExcept $ f
|
||||||
|
case result of
|
||||||
|
Left error => do
|
||||||
|
load starting_state
|
||||||
|
err error
|
||||||
|
Right result => pure result
|
||||||
|
|
||||||
|
export
|
||||||
|
tryMaybe : (f : Parser a) -> Parser (Maybe a)
|
||||||
|
tryMaybe f = try (map Just f) (\_ => pure Nothing)
|
||||||
|
|
||||||
|
export
|
||||||
|
tryEither : (f : Parser a) -> Parser (Either ParseError a)
|
||||||
|
tryEither f = try (map Right f) (pure . Left)
|
||||||
|
```
|
||||||
|
|
||||||
|
Attempt to parse one of the given input parsers, in the provided order, invoking
|
||||||
|
the provided error action on failure.
|
||||||
|
|
||||||
|
The state will not be modified when an input parser fails
|
||||||
|
|
||||||
|
```idris
|
||||||
|
export
|
||||||
|
oneOfE : (err : String) -> List (Parser a) -> Parser a
|
||||||
|
oneOfE err xs = do
|
||||||
|
start <- save
|
||||||
|
oneOfE' err start [] xs
|
||||||
|
where
|
||||||
|
oneOfE' : (err : String) -> (start : ParserInternal Id)
|
||||||
|
-> (errs : List ParseError) -> List (Parser a) -> Parser a
|
||||||
|
oneOfE' err start errs [] = do
|
||||||
|
throw $ NestedErrors start err (reverse errs)
|
||||||
|
oneOfE' err start errs (x :: xs) = do
|
||||||
|
x <- tryEither x
|
||||||
|
case x of
|
||||||
|
Right val => pure val
|
||||||
|
Left error => oneOfE' err start (error :: errs) xs
|
||||||
|
```
|
||||||
|
|
||||||
|
Attempt to parse 0+ of an item
|
||||||
|
|
||||||
|
```idris
|
||||||
|
export
|
||||||
|
many : (f : Parser a) -> Parser (List a)
|
||||||
|
many f = do
|
||||||
|
Just next <- tryMaybe f
|
||||||
|
| _ => pure []
|
||||||
|
map (next ::) $ many f
|
||||||
|
```
|
||||||
|
|
||||||
|
Attempt to parse 1+ of an item, invoking the supplied error action on failure
|
||||||
|
|
||||||
|
```idris
|
||||||
|
export
|
||||||
|
atLeastOne : (err : ParseError -> Parser (List1 a)) -> (f : Parser a)
|
||||||
|
-> Parser (List1 a)
|
||||||
|
atLeastOne err f = do
|
||||||
|
Right next <- tryEither f
|
||||||
|
| Left e => err e
|
||||||
|
map (next :::) $ many f
|
||||||
|
```
|
||||||
|
|
||||||
|
Lift a parser producing a `List` or `List1` of `Char` into a parser producing a
|
||||||
|
`String`
|
||||||
|
|
||||||
|
```idris
|
||||||
|
-- TODO: Rename these
|
||||||
|
export
|
||||||
|
liftString : Parser (List Char) -> Parser String
|
||||||
|
liftString x = do
|
||||||
|
xs <- x
|
||||||
|
pure $ pack xs
|
||||||
|
|
||||||
|
export
|
||||||
|
liftString' : Parser (List1 Char) -> Parser String
|
||||||
|
liftString' x = liftString $ map forget x
|
||||||
|
```
|
||||||
|
|
||||||
|
Attempt to parse a specified character
|
||||||
|
|
||||||
|
```idris
|
||||||
|
export
|
||||||
|
charExact : Char -> Parser Char
|
||||||
|
charExact c = do
|
||||||
|
result <- charExact' c
|
||||||
|
case result of
|
||||||
|
GotChar char => pure char
|
||||||
|
GotError err => throwParseError "Got \{show err} Expected \{show c}"
|
||||||
|
EndOfInput => throwParseError "End of input"
|
||||||
|
```
|
||||||
|
|
||||||
|
Attempt to parse one of a list of chars
|
||||||
|
|
||||||
|
```idris
|
||||||
|
export
|
||||||
|
theseChars : List Char -> Parser Char
|
||||||
|
theseChars cs = do
|
||||||
|
pnote "Parsing one of: \{show cs}"
|
||||||
|
result <- charPredicate (\x => any (== x) cs)
|
||||||
|
case result of
|
||||||
|
GotChar char => pure char
|
||||||
|
GotError err => throwParseError "Got \{show err} Expected one of \{show cs}"
|
||||||
|
EndOfInput => throwParseError "End of input"
|
||||||
|
```
|
||||||
|
|
||||||
|
Attempt to parse an exact string
|
||||||
|
|
||||||
|
```idris
|
||||||
|
export
|
||||||
|
exactString : String -> Parser String
|
||||||
|
exactString str with (asList str)
|
||||||
|
exactString "" | [] = do
|
||||||
|
pnote "Parsing the empty string"
|
||||||
|
pure ""
|
||||||
|
exactString input@(strCons c str) | (c :: x) = do
|
||||||
|
pnote "Parsing exact string \{show input}"
|
||||||
|
GotChar next <- charPredicate (== c)
|
||||||
|
| GotError err => throwParseError "Got \{show err} expected \{show c}"
|
||||||
|
| EndOfInput => throwParseError "End of input"
|
||||||
|
rest <- exactString str | x
|
||||||
|
pure input
|
||||||
|
```
|
||||||
|
|
||||||
|
Wrap a parser in delimiter characters, discarding the value of the delimiters
|
||||||
|
|
||||||
|
```idris
|
||||||
|
export
|
||||||
|
delimited : (before, after : Char) -> Parser a -> Parser a
|
||||||
|
delimited before after x = do
|
||||||
|
pnote "Parsing delimited by \{show before} \{show after}"
|
||||||
|
starting_state <- save
|
||||||
|
_ <- charExact before
|
||||||
|
Right val <- tryEither x
|
||||||
|
| Left err => do
|
||||||
|
load starting_state
|
||||||
|
throw err
|
||||||
|
Just _ <- tryMaybe $ charExact after
|
||||||
|
| _ => do
|
||||||
|
load starting_state
|
||||||
|
throw $ MkParseError starting_state "Unmatched delimiter \{show before}"
|
||||||
|
pure val
|
||||||
|
```
|
||||||
|
|
||||||
|
Consume any number of characters of the provided character class and discard the
|
||||||
|
result. Also a version for doing so on both sides of a provided parser
|
||||||
|
|
||||||
|
```idris
|
||||||
|
export
|
||||||
|
nom : Parser Char -> Parser ()
|
||||||
|
nom x = do
|
||||||
|
pnote "Nomming"
|
||||||
|
_ <- many x
|
||||||
|
pure ()
|
||||||
|
|
||||||
|
export
|
||||||
|
surround : (around : Parser Char) -> (item : Parser a) -> Parser a
|
||||||
|
surround around item = do
|
||||||
|
pnote "Surrounding"
|
||||||
|
nom around
|
||||||
|
val <- item
|
||||||
|
nom around
|
||||||
|
pure val
|
||||||
|
```
|
||||||
|
|
||||||
|
### Composition of boolean functions
|
||||||
|
|
||||||
|
```idris
|
||||||
|
||| Return true if both of the predicates evaluate to true
|
||||||
|
public export
|
||||||
|
(>&) : (a : e -> Bool) -> (b : e -> Bool) -> (e -> Bool)
|
||||||
|
(>&) a b x = a x && b x
|
||||||
|
```
|
||||||
|
|
||||||
|
```idris
|
||||||
|
||| Return true if either of the predicates evaulates to true
|
||||||
|
public export
|
||||||
|
(>|) : (a : e -> Bool) -> (b : e -> Bool) -> (e -> Bool)
|
||||||
|
(>|) a b x = a x || b x
|
||||||
|
```
|
285
src/Parser/JSON.md
Normal file
285
src/Parser/JSON.md
Normal file
|
@ -0,0 +1,285 @@
|
||||||
|
# JSON Parser
|
||||||
|
|
||||||
|
```idris
|
||||||
|
module Parser.JSON
|
||||||
|
|
||||||
|
import public Parser
|
||||||
|
import public Parser.Numbers
|
||||||
|
|
||||||
|
import Structures.Dependent.DList
|
||||||
|
```
|
||||||
|
|
||||||
|
```idris hide
|
||||||
|
import System
|
||||||
|
import Derive.Prelude
|
||||||
|
import Generics.Derive
|
||||||
|
|
||||||
|
%hide Generics.Derive.Eq
|
||||||
|
%hide Generics.Derive.Ord
|
||||||
|
%hide Generics.Derive.Show
|
||||||
|
|
||||||
|
%language ElabReflection
|
||||||
|
```
|
||||||
|
|
||||||
|
## JSON components
|
||||||
|
|
||||||
|
Types a JSON value is allowed to have
|
||||||
|
|
||||||
|
```idris
|
||||||
|
public export
|
||||||
|
data JSONType : Type where
|
||||||
|
TObject : JSONType
|
||||||
|
TArray : JSONType
|
||||||
|
TString : JSONType
|
||||||
|
TNumber : JSONType
|
||||||
|
TBool : JSONType
|
||||||
|
TNull : JSONType
|
||||||
|
%runElab derive "JSONType" [Generic, Meta, Eq, Ord, Show, DecEq]
|
||||||
|
%name JSONType type, type2, type3
|
||||||
|
```
|
||||||
|
|
||||||
|
A JSON value indexed by its type
|
||||||
|
|
||||||
|
```idris
|
||||||
|
public export
|
||||||
|
data JSONValue : JSONType -> Type where
|
||||||
|
VObject : {types : List JSONType}
|
||||||
|
-> DList JSONType (\t => (String, JSONValue t)) types -> JSONValue TObject
|
||||||
|
VArray : {types : List JSONType}
|
||||||
|
-> DList JSONType JSONValue types -> JSONValue TArray
|
||||||
|
VString : (s : String) -> JSONValue TString
|
||||||
|
VNumber : (d : Double) -> JSONValue TNumber
|
||||||
|
VBool : (b : Bool) -> JSONValue TBool
|
||||||
|
VNull : JSONValue TNull
|
||||||
|
%name JSONValue value, value2, value3
|
||||||
|
```
|
||||||
|
|
||||||
|
```idris hide
|
||||||
|
Show (JSONValue t) where
|
||||||
|
show (VObject xs) =
|
||||||
|
let xs = dMap (\_,(key, value) => "\"\{key}\":\{show value}") xs
|
||||||
|
in assert_total $ "{\{joinBy "," xs}}"
|
||||||
|
show (VArray xs) =
|
||||||
|
let xs = dMap (\_,e => show e) xs
|
||||||
|
in assert_total $ "[\{joinBy "," xs}]"
|
||||||
|
show (VString s) = "\"\{s}\""
|
||||||
|
show (VNumber d) = show d
|
||||||
|
show (VBool False) = "false"
|
||||||
|
show (VBool True) = "true"
|
||||||
|
show VNull = "null"
|
||||||
|
|
||||||
|
-- TODO: Deal with keys potentially having different orders in different objects
|
||||||
|
Eq (JSONValue t) where
|
||||||
|
(VObject xs) == (VObject ys) =
|
||||||
|
assert_total $ xs $== ys
|
||||||
|
(VArray xs) == (VArray ys) =
|
||||||
|
assert_total $ xs $== ys
|
||||||
|
(VString s) == (VString str) = s == str
|
||||||
|
(VNumber d) == (VNumber dbl) = d == dbl
|
||||||
|
(VBool b) == (VBool x) = b == x
|
||||||
|
VNull == VNull = True
|
||||||
|
|
||||||
|
%hide Language.Reflection.TT.WithFC.value
|
||||||
|
```
|
||||||
|
|
||||||
|
## Parsers
|
||||||
|
|
||||||
|
We are going to get mutually recursive here. Instead of using a `mutual` block,
|
||||||
|
we will use the more modern style of declaring all our types ahead of our
|
||||||
|
definitions.
|
||||||
|
|
||||||
|
```idris
|
||||||
|
export
|
||||||
|
object : Parser (JSONValue TObject)
|
||||||
|
export
|
||||||
|
array : Parser (JSONValue TArray)
|
||||||
|
export
|
||||||
|
string : Parser (JSONValue TString)
|
||||||
|
export
|
||||||
|
number : Parser (JSONValue TNumber)
|
||||||
|
export
|
||||||
|
bool : Parser (JSONValue TBool)
|
||||||
|
export
|
||||||
|
null : Parser (JSONValue TNull)
|
||||||
|
```
|
||||||
|
|
||||||
|
Define a `whitespace` character class based on the json specifications
|
||||||
|
|
||||||
|
```idris
|
||||||
|
whitespace : Parser Char
|
||||||
|
whitespace = do
|
||||||
|
pnote "Whitespace character"
|
||||||
|
theseChars [' ', '\n', '\r', '\t']
|
||||||
|
```
|
||||||
|
|
||||||
|
Convenience function
|
||||||
|
|
||||||
|
```idris
|
||||||
|
dpairize : {t : JSONType} ->
|
||||||
|
Parser (JSONValue t) -> Parser (t' : JSONType ** JSONValue t')
|
||||||
|
dpairize x = do
|
||||||
|
x <- x
|
||||||
|
pure (_ ** x)
|
||||||
|
```
|
||||||
|
|
||||||
|
Top level json value parser
|
||||||
|
|
||||||
|
```idris
|
||||||
|
export
|
||||||
|
value : Parser (t : JSONType ** JSONValue t)
|
||||||
|
value = do
|
||||||
|
pnote "JSON Value"
|
||||||
|
surround whitespace $ oneOfE
|
||||||
|
"Expected JSON Value"
|
||||||
|
[
|
||||||
|
dpairize object
|
||||||
|
, dpairize array
|
||||||
|
, dpairize string
|
||||||
|
, dpairize number
|
||||||
|
, dpairize bool
|
||||||
|
, dpairize null
|
||||||
|
]
|
||||||
|
```
|
||||||
|
|
||||||
|
Now go through our json value types
|
||||||
|
|
||||||
|
```idris
|
||||||
|
object = do
|
||||||
|
pnote "JSON Object"
|
||||||
|
oneOfE
|
||||||
|
"Expected Object"
|
||||||
|
[emptyObject, occupiedObject]
|
||||||
|
where
|
||||||
|
emptyObject : Parser (JSONValue TObject)
|
||||||
|
emptyObject = do
|
||||||
|
delimited '{' '}' (nom whitespace)
|
||||||
|
pure $ VObject Nil
|
||||||
|
keyValue : Parser (t : JSONType ** (String, JSONValue t))
|
||||||
|
keyValue = do
|
||||||
|
VString key <- surround whitespace string
|
||||||
|
_ <- charExact ':'
|
||||||
|
(typ ** val) <- value
|
||||||
|
pure (typ ** (key, val))
|
||||||
|
restKeyValue : Parser (t : JSONType ** (String, JSONValue t))
|
||||||
|
restKeyValue = do
|
||||||
|
_ <- charExact ','
|
||||||
|
keyValue
|
||||||
|
pairs : Parser (List1 (t : JSONType ** (String, JSONValue t)))
|
||||||
|
pairs = do
|
||||||
|
first <- keyValue
|
||||||
|
rest <- many restKeyValue
|
||||||
|
pure $ first ::: rest
|
||||||
|
occupiedObject : Parser (JSONValue TObject)
|
||||||
|
occupiedObject = do
|
||||||
|
val <- delimited '{' '}' pairs
|
||||||
|
let (types ** xs) = DList.fromList (forget val)
|
||||||
|
pure $ VObject xs
|
||||||
|
```
|
||||||
|
|
||||||
|
```idris
|
||||||
|
array = do
|
||||||
|
pnote "JSON Array"
|
||||||
|
oneOfE
|
||||||
|
"Expected Array"
|
||||||
|
[emptyArray, occupiedArray]
|
||||||
|
where
|
||||||
|
emptyArray : Parser (JSONValue TArray)
|
||||||
|
emptyArray = do
|
||||||
|
delimited '[' ']' (nom whitespace)
|
||||||
|
pure $ VArray Nil
|
||||||
|
restValue : Parser (t : JSONType ** JSONValue t)
|
||||||
|
restValue = do
|
||||||
|
_ <- charExact ','
|
||||||
|
value
|
||||||
|
values : Parser (List1 (t : JSONType ** JSONValue t))
|
||||||
|
values = do
|
||||||
|
first <- value
|
||||||
|
rest <- many restValue
|
||||||
|
pure $ first ::: rest
|
||||||
|
occupiedArray : Parser (JSONValue TArray)
|
||||||
|
occupiedArray = do
|
||||||
|
xs <- delimited '[' ']' values
|
||||||
|
let (types ** xs) = DList.fromList (forget xs)
|
||||||
|
pure $ VArray xs
|
||||||
|
```
|
||||||
|
|
||||||
|
```idris
|
||||||
|
string = do
|
||||||
|
pnote "JSON String"
|
||||||
|
str <- liftString $ delimited '"' '"' (many stringCharacter)
|
||||||
|
pure $ VString str
|
||||||
|
where
|
||||||
|
-- TODO: Handle control characters properly
|
||||||
|
stringCharacter : Parser Char
|
||||||
|
stringCharacter = do
|
||||||
|
result <- charPredicate (not . (== '"'))
|
||||||
|
case result of
|
||||||
|
GotChar char => pure char
|
||||||
|
GotError err =>
|
||||||
|
throwParseError "Expected string character, got \{show err}"
|
||||||
|
EndOfInput => throwParseError "Unexpected end of input"
|
||||||
|
```
|
||||||
|
|
||||||
|
```idris
|
||||||
|
number = do
|
||||||
|
pnote "JSON Number"
|
||||||
|
d <- double
|
||||||
|
pure $ VNumber d
|
||||||
|
```
|
||||||
|
|
||||||
|
```idris
|
||||||
|
bool = do
|
||||||
|
pnote "JSON Bool"
|
||||||
|
oneOfE
|
||||||
|
"Expected Bool"
|
||||||
|
[true, false]
|
||||||
|
where
|
||||||
|
true : Parser (JSONValue TBool)
|
||||||
|
true = do
|
||||||
|
_ <- exactString "true"
|
||||||
|
pure $ VBool True
|
||||||
|
false : Parser (JSONValue TBool)
|
||||||
|
false = do
|
||||||
|
_ <- exactString "false"
|
||||||
|
pure $ VBool False
|
||||||
|
```
|
||||||
|
|
||||||
|
```idris
|
||||||
|
null = do
|
||||||
|
pnote "JSON null"
|
||||||
|
_ <- exactString "null"
|
||||||
|
pure VNull
|
||||||
|
```
|
||||||
|
|
||||||
|
## Unit tests
|
||||||
|
|
||||||
|
Quick smoke test
|
||||||
|
|
||||||
|
```idris
|
||||||
|
-- @@test JSON Quick Smoke
|
||||||
|
quickSmoke : IO Bool
|
||||||
|
quickSmoke = do
|
||||||
|
let input = "{\"string\":\"string\",\"number\":5,\"true\":true,\"false\":false,\"null\":null,\"array\":[1,2,3]}"
|
||||||
|
putStrLn input
|
||||||
|
Right (type ** parsed) <- runFirstIODebug value input
|
||||||
|
| Left err => do
|
||||||
|
printLn err
|
||||||
|
pure False
|
||||||
|
putStrLn "Input: \{input}\nOutput: \{show type} -> \{show parsed}"
|
||||||
|
let reference_object =
|
||||||
|
VObject [
|
||||||
|
("string", VString "string")
|
||||||
|
, ("number", VNumber 5.0)
|
||||||
|
, ("true", VBool True)
|
||||||
|
, ("false", VBool False)
|
||||||
|
, ("null", VNull)
|
||||||
|
, ("array", VArray [
|
||||||
|
VNumber 1.0
|
||||||
|
, VNumber 2.0
|
||||||
|
, VNumber 3.0
|
||||||
|
])
|
||||||
|
]
|
||||||
|
case type of
|
||||||
|
TObject => pure $ parsed == reference_object
|
||||||
|
_ => pure False
|
||||||
|
```
|
257
src/Parser/Numbers.md
Normal file
257
src/Parser/Numbers.md
Normal file
|
@ -0,0 +1,257 @@
|
||||||
|
# Numerical Parsers
|
||||||
|
|
||||||
|
```idris
|
||||||
|
module Parser.Numbers
|
||||||
|
|
||||||
|
import public Parser
|
||||||
|
|
||||||
|
import Data.Vect
|
||||||
|
import Control.Eff
|
||||||
|
```
|
||||||
|
|
||||||
|
```idris hide
|
||||||
|
import System
|
||||||
|
```
|
||||||
|
|
||||||
|
## Base Abstraction
|
||||||
|
|
||||||
|
```idris
|
||||||
|
public export
|
||||||
|
record Base where
|
||||||
|
constructor MkBase
|
||||||
|
base : Nat
|
||||||
|
digits : Vect base Char
|
||||||
|
%name Base b
|
||||||
|
|
||||||
|
export
|
||||||
|
hasDigit : Base -> Char -> Bool
|
||||||
|
hasDigit (MkBase base digits) c = any (== c) digits
|
||||||
|
|
||||||
|
export
|
||||||
|
digitValue : Base -> Char -> Maybe Nat
|
||||||
|
digitValue (MkBase base digits) c = digitValue' digits 0
|
||||||
|
where
|
||||||
|
digitValue' : Vect n Char -> (idx : Nat) -> Maybe Nat
|
||||||
|
digitValue' [] idx = Nothing
|
||||||
|
digitValue' (x :: xs) idx =
|
||||||
|
if x == c
|
||||||
|
then Just idx
|
||||||
|
else digitValue' xs (S idx)
|
||||||
|
|
||||||
|
public export
|
||||||
|
base10 : Base
|
||||||
|
base10 = MkBase 10
|
||||||
|
['0', '1', '2', '3', '4', '5', '6', '7', '8', '9']
|
||||||
|
|
||||||
|
public export
|
||||||
|
hex : Base
|
||||||
|
hex = MkBase 16
|
||||||
|
['0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f']
|
||||||
|
```
|
||||||
|
|
||||||
|
## Parsers
|
||||||
|
|
||||||
|
### Nat
|
||||||
|
|
||||||
|
```idris
|
||||||
|
export
|
||||||
|
nat : Base -> Parser Nat
|
||||||
|
nat b = do
|
||||||
|
error <- replaceError "Expected digit"
|
||||||
|
(first ::: rest) <- atLeastOne error parseDigit
|
||||||
|
pure $ foldl (\acc, e => 10 * acc + e) first rest
|
||||||
|
where
|
||||||
|
parseDigit : Parser Nat
|
||||||
|
parseDigit = do
|
||||||
|
GotChar char <- charPredicate (hasDigit b)
|
||||||
|
| GotError e => throwParseError "\{show e} is not a digit"
|
||||||
|
| EndOfInput => throwParseError "End Of Input"
|
||||||
|
case digitValue b char of
|
||||||
|
Nothing =>
|
||||||
|
throwParseError "Failed to parse as base \{show b.base}: \{show char}"
|
||||||
|
Just x => pure x
|
||||||
|
|
||||||
|
export
|
||||||
|
natBase10 : Parser Nat
|
||||||
|
natBase10 = nat base10
|
||||||
|
```
|
||||||
|
|
||||||
|
### Integer
|
||||||
|
|
||||||
|
```idris
|
||||||
|
export
|
||||||
|
integer : Base -> Parser Integer
|
||||||
|
integer b = do
|
||||||
|
negative <- map isJust . tryMaybe $ charExact '-'
|
||||||
|
value <- map natToInteger $ nat b
|
||||||
|
if negative
|
||||||
|
then pure $ negate value
|
||||||
|
else pure $ value
|
||||||
|
|
||||||
|
export
|
||||||
|
integerBase10 : Parser Integer
|
||||||
|
integerBase10 = integer base10
|
||||||
|
```
|
||||||
|
|
||||||
|
### Double
|
||||||
|
|
||||||
|
```idris
|
||||||
|
-- TODO: Replicate `parseDouble` logic and make this base-generic
|
||||||
|
export
|
||||||
|
double : Parser Double
|
||||||
|
double = do
|
||||||
|
starting_state <- save
|
||||||
|
integer <- integer
|
||||||
|
fraction <- tryMaybe fraction
|
||||||
|
exponent <- tryMaybe exponent
|
||||||
|
let str = case (fraction, exponent) of
|
||||||
|
(Nothing, Nothing) =>
|
||||||
|
integer
|
||||||
|
(Nothing, (Just exponent)) =>
|
||||||
|
"\{integer}e\{exponent}"
|
||||||
|
((Just fraction), Nothing) =>
|
||||||
|
"\{integer}.\{fraction}"
|
||||||
|
((Just fraction), (Just exponent)) =>
|
||||||
|
"\{integer}.\{fraction}e\{exponent}"
|
||||||
|
Just out <- pure $ parseDouble str
|
||||||
|
| _ =>
|
||||||
|
throw $ MkParseError starting_state "Std failed to parse as double: \{str}"
|
||||||
|
pure out
|
||||||
|
where
|
||||||
|
parseDigit : Parser Char
|
||||||
|
parseDigit = do
|
||||||
|
GotChar char <- charPredicate (hasDigit base10)
|
||||||
|
| GotError e => throwParseError "\{show e} is not a digit"
|
||||||
|
| EndOfInput => throwParseError "End Of Input"
|
||||||
|
pure char
|
||||||
|
integer : Parser String
|
||||||
|
integer = do
|
||||||
|
sign <- tryMaybe $ charExact '-'
|
||||||
|
error <- replaceError "Expected digit"
|
||||||
|
digits <- map forget $ atLeastOne error parseDigit
|
||||||
|
case sign of
|
||||||
|
Nothing => pure $ pack digits
|
||||||
|
Just x => pure $ pack (x :: digits)
|
||||||
|
fraction : Parser String
|
||||||
|
fraction = do
|
||||||
|
decimal <- charExact '.'
|
||||||
|
error <- replaceError "Expected digit"
|
||||||
|
digits <- map forget $ atLeastOne error parseDigit
|
||||||
|
pure $ pack digits
|
||||||
|
exponent : Parser String
|
||||||
|
exponent = do
|
||||||
|
e <- theseChars ['e', 'E']
|
||||||
|
sign <- theseChars ['+', '-']
|
||||||
|
error <- replaceError "Expected digit"
|
||||||
|
digits <- map forget $ atLeastOne error parseDigit
|
||||||
|
pure . pack $ sign :: digits
|
||||||
|
```
|
||||||
|
|
||||||
|
## Unit tests
|
||||||
|
|
||||||
|
Test roundtripping a value through the provided parser
|
||||||
|
|
||||||
|
```idris
|
||||||
|
roundtrip : Eq a => Show a => a -> (p : Parser a) -> IO Bool
|
||||||
|
roundtrip x p = do
|
||||||
|
let string = show x
|
||||||
|
putStrLn "Roundtripping \{string}"
|
||||||
|
Just state <- newInternalIO string
|
||||||
|
| _ => do
|
||||||
|
putStrLn "Failed to produce parser for \{string}"
|
||||||
|
pure False
|
||||||
|
Right result <- runEff (rundownFirst p) [handleParserStateIO state] {m = IO}
|
||||||
|
| Left err => do
|
||||||
|
printLn err
|
||||||
|
pure False
|
||||||
|
putStrLn "Input: \{string} Output: \{show result}"
|
||||||
|
pure $ x == result
|
||||||
|
```
|
||||||
|
|
||||||
|
Do some roundtrip tests with the nat parser
|
||||||
|
|
||||||
|
```idris
|
||||||
|
-- @@test Nat round trip
|
||||||
|
natRoundTrip : IO Bool
|
||||||
|
natRoundTrip = pure $
|
||||||
|
!(roundtrip 0 natBase10)
|
||||||
|
&& !(roundtrip 1 natBase10)
|
||||||
|
&& !(roundtrip 100 natBase10)
|
||||||
|
&& !(roundtrip 1234 natBase10)
|
||||||
|
&& !(roundtrip 1234567890 natBase10)
|
||||||
|
&& !(roundtrip 1234567890000 natBase10)
|
||||||
|
&& !(roundtrip 12345678901234567890 natBase10)
|
||||||
|
```
|
||||||
|
|
||||||
|
```idris
|
||||||
|
-- @@test Integer round trip
|
||||||
|
integerRoundTrip : IO Bool
|
||||||
|
integerRoundTrip = pure $
|
||||||
|
!(roundtrip 0 integerBase10)
|
||||||
|
&& !(roundtrip 1 integerBase10)
|
||||||
|
&& !(roundtrip 100 integerBase10)
|
||||||
|
&& !(roundtrip 1234 integerBase10)
|
||||||
|
&& !(roundtrip 1234567890 integerBase10)
|
||||||
|
&& !(roundtrip 1234567890000 integerBase10)
|
||||||
|
&& !(roundtrip 12345678901234567890 integerBase10)
|
||||||
|
&& !(roundtrip (-1) integerBase10)
|
||||||
|
&& !(roundtrip (-100) integerBase10)
|
||||||
|
&& !(roundtrip (-1234) integerBase10)
|
||||||
|
&& !(roundtrip (-1234567890) integerBase10)
|
||||||
|
&& !(roundtrip (-1234567890000) integerBase10)
|
||||||
|
&& !(roundtrip (-12345678901234567890) integerBase10)
|
||||||
|
```
|
||||||
|
|
||||||
|
Compare our parsing of a double to the standard library's
|
||||||
|
|
||||||
|
```idris
|
||||||
|
compareDouble : String -> IO Bool
|
||||||
|
compareDouble string = do
|
||||||
|
Just state <- newInternalIO string
|
||||||
|
| _ => do
|
||||||
|
putStrLn "Failed to produce parser for \{string}"
|
||||||
|
pure False
|
||||||
|
Right result <-
|
||||||
|
runEff (rundownFirst double) [handleParserStateIO state] {m = IO}
|
||||||
|
| Left err => do
|
||||||
|
printLn err
|
||||||
|
pure False
|
||||||
|
putStrLn "Input: \{string} Output: \{show result}"
|
||||||
|
Just double' <- pure $ parseDouble string
|
||||||
|
| _ => do
|
||||||
|
printLn "Std failed to parse as double: \{string}"
|
||||||
|
pure False
|
||||||
|
pure $ result == double'
|
||||||
|
```
|
||||||
|
|
||||||
|
```idris
|
||||||
|
-- @@test Double Std Comparison
|
||||||
|
doubleRoundTrip : IO Bool
|
||||||
|
doubleRoundTrip = pure $
|
||||||
|
!(compareDouble "0")
|
||||||
|
&& !(compareDouble "1")
|
||||||
|
&& !(compareDouble "100")
|
||||||
|
&& !(compareDouble "1234")
|
||||||
|
&& !(compareDouble "1234567890")
|
||||||
|
&& !(compareDouble "1234567890000")
|
||||||
|
&& !(compareDouble "12345678901234567890")
|
||||||
|
&& !(compareDouble "-1")
|
||||||
|
&& !(compareDouble "-100")
|
||||||
|
&& !(compareDouble "-1234")
|
||||||
|
&& !(compareDouble "-1234567890")
|
||||||
|
&& !(compareDouble "-1234567890000")
|
||||||
|
&& !(compareDouble "-12345678901234567890")
|
||||||
|
&& !(compareDouble "0.0")
|
||||||
|
&& !(compareDouble "1.0")
|
||||||
|
&& !(compareDouble "-1.0")
|
||||||
|
&& !(compareDouble "-0.0")
|
||||||
|
&& !(compareDouble "-0.0")
|
||||||
|
&& !(compareDouble "0.1234")
|
||||||
|
&& !(compareDouble "0.01234")
|
||||||
|
&& !(compareDouble "-0.1234")
|
||||||
|
&& !(compareDouble "-0.01234")
|
||||||
|
&& !(compareDouble "1.234e+5")
|
||||||
|
&& !(compareDouble "1.234e-5")
|
||||||
|
&& !(compareDouble "-1.234e+5")
|
||||||
|
&& !(compareDouble "-1.234e-5")
|
||||||
|
```
|
369
src/Parser/ParserState.md
Normal file
369
src/Parser/ParserState.md
Normal file
|
@ -0,0 +1,369 @@
|
||||||
|
# Parser State
|
||||||
|
|
||||||
|
An effectful description of the text a parser consumes
|
||||||
|
|
||||||
|
```idris
|
||||||
|
module Parser.ParserState
|
||||||
|
|
||||||
|
import public Data.String
|
||||||
|
import public Data.DPair
|
||||||
|
import public Data.Refined
|
||||||
|
import public Data.Refined.Int64
|
||||||
|
import public Data.SortedMap
|
||||||
|
import public Data.IORef
|
||||||
|
|
||||||
|
import Data.Primitives.Interpolation
|
||||||
|
import System.File
|
||||||
|
|
||||||
|
import public Control.Eff
|
||||||
|
```
|
||||||
|
|
||||||
|
## Barbie Basics
|
||||||
|
|
||||||
|
Barbies are types that can "change their clothes", in Idris, this manifests as a
|
||||||
|
type indexed by a type-level function that affects the types of the fields.
|
||||||
|
|
||||||
|
Since we know our usage here is going to be quite simple, and not even really
|
||||||
|
making use of dependently typed fun, we are going to implement all the barbie
|
||||||
|
functionality we need by hand, but if you feel like barbies might be a good fit
|
||||||
|
for your problem, or you simply want to learn more, please check out a library
|
||||||
|
like `barbies`[^1]
|
||||||
|
|
||||||
|
```idris
|
||||||
|
public export
|
||||||
|
Id : Type -> Type
|
||||||
|
Id x = x
|
||||||
|
```
|
||||||
|
|
||||||
|
## Internal State of a Parser
|
||||||
|
|
||||||
|
Type alias for our refined `Int64`s
|
||||||
|
|
||||||
|
```idris
|
||||||
|
public export
|
||||||
|
0 IsIndex : (length : Int64) -> Int64 -> Type
|
||||||
|
IsIndex length = From 0 && LessThan length
|
||||||
|
|
||||||
|
public export
|
||||||
|
record Index (length : Int64) where
|
||||||
|
constructor MkIndex
|
||||||
|
index : Int64
|
||||||
|
{auto 0 prf : IsIndex length index}
|
||||||
|
```
|
||||||
|
|
||||||
|
```idris hide
|
||||||
|
export
|
||||||
|
Eq (Index i) where
|
||||||
|
x == y = x.index == y.index
|
||||||
|
|
||||||
|
export
|
||||||
|
Ord (Index i) where
|
||||||
|
compare x y = compare x.index y.index
|
||||||
|
|
||||||
|
export
|
||||||
|
Show (Index i) where
|
||||||
|
show (MkIndex index) = show index
|
||||||
|
```
|
||||||
|
|
||||||
|
Stores the location we are currently at in the string, and metadata about it for
|
||||||
|
providing good error messages. Parsing an empty input isn't very interesting, so
|
||||||
|
we exclude inputs of length zero, since that will make other things easier.
|
||||||
|
|
||||||
|
```idris
|
||||||
|
||| State representing a parser's position in the text
|
||||||
|
public export
|
||||||
|
record ParserInternal (f : Type -> Type) where
|
||||||
|
constructor MkInternal
|
||||||
|
-- IDEA: Maybe go full barbie and have this be a field, so that we can, say,
|
||||||
|
-- read directly from a file instead of from an already loaded string using the
|
||||||
|
-- same parser
|
||||||
|
||| The input string
|
||||||
|
input : String
|
||||||
|
||| The length of the input string
|
||||||
|
length : Int64
|
||||||
|
{auto 0 len_prf : length = cast (strLength input)}
|
||||||
|
||| A sorted set containing the positions of the start of each line
|
||||||
|
line_starts : SortedMap (Index length) Nat
|
||||||
|
||| The position of the next character to read in the input
|
||||||
|
position : f (Index length)
|
||||||
|
||| True if we have hit the end of input
|
||||||
|
end_of_input : f Bool
|
||||||
|
%name ParserInternal pi, pj, pk
|
||||||
|
```
|
||||||
|
|
||||||
|
### ParserInternal Methods
|
||||||
|
|
||||||
|
Construct a `ParserInternal` from an input string. Will fail if the input is
|
||||||
|
empty, because then we can't index it.
|
||||||
|
|
||||||
|
```idris
|
||||||
|
export
|
||||||
|
newInternal : (input : String) -> Maybe (ParserInternal Id)
|
||||||
|
newInternal input =
|
||||||
|
-- Check if we have at least one character in the input
|
||||||
|
case refine0 0 {p = IsIndex (cast (strLength input))} of
|
||||||
|
Nothing => Nothing
|
||||||
|
Just (Element position _) => Just $
|
||||||
|
MkInternal input
|
||||||
|
(cast (strLength input))
|
||||||
|
(mkStarts' input (MkIndex position))
|
||||||
|
(MkIndex position)
|
||||||
|
False
|
||||||
|
where
|
||||||
|
partial
|
||||||
|
mkStarts :
|
||||||
|
(str : String) -> (acc : List (Index (cast (strLength str)), Nat))
|
||||||
|
-> (idx : Index (cast (strLength str))) -> (count : Nat) -> (next : Bool)
|
||||||
|
-> List (Index (cast (strLength str)), Nat)
|
||||||
|
mkStarts str acc idx count True =
|
||||||
|
mkStarts str ((idx, count) :: acc) idx (S count) False
|
||||||
|
mkStarts str acc idx count False =
|
||||||
|
case refine0 (idx.index + 1) {p = IsIndex (cast (strLength str))} of
|
||||||
|
Nothing => acc
|
||||||
|
Just (Element next _) =>
|
||||||
|
if strIndex str (cast idx.index) == '\n'
|
||||||
|
then mkStarts str acc (MkIndex next) count True
|
||||||
|
else mkStarts str acc (MkIndex next) count False
|
||||||
|
mkStarts' : (str : String) -> (start : Index (cast (strLength str)))
|
||||||
|
-> SortedMap (Index (cast (strLength str))) Nat
|
||||||
|
mkStarts' str start =
|
||||||
|
let
|
||||||
|
pairs = assert_total $
|
||||||
|
mkStarts str [] start 0 True
|
||||||
|
in fromList pairs
|
||||||
|
```
|
||||||
|
|
||||||
|
Get the current line and column number
|
||||||
|
|
||||||
|
```idris
|
||||||
|
||| Returns the current position of the parser cursor in, zero indexed, (line,
|
||||||
|
||| column) form
|
||||||
|
export
|
||||||
|
positionPair : (pi : ParserInternal Id) -> (Nat, Nat)
|
||||||
|
positionPair pi =
|
||||||
|
case lookup pi.position pi.line_starts of
|
||||||
|
Just line => (line, 0)
|
||||||
|
Nothing =>
|
||||||
|
case lookupBetween pi.position pi.line_starts of
|
||||||
|
-- There will always be at least one line start, and we would have hit
|
||||||
|
-- the previous case if we were at the start of the first one, so if
|
||||||
|
-- there isn't a before, we can return a nonsense value safely
|
||||||
|
(Nothing, _) => (0, 0)
|
||||||
|
(Just (start, linum), after) =>
|
||||||
|
-- Our index will always be after the start of the line, for previously
|
||||||
|
-- mentioned reasons, so this cast is safe
|
||||||
|
let col = cast {to = Nat} $ pi.position.index - start.index
|
||||||
|
in (linum, col)
|
||||||
|
```
|
||||||
|
|
||||||
|
```idris hide
|
||||||
|
export
|
||||||
|
Show (ParserInternal Id) where
|
||||||
|
show pi =
|
||||||
|
let (line, col) = positionPair pi
|
||||||
|
current = assert_total $ strIndex pi.input (cast pi.position.index)
|
||||||
|
pos = pi.position.index
|
||||||
|
eof = show pi.end_of_input
|
||||||
|
in "Position: \{pos}(\{line}, \{col}}) Value: \{show current} EoF: \{eof}"
|
||||||
|
```
|
||||||
|
|
||||||
|
### More Barbie Functionality
|
||||||
|
|
||||||
|
Provide the barbie analogs of `map` and `traverse` for our `ParserInternal`
|
||||||
|
type, allowing us to change the type the values in a `ParserInternal` by mapping
|
||||||
|
over those values.
|
||||||
|
|
||||||
|
```idris
|
||||||
|
export
|
||||||
|
bmap : ({0 a : Type} -> f a -> g a) -> ParserInternal f -> ParserInternal g
|
||||||
|
-- bmap f = bmap_ (\_ => f)
|
||||||
|
bmap fun (MkInternal input length line_starts position end_of_input) =
|
||||||
|
let position' = fun position
|
||||||
|
end_of_input' = fun end_of_input
|
||||||
|
in MkInternal input length line_starts position' end_of_input'
|
||||||
|
|
||||||
|
export
|
||||||
|
btraverse : Applicative e => ({0 a : Type} -> f a -> e (g a))
|
||||||
|
-> ParserInternal f -> e (ParserInternal g)
|
||||||
|
btraverse fun (MkInternal input length line_starts position end_of_input) =
|
||||||
|
let pures = (MkInternal input length line_starts)
|
||||||
|
in [| pures (fun position) (fun end_of_input)|]
|
||||||
|
```
|
||||||
|
|
||||||
|
## Three way result
|
||||||
|
|
||||||
|
```idris
|
||||||
|
||| Three way result returned from attempting to parse a single char
|
||||||
|
public export
|
||||||
|
data ParseCharResult : Type where
|
||||||
|
GotChar : (char : Char) -> ParseCharResult
|
||||||
|
GotError : (err : Char) -> ParseCharResult
|
||||||
|
EndOfInput : ParseCharResult
|
||||||
|
```
|
||||||
|
|
||||||
|
## The Effect Type
|
||||||
|
|
||||||
|
```idris
|
||||||
|
export
|
||||||
|
data ParserState : Type -> Type where
|
||||||
|
Save : ParserState (ParserInternal Id)
|
||||||
|
Load : (ParserInternal Id) -> ParserState ()
|
||||||
|
-- TODO: Maybe add a ParseString that parses a string of characters as a
|
||||||
|
-- string using efficent slicing?
|
||||||
|
ParseChar : (predicate : Char -> Bool) -> ParserState ParseCharResult
|
||||||
|
ParseExactChar : (char : Char) -> ParserState ParseCharResult
|
||||||
|
ParseEoF : ParserState Bool
|
||||||
|
Note : Lazy String -> ParserState ()
|
||||||
|
```
|
||||||
|
|
||||||
|
```idris hide
|
||||||
|
Show (ParserState t) where
|
||||||
|
show Save = "Saving state"
|
||||||
|
show (Load pi) = "Loading state \{show pi}"
|
||||||
|
show (ParseChar predicate) = "Parsing char"
|
||||||
|
show (ParseExactChar char) = "Parsing char \{show char}"
|
||||||
|
show ParseEoF = "Parsing EoF"
|
||||||
|
show (Note _) = "Note"
|
||||||
|
```
|
||||||
|
|
||||||
|
### Actions
|
||||||
|
|
||||||
|
```idris
|
||||||
|
||| Return the current state, for potential later reloading
|
||||||
|
export
|
||||||
|
save : Has ParserState fs => Eff fs (ParserInternal Id)
|
||||||
|
save = send Save
|
||||||
|
|
||||||
|
||| Reset to the provided state
|
||||||
|
export
|
||||||
|
load : Has ParserState fs => ParserInternal Id -> Eff fs ()
|
||||||
|
load pi = send $ Load pi
|
||||||
|
|
||||||
|
||| Attempt to parse a char, checking to see if it complies with the supplied
|
||||||
|
||| predicate, updates the state if parsing succeeds, does not alter it in an
|
||||||
|
||| error condition.
|
||||||
|
export
|
||||||
|
charPredicate : Has ParserState fs => (predicate : Char -> Bool)
|
||||||
|
-> Eff fs ParseCharResult
|
||||||
|
charPredicate predicate = send $ ParseChar predicate
|
||||||
|
|
||||||
|
||| Parse a char by exact value
|
||||||
|
export
|
||||||
|
charExact' : Has ParserState fs => (chr : Char) -> Eff fs ParseCharResult
|
||||||
|
charExact' chr = send $ ParseExactChar chr
|
||||||
|
|
||||||
|
||| "Parse" the end of input, returning `True` if the parser state is currently
|
||||||
|
||| at the end of the input
|
||||||
|
export
|
||||||
|
parseEoF : Has ParserState fs => Eff fs Bool
|
||||||
|
parseEoF = send ParseEoF
|
||||||
|
|
||||||
|
||| Make a note to be output when running with a debug handler
|
||||||
|
export
|
||||||
|
pnote : Has ParserState fs => Lazy String -> Eff fs ()
|
||||||
|
pnote x = send $ Note x
|
||||||
|
```
|
||||||
|
|
||||||
|
## Handling a ParserState
|
||||||
|
|
||||||
|
### IO Context
|
||||||
|
|
||||||
|
```idris
|
||||||
|
export
|
||||||
|
handleParserStateIO : HasIO io =>
|
||||||
|
IORef (ParserInternal IORef) -> ParserState t -> io t
|
||||||
|
handleParserStateIO pi Save = do
|
||||||
|
pi <- readIORef pi
|
||||||
|
btraverse readIORef pi
|
||||||
|
handleParserStateIO pi (Load pj) = do
|
||||||
|
pj <- btraverse newIORef pj
|
||||||
|
writeIORef pi pj
|
||||||
|
handleParserStateIO pi (ParseChar predicate) = do
|
||||||
|
pi <- readIORef pi
|
||||||
|
False <- readIORef pi.end_of_input
|
||||||
|
| _ => pure EndOfInput
|
||||||
|
position <- readIORef pi.position
|
||||||
|
let char = assert_total $ strIndex pi.input (cast position.index)
|
||||||
|
True <- pure $ predicate char
|
||||||
|
| _ => pure $ GotError char
|
||||||
|
-- Our refinement type on the position forces us to check that the length is
|
||||||
|
-- in bounds after incrementing it, if its out of bounds, set the end_of_input
|
||||||
|
-- flag
|
||||||
|
case refine0 (position.index + 1) {p = IsIndex pi.length} of
|
||||||
|
Nothing => do
|
||||||
|
writeIORef pi.end_of_input True
|
||||||
|
pure $ GotChar char
|
||||||
|
Just (Element next _) => do
|
||||||
|
writeIORef pi.position $ MkIndex next
|
||||||
|
pure $ GotChar char
|
||||||
|
handleParserStateIO pi (ParseExactChar chr) = do
|
||||||
|
-- TODO: do this directly?
|
||||||
|
handleParserStateIO pi (ParseChar (== chr))
|
||||||
|
handleParserStateIO pi ParseEoF = do
|
||||||
|
pi <- readIORef pi
|
||||||
|
readIORef pi.end_of_input
|
||||||
|
-- We ignore notes in non-debug mode
|
||||||
|
handleParserStateIO pi (Note _) = pure ()
|
||||||
|
|
||||||
|
export
|
||||||
|
newInternalIO : HasIO io => String -> io $ Maybe (IORef (ParserInternal IORef))
|
||||||
|
newInternalIO str = do
|
||||||
|
Just internal <- pure $ newInternal str
|
||||||
|
| _ => pure Nothing
|
||||||
|
internal <- btraverse newIORef internal
|
||||||
|
map Just $ newIORef internal
|
||||||
|
```
|
||||||
|
|
||||||
|
Wrapper with debugging output
|
||||||
|
|
||||||
|
```idris
|
||||||
|
export
|
||||||
|
handleParserStateIODebug : HasIO io =>
|
||||||
|
IORef (ParserInternal IORef) -> ParserState t -> io t
|
||||||
|
handleParserStateIODebug x (Note note) = do
|
||||||
|
state <- readIORef x
|
||||||
|
state <- btraverse readIORef state
|
||||||
|
_ <- fPutStrLn stderr "Note \{note} -> \{show state}"
|
||||||
|
pure ()
|
||||||
|
handleParserStateIODebug x y = do
|
||||||
|
state <- readIORef x
|
||||||
|
state <- btraverse readIORef state
|
||||||
|
_ <- fPutStrLn stderr "\{show y} -> \{show state}"
|
||||||
|
handleParserStateIO x y
|
||||||
|
```
|
||||||
|
|
||||||
|
### State context
|
||||||
|
|
||||||
|
```idris
|
||||||
|
unPS : ParserInternal Id -> ParserState a -> (a, ParserInternal Id)
|
||||||
|
unPS pi Save = (pi, pi)
|
||||||
|
unPS pi (Load pj) = ((), pi)
|
||||||
|
unPS pi (ParseChar predicate) =
|
||||||
|
if pi.end_of_input
|
||||||
|
then (EndOfInput, pi)
|
||||||
|
else let
|
||||||
|
char = assert_total $ strIndex pi.input (cast pi.position.index)
|
||||||
|
in if predicate char
|
||||||
|
then case refine0 (pi.position.index + 1) {p = IsIndex pi.length} of
|
||||||
|
Nothing =>
|
||||||
|
(GotChar char, {end_of_input := True} pi)
|
||||||
|
Just (Element next _) =>
|
||||||
|
(GotChar char, {position := MkIndex next} pi)
|
||||||
|
else (GotError char, pi)
|
||||||
|
unPS pi (ParseExactChar chr) = unPS pi (ParseChar (== chr))
|
||||||
|
unPS pi ParseEoF = (pi.end_of_input, pi)
|
||||||
|
unPS pi (Note _) = ((), pi)
|
||||||
|
|
||||||
|
export
|
||||||
|
runParserState : Has ParserState fs =>
|
||||||
|
(s : ParserInternal Id) -> Eff fs t
|
||||||
|
-> Eff (fs - ParserState) (t, ParserInternal Id)
|
||||||
|
runParserState s =
|
||||||
|
handleRelayS s (\x, y => pure (y, x)) $ \s2,ps,f =>
|
||||||
|
let (a, st) = unPS s2 ps
|
||||||
|
in f st a
|
||||||
|
```
|
||||||
|
|
||||||
|
## Footnotes
|
||||||
|
|
||||||
|
[^1]: <https://github.com/stefan-hoeck/idris2-barbies>
|
1
src/README.md
Symbolic link
1
src/README.md
Symbolic link
|
@ -0,0 +1 @@
|
||||||
|
../README.md
|
35
src/SUMMARY.md
Normal file
35
src/SUMMARY.md
Normal file
|
@ -0,0 +1,35 @@
|
||||||
|
# Summary
|
||||||
|
|
||||||
|
[README](README.md)
|
||||||
|
|
||||||
|
# Running the code
|
||||||
|
|
||||||
|
- [Runner - Divide Code Into Years and Days](Runner.md)
|
||||||
|
- [Main - Select a Day and Year to Run](Main.md)
|
||||||
|
|
||||||
|
# Utility Mini-Library
|
||||||
|
|
||||||
|
- [Util - Extend Standard Types](Util.md)
|
||||||
|
- [Util.Eff - Effects and Effect Accessories](Util/Eff.md)
|
||||||
|
- [Util.Digits - Pattern Matching Integers as Lists of Digits](Util/Eff.md)
|
||||||
|
- [Array - Arrays With Constant Time Indexing and Slicing](Array.md)
|
||||||
|
- [Parser - Recursive Descent Parsing, With Effects](Parser.md)
|
||||||
|
- [Interface - Core Parsing Functionality](Parser/Interface.md)
|
||||||
|
- [ParserState - Custom Effect for Parser Internal State](Parser/ParserState.md)
|
||||||
|
- [Numbers - Parsers for Numerical Values](Parser/Numbers.md)
|
||||||
|
- [JSON - A JSON Parser](Parser/JSON.md)
|
||||||
|
|
||||||
|
# Problems
|
||||||
|
|
||||||
|
- [2015](Years/Y2015.md)
|
||||||
|
- [Day 1 - Warmup](Years/Y2015/Day1.md)
|
||||||
|
- [Day 2 - Early Effectful Parsing](Years/Y2015/Day2.md)
|
||||||
|
- [Day 3 - Mutually Recursive Functions](Years/Y2015/Day3.md)
|
||||||
|
- [Day 4 - Basic FFI](Years/Y2015/Day4.md)
|
||||||
|
- [Day 5 - Views and Dependent Pattern Matching](Years/Y2015/Day5.md)
|
||||||
|
- [Day 6 - Naive 2D Grid](Years/Y2015/Day6.md)
|
||||||
|
- [Day 7 - Dependent Maps and Indexed Type Familes](Years/Y2015/Day7.md)
|
||||||
|
- [Day 8 - Proper Effectful Parsers](Years/Y2015/Day8.md)
|
||||||
|
- [Day 9 - Naive Graph Traversal](Years/Y2015/Day9.md)
|
||||||
|
- [Day 10 - Digits View](Years/Y2015/Day10.md)
|
||||||
|
- [Day 11 - Refinement Types](Years/Y2015/Day11.md)
|
20
src/Util.md
20
src/Util.md
|
@ -29,9 +29,9 @@ repeatN (S times') f seed = repeatN times' f (f seed)
|
||||||
|
|
||||||
## Either
|
## Either
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
namespace Either
|
namespace Either
|
||||||
-->
|
```
|
||||||
|
|
||||||
### mapLeft
|
### mapLeft
|
||||||
|
|
||||||
|
@ -47,9 +47,9 @@ Applies a function to the contents of a `Left` if the value of the given
|
||||||
|
|
||||||
## List
|
## List
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
namespace List
|
namespace List
|
||||||
-->
|
```
|
||||||
|
|
||||||
### contains
|
### contains
|
||||||
|
|
||||||
|
@ -94,12 +94,12 @@ Define some operations for pairs of numbers, treating them roughly like vectors
|
||||||
|
|
||||||
### Addition and Subtraction
|
### Addition and Subtraction
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
export infixl 8 >+<
|
export infixl 8 >+<
|
||||||
export infixl 8 >-<
|
export infixl 8 >-<
|
||||||
|
|
||||||
namespace Pair
|
namespace Pair
|
||||||
-->
|
```
|
||||||
|
|
||||||
```idris
|
```idris
|
||||||
public export
|
public export
|
||||||
|
@ -115,9 +115,9 @@ namespace Pair
|
||||||
|
|
||||||
Extend `Data.SortedSet`
|
Extend `Data.SortedSet`
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
namespace Set
|
namespace Set
|
||||||
-->
|
```
|
||||||
|
|
||||||
### length
|
### length
|
||||||
|
|
||||||
|
@ -133,9 +133,9 @@ Count the number of elements in a sorted set
|
||||||
|
|
||||||
Extend `Data.String`
|
Extend `Data.String`
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
namespace String
|
namespace String
|
||||||
-->
|
```
|
||||||
|
|
||||||
### isSubstr
|
### isSubstr
|
||||||
|
|
||||||
|
|
|
@ -6,11 +6,11 @@ module Util.Digits
|
||||||
import Data.Monoid.Exponentiation
|
import Data.Monoid.Exponentiation
|
||||||
```
|
```
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
import System
|
import System
|
||||||
|
|
||||||
%default total
|
%default total
|
||||||
-->
|
```
|
||||||
|
|
||||||
This module provides views and associated functionality for treating `Integers`
|
This module provides views and associated functionality for treating `Integers`
|
||||||
as if they were lists of numbers.
|
as if they were lists of numbers.
|
||||||
|
@ -22,10 +22,10 @@ teaching purposes, we'll do it here, but please consider a library like
|
||||||
[prim](https://github.com/stefan-hoeck/idris2-prim) if you find yourself needing
|
[prim](https://github.com/stefan-hoeck/idris2-prim) if you find yourself needing
|
||||||
to prove properties about primitive types.
|
to prove properties about primitive types.
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
-- This mutual block isn't strictly required, but is useful for literate purposes
|
-- This mutual block isn't strictly required, but is useful for literate purposes
|
||||||
mutual
|
mutual
|
||||||
-->
|
```
|
||||||
|
|
||||||
## Primitive functionality
|
## Primitive functionality
|
||||||
|
|
||||||
|
@ -50,14 +50,14 @@ most significant digit.
|
||||||
|
|
||||||
For a clarifying example:
|
For a clarifying example:
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
-- @@test Ascending Digits Example
|
-- @@test Ascending Digits Example
|
||||||
ascendingExample : IO Bool
|
ascendingExample : IO Bool
|
||||||
ascendingExample = do
|
ascendingExample = do
|
||||||
putStrLn "Expecting: \{show [5, 4, 3, 2, 1]}"
|
putStrLn "Expecting: \{show [5, 4, 3, 2, 1]}"
|
||||||
putStrLn "Got: \{show . ascList $ ascending 12345}"
|
putStrLn "Got: \{show . ascList $ ascending 12345}"
|
||||||
pure $
|
pure $
|
||||||
-->
|
```
|
||||||
|
|
||||||
```idris
|
```idris
|
||||||
ascList (ascending 12345) == [5, 4, 3, 2, 1]
|
ascList (ascending 12345) == [5, 4, 3, 2, 1]
|
||||||
|
@ -121,14 +121,14 @@ least significant digit.
|
||||||
|
|
||||||
For a clarifying example:
|
For a clarifying example:
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
-- @@test Descending Digits Example
|
-- @@test Descending Digits Example
|
||||||
descendingExample : IO Bool
|
descendingExample : IO Bool
|
||||||
descendingExample = do
|
descendingExample = do
|
||||||
putStrLn "Expecting: \{show [1, 2, 3, 4, 5]}"
|
putStrLn "Expecting: \{show [1, 2, 3, 4, 5]}"
|
||||||
putStrLn "Got: \{show . decList $ descending 12345}"
|
putStrLn "Got: \{show . decList $ descending 12345}"
|
||||||
pure $
|
pure $
|
||||||
-->
|
```
|
||||||
|
|
||||||
```idris
|
```idris
|
||||||
decList (descending 12345) == [1, 2, 3, 4, 5]
|
decList (descending 12345) == [1, 2, 3, 4, 5]
|
||||||
|
|
|
@ -36,7 +36,7 @@ data Level : Type where
|
||||||
Other : (n : Nat) -> {auto _ : n `GT` 4} -> Level
|
Other : (n : Nat) -> {auto _ : n `GT` 4} -> Level
|
||||||
```
|
```
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
export
|
export
|
||||||
levelToNat : Level -> Nat
|
levelToNat : Level -> Nat
|
||||||
levelToNat Err = 0
|
levelToNat Err = 0
|
||||||
|
@ -67,7 +67,7 @@ export infixl 8 >+
|
||||||
export
|
export
|
||||||
(>+) : Level -> Nat -> Level
|
(>+) : Level -> Nat -> Level
|
||||||
(>+) x k = natToLevel (k + levelToNat x)
|
(>+) x k = natToLevel (k + levelToNat x)
|
||||||
-->
|
```
|
||||||
|
|
||||||
Convert a `Level` into a colorized tag
|
Convert a `Level` into a colorized tag
|
||||||
|
|
||||||
|
|
|
@ -6,7 +6,7 @@ import Structures.Dependent.FreshList
|
||||||
import Runner
|
import Runner
|
||||||
```
|
```
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
import Years.Y2015.Day1
|
import Years.Y2015.Day1
|
||||||
import Years.Y2015.Day2
|
import Years.Y2015.Day2
|
||||||
import Years.Y2015.Day3
|
import Years.Y2015.Day3
|
||||||
|
@ -18,7 +18,7 @@ import Years.Y2015.Day8
|
||||||
import Years.Y2015.Day9
|
import Years.Y2015.Day9
|
||||||
import Years.Y2015.Day10
|
import Years.Y2015.Day10
|
||||||
import Years.Y2015.Day11
|
import Years.Y2015.Day11
|
||||||
-->
|
```
|
||||||
|
|
||||||
# Days
|
# Days
|
||||||
|
|
||||||
|
|
|
@ -3,7 +3,7 @@
|
||||||
Pretty simple, basic warmup problem, nothing really novel is on display here
|
Pretty simple, basic warmup problem, nothing really novel is on display here
|
||||||
except the effectful part computations.
|
except the effectful part computations.
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
module Years.Y2015.Day1
|
module Years.Y2015.Day1
|
||||||
|
|
||||||
import Control.Eff
|
import Control.Eff
|
||||||
|
@ -11,7 +11,7 @@ import Control.Eff
|
||||||
import Runner
|
import Runner
|
||||||
|
|
||||||
%default total
|
%default total
|
||||||
-->
|
```
|
||||||
|
|
||||||
## Solver Functions
|
## Solver Functions
|
||||||
|
|
||||||
|
@ -76,8 +76,8 @@ part2 x = do
|
||||||
pure $ findBasement 1 0 input
|
pure $ findBasement 1 0 input
|
||||||
```
|
```
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
public export
|
public export
|
||||||
day1 : Day
|
day1 : Day
|
||||||
day1 = Both 1 part1 part2
|
day1 = Both 1 part1 part2
|
||||||
-->
|
```
|
||||||
|
|
|
@ -3,13 +3,13 @@
|
||||||
This day doesn't really add anything new, but we will show off our new views for
|
This day doesn't really add anything new, but we will show off our new views for
|
||||||
viewing integers as lists of digits.
|
viewing integers as lists of digits.
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
module Years.Y2015.Day10
|
module Years.Y2015.Day10
|
||||||
|
|
||||||
import Control.Eff
|
import Control.Eff
|
||||||
|
|
||||||
import Runner
|
import Runner
|
||||||
-->
|
```
|
||||||
|
|
||||||
```idris
|
```idris
|
||||||
import Data.String
|
import Data.String
|
||||||
|
@ -22,9 +22,9 @@ import Util
|
||||||
import Util.Digits
|
import Util.Digits
|
||||||
```
|
```
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
%default total
|
%default total
|
||||||
-->
|
```
|
||||||
|
|
||||||
# Solver Functions
|
# Solver Functions
|
||||||
|
|
||||||
|
@ -118,8 +118,8 @@ part2 digits = do
|
||||||
pure $ count (const True) output
|
pure $ count (const True) output
|
||||||
```
|
```
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
public export
|
public export
|
||||||
day10 : Day
|
day10 : Day
|
||||||
day10 = Both 10 part1 part2
|
day10 = Both 10 part1 part2
|
||||||
-->
|
```
|
||||||
|
|
|
@ -10,13 +10,13 @@ implement the one we need for today's task as a throw away data structure just
|
||||||
for this module, we will be using the `refined`[^1] library's implementation for
|
for this module, we will be using the `refined`[^1] library's implementation for
|
||||||
the sake of getting on with it.
|
the sake of getting on with it.
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
module Years.Y2015.Day11
|
module Years.Y2015.Day11
|
||||||
|
|
||||||
import Control.Eff
|
import Control.Eff
|
||||||
|
|
||||||
import Runner
|
import Runner
|
||||||
-->
|
```
|
||||||
|
|
||||||
```idris
|
```idris
|
||||||
import Data.Vect
|
import Data.Vect
|
||||||
|
@ -55,13 +55,13 @@ record PasswordChar where
|
||||||
%name PasswordChar pc
|
%name PasswordChar pc
|
||||||
```
|
```
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
Show PasswordChar where
|
Show PasswordChar where
|
||||||
show (MkPC char) = singleton char
|
show (MkPC char) = singleton char
|
||||||
|
|
||||||
Eq PasswordChar where
|
Eq PasswordChar where
|
||||||
x == y = x.char == y.char
|
x == y = x.char == y.char
|
||||||
-->
|
```
|
||||||
|
|
||||||
A function to fallible convert `Char`s into refined `PasswordChar`s, this will
|
A function to fallible convert `Char`s into refined `PasswordChar`s, this will
|
||||||
return `Just` if the `Char` satisfies the predicate, and `Nothing` otherwise,
|
return `Just` if the `Char` satisfies the predicate, and `Nothing` otherwise,
|
||||||
|
@ -227,12 +227,12 @@ part2 password = do
|
||||||
pure $ passwordToString next_password
|
pure $ passwordToString next_password
|
||||||
```
|
```
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
public export
|
public export
|
||||||
day11 : Day
|
day11 : Day
|
||||||
day11 = Both 11 part1 part2
|
day11 = Both 11 part1 part2
|
||||||
-->
|
```
|
||||||
|
|
||||||
## References
|
## References
|
||||||
|
|
||||||
[^1]: https://github.com/stefan-hoeck/idris2-refined/
|
[^1]: <https://github.com/stefan-hoeck/idris2-refined/>
|
||||||
|
|
|
@ -2,13 +2,13 @@
|
||||||
|
|
||||||
This day provides us our first little taste of effectful parsing
|
This day provides us our first little taste of effectful parsing
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
module Years.Y2015.Day2
|
module Years.Y2015.Day2
|
||||||
|
|
||||||
import Control.Eff
|
import Control.Eff
|
||||||
|
|
||||||
import Runner
|
import Runner
|
||||||
-->
|
```
|
||||||
|
|
||||||
```idris
|
```idris
|
||||||
import Data.List
|
import Data.List
|
||||||
|
@ -16,9 +16,9 @@ import Data.List1
|
||||||
import Data.String
|
import Data.String
|
||||||
```
|
```
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
%default total
|
%default total
|
||||||
-->
|
```
|
||||||
|
|
||||||
## Box structure
|
## Box structure
|
||||||
|
|
||||||
|
@ -130,8 +130,8 @@ part2 : (boxes : List Box) -> Eff (PartEff String) Integer
|
||||||
part2 boxes = pure . sum . map totalRibbon $ boxes
|
part2 boxes = pure . sum . map totalRibbon $ boxes
|
||||||
```
|
```
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
public export
|
public export
|
||||||
day2 : Day
|
day2 : Day
|
||||||
day2 = Both 2 part1 part2
|
day2 = Both 2 part1 part2
|
||||||
-->
|
```
|
||||||
|
|
|
@ -3,13 +3,13 @@
|
||||||
This day provides a gentle introduction to `mutual` blocks and mutually
|
This day provides a gentle introduction to `mutual` blocks and mutually
|
||||||
recursive functions.
|
recursive functions.
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
module Years.Y2015.Day3
|
module Years.Y2015.Day3
|
||||||
|
|
||||||
import Control.Eff
|
import Control.Eff
|
||||||
|
|
||||||
import Runner
|
import Runner
|
||||||
-->
|
```
|
||||||
|
|
||||||
```idris
|
```idris
|
||||||
import Data.SortedSet
|
import Data.SortedSet
|
||||||
|
@ -18,9 +18,9 @@ import Data.String
|
||||||
import Util
|
import Util
|
||||||
```
|
```
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
%default total
|
%default total
|
||||||
-->
|
```
|
||||||
|
|
||||||
## Parsing and data structures
|
## Parsing and data structures
|
||||||
|
|
||||||
|
@ -152,8 +152,8 @@ part2 movements = do
|
||||||
pure . length $ locations
|
pure . length $ locations
|
||||||
```
|
```
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
public export
|
public export
|
||||||
day3 : Day
|
day3 : Day
|
||||||
day3 = Both 3 part1 part2
|
day3 = Both 3 part1 part2
|
||||||
-->
|
```
|
||||||
|
|
|
@ -3,13 +3,13 @@
|
||||||
This day introduces us to a little bit of FFI, linking to openssl to use it's
|
This day introduces us to a little bit of FFI, linking to openssl to use it's
|
||||||
`MD5` functionality.
|
`MD5` functionality.
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
module Years.Y2015.Day4
|
module Years.Y2015.Day4
|
||||||
|
|
||||||
import Control.Eff
|
import Control.Eff
|
||||||
|
|
||||||
import Runner
|
import Runner
|
||||||
-->
|
```
|
||||||
|
|
||||||
```idris
|
```idris
|
||||||
import Data.String
|
import Data.String
|
||||||
|
@ -196,8 +196,8 @@ part2 seed = do
|
||||||
pure number
|
pure number
|
||||||
```
|
```
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
public export
|
public export
|
||||||
day4 : Day
|
day4 : Day
|
||||||
day4 = Both 4 part1 part2
|
day4 = Both 4 part1 part2
|
||||||
-->
|
```
|
||||||
|
|
|
@ -6,13 +6,13 @@ specifically `String`'s
|
||||||
[`AsList`](https://www.idris-lang.org/docs/idris2/current/base_docs/docs/Data.String.html#Data.String.AsList)
|
[`AsList`](https://www.idris-lang.org/docs/idris2/current/base_docs/docs/Data.String.html#Data.String.AsList)
|
||||||
view, which lets us treat `String`s as if they were lazy lists or iterators.
|
view, which lets us treat `String`s as if they were lazy lists or iterators.
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
module Years.Y2015.Day5
|
module Years.Y2015.Day5
|
||||||
|
|
||||||
import Control.Eff
|
import Control.Eff
|
||||||
|
|
||||||
import Runner
|
import Runner
|
||||||
-->
|
```
|
||||||
|
|
||||||
```idris
|
```idris
|
||||||
import Data.String
|
import Data.String
|
||||||
|
@ -20,9 +20,9 @@ import Data.String
|
||||||
import Util
|
import Util
|
||||||
```
|
```
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
%default total
|
%default total
|
||||||
-->
|
```
|
||||||
|
|
||||||
## Nice Strings
|
## Nice Strings
|
||||||
|
|
||||||
|
@ -213,8 +213,8 @@ part2 _ = do
|
||||||
pure x
|
pure x
|
||||||
```
|
```
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
public export
|
public export
|
||||||
day5 : Day
|
day5 : Day
|
||||||
day5 = Both 5 part1 part2
|
day5 = Both 5 part1 part2
|
||||||
-->
|
```
|
||||||
|
|
|
@ -1,16 +1,14 @@
|
||||||
# \[Year 2015 Day 6\](https://adventofcode.com/2015/day/
|
# [Year 2015 Day 6](https://adventofcode.com/2015/day/6)
|
||||||
|
|
||||||
6.
|
|
||||||
|
|
||||||
Introduction to the advent of code classic 2d grid problem.
|
Introduction to the advent of code classic 2d grid problem.
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
module Years.Y2015.Day6
|
module Years.Y2015.Day6
|
||||||
|
|
||||||
import Control.Eff
|
import Control.Eff
|
||||||
|
|
||||||
import Runner
|
import Runner
|
||||||
-->
|
```
|
||||||
|
|
||||||
```idris
|
```idris
|
||||||
import Util
|
import Util
|
||||||
|
@ -23,9 +21,9 @@ import Data.String
|
||||||
import Data.IORef
|
import Data.IORef
|
||||||
```
|
```
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
%default total
|
%default total
|
||||||
-->
|
```
|
||||||
|
|
||||||
## Parsing and data structures
|
## Parsing and data structures
|
||||||
|
|
||||||
|
@ -77,12 +75,12 @@ The three types of action that can be performed on a light.
|
||||||
data Action = On | Off | Toggle
|
data Action = On | Off | Toggle
|
||||||
```
|
```
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
Show Action where
|
Show Action where
|
||||||
show On = "on"
|
show On = "on"
|
||||||
show Off = "off"
|
show Off = "off"
|
||||||
show Toggle = "toggle"
|
show Toggle = "toggle"
|
||||||
-->
|
```
|
||||||
|
|
||||||
The range of coordinates that a command affects
|
The range of coordinates that a command affects
|
||||||
|
|
||||||
|
@ -92,11 +90,11 @@ record Range (rows, cols : Nat) where
|
||||||
top_left, bottom_right : Coord rows cols
|
top_left, bottom_right : Coord rows cols
|
||||||
```
|
```
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
Show (Range rows cols) where
|
Show (Range rows cols) where
|
||||||
show (MkRange top_left bottom_right) =
|
show (MkRange top_left bottom_right) =
|
||||||
"\{show top_left} -> \{show bottom_right}"
|
"\{show top_left} -> \{show bottom_right}"
|
||||||
-->
|
```
|
||||||
|
|
||||||
Helper function to extract a range of values from our Grid.
|
Helper function to extract a range of values from our Grid.
|
||||||
|
|
||||||
|
@ -121,11 +119,11 @@ record Command (rows, cols : Nat) where
|
||||||
range : Range rows cols
|
range : Range rows cols
|
||||||
```
|
```
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
Show (Command rows cols) where
|
Show (Command rows cols) where
|
||||||
show (MkCmd action range) =
|
show (MkCmd action range) =
|
||||||
"{\{show action}: \{show range}}"
|
"{\{show action}: \{show range}}"
|
||||||
-->
|
```
|
||||||
|
|
||||||
### Parsing
|
### Parsing
|
||||||
|
|
||||||
|
@ -336,8 +334,8 @@ part2 commands = do
|
||||||
pure brightness
|
pure brightness
|
||||||
```
|
```
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
public export
|
public export
|
||||||
day6 : Day
|
day6 : Day
|
||||||
day6 = Both 6 part1 part2
|
day6 = Both 6 part1 part2
|
||||||
-->
|
```
|
||||||
|
|
|
@ -1,6 +1,4 @@
|
||||||
# \[Year 2015 Day 7\](https://adventofcode.com/2015/day/
|
# [Year 2015 Day 7](https://adventofcode.com/2015/day/7)
|
||||||
|
|
||||||
7.
|
|
||||||
|
|
||||||
This day provides us a gentle introduction to dependent maps.
|
This day provides us a gentle introduction to dependent maps.
|
||||||
|
|
||||||
|
@ -15,13 +13,13 @@ Ensuring that the input contains only one gate outputting for each wire is done
|
||||||
through throwing a runtime error in the parsing function if a second gate
|
through throwing a runtime error in the parsing function if a second gate
|
||||||
outputting to a given wire is found in the input.
|
outputting to a given wire is found in the input.
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
module Years.Y2015.Day7
|
module Years.Y2015.Day7
|
||||||
|
|
||||||
import Control.Eff
|
import Control.Eff
|
||||||
|
|
||||||
import Runner
|
import Runner
|
||||||
-->
|
```
|
||||||
|
|
||||||
```idris
|
```idris
|
||||||
import Data.Bits
|
import Data.Bits
|
||||||
|
@ -33,9 +31,9 @@ import Data.SortedMap.Dependent
|
||||||
import Decidable.Equality
|
import Decidable.Equality
|
||||||
```
|
```
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
%default total
|
%default total
|
||||||
-->
|
```
|
||||||
|
|
||||||
## Parsing and data structures
|
## Parsing and data structures
|
||||||
|
|
||||||
|
@ -254,8 +252,8 @@ part2 (circut, value) = do
|
||||||
pure value
|
pure value
|
||||||
```
|
```
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
public export covering
|
public export covering
|
||||||
day7 : Day
|
day7 : Day
|
||||||
day7 = Both 7 part1 part2
|
day7 = Both 7 part1 part2
|
||||||
-->
|
```
|
||||||
|
|
|
@ -3,7 +3,7 @@
|
||||||
This day provides a more in depth introduction to writing effectful parsers,
|
This day provides a more in depth introduction to writing effectful parsers,
|
||||||
making use of state and non-determinism in our parsers.
|
making use of state and non-determinism in our parsers.
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
module Years.Y2015.Day8
|
module Years.Y2015.Day8
|
||||||
|
|
||||||
import Control.Eff
|
import Control.Eff
|
||||||
|
@ -11,7 +11,7 @@ import Control.Eff
|
||||||
import Data.Primitives.Interpolation
|
import Data.Primitives.Interpolation
|
||||||
|
|
||||||
import Runner
|
import Runner
|
||||||
-->
|
```
|
||||||
|
|
||||||
```idris
|
```idris
|
||||||
import Data.String
|
import Data.String
|
||||||
|
@ -344,8 +344,8 @@ part2 inputs = do
|
||||||
pure difference
|
pure difference
|
||||||
```
|
```
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
public export
|
public export
|
||||||
day8 : Day
|
day8 : Day
|
||||||
day8 = Both 8 part1 part2
|
day8 = Both 8 part1 part2
|
||||||
-->
|
```
|
||||||
|
|
|
@ -6,13 +6,13 @@ meeting the problem criteria, and then figure out the length in a separate step.
|
||||||
This isn't a particularly efficient solution, but its good enough for this small
|
This isn't a particularly efficient solution, but its good enough for this small
|
||||||
problem size.
|
problem size.
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
module Years.Y2015.Day9
|
module Years.Y2015.Day9
|
||||||
|
|
||||||
import Control.Eff
|
import Control.Eff
|
||||||
|
|
||||||
import Runner
|
import Runner
|
||||||
-->
|
```
|
||||||
|
|
||||||
```idris
|
```idris
|
||||||
import Data.String
|
import Data.String
|
||||||
|
@ -70,10 +70,10 @@ DistanceMap : Type
|
||||||
DistanceMap = SortedMap Location (List LP)
|
DistanceMap = SortedMap Location (List LP)
|
||||||
```
|
```
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
Show l => Show (LocationPair l) where
|
Show l => Show (LocationPair l) where
|
||||||
show (MkLP [x, y] distance) = "\{show x} <-> \{show y}: \{show distance}"
|
show (MkLP [x, y] distance) = "\{show x} <-> \{show y}: \{show distance}"
|
||||||
-->
|
```
|
||||||
|
|
||||||
Perform simple, pattern matching based parsing of a location pair.
|
Perform simple, pattern matching based parsing of a location pair.
|
||||||
|
|
||||||
|
@ -287,8 +287,8 @@ part2 (distance_map, pairs) = do
|
||||||
pure len
|
pure len
|
||||||
```
|
```
|
||||||
|
|
||||||
<!-- idris
|
```idris hide
|
||||||
public export
|
public export
|
||||||
day9 : Day
|
day9 : Day
|
||||||
day9 = Both 9 part1 part2
|
day9 = Both 9 part1 part2
|
||||||
-->
|
```
|
||||||
|
|
Loading…
Add table
Reference in a new issue