aoc

#! /usr/bin/env stack
-- stack --install-ghc runghc --package turtle

{-# LANGUAGE OverloadedStrings, ExistentialQuantification, Rank2Types #-}

import Utils hiding (Parser(..), fold)
import Prelude hiding (FilePath)
import Turtle
import Data.Bifoldable (bifold)
import Data.Time (toGregorian, utctDay)
import Data.Text (unpack, breakOnEnd)
import qualified Filesystem.Path.CurrentOS

fpathText :: FilePath -> Text
fpathText = bifold . Filesystem.Path.CurrentOS.toText

fpath :: Text -> FilePath
fpath = fromString . unpack

type Year = Int
type Day  = Int

type Puzzle = (FilePath, FilePath)
type PuzzleCommand = Puzzle -> (forall io. MonadIO io => io ())

parseOpts :: MonadIO io => Year -> Parser (io ())
parseOpts year
  =  newPuzzle
         <$> subcommand "new" "Make a new puzzle"  parsePuzzle
 <|> runPuzzle
         <$> subcommand "run" "Run puzzle in ghci" parsePuzzle
 <|> compilePuzzle
         <$> subcommand "compile" "Compile puzzle" parsePuzzle
  where
    yearDesc = fromString $ "The year (default: "++show year++")"
    parsePuzzle = puzzlePath year
                  <$> (optInt "year" 'y' yearDesc <|> pure year)
                  <*> argInt "day" "The day"

puzzlePath :: Year -> Year -> Day -> Puzzle
puzzlePath maxYr yr day
  | not $ 2015 <= yr  && yr  <= maxYr = error $ "Invalid year: " ++ show yr
  | not $ 1    <= day && day <= 25    = error $ "Invalid day: " ++ show day
  | otherwise =
    let dir  = fpath $ format (d%"/day"%d) yr day
        file = fpath $ format ("day"%d%".hs") day
    in (dir, file)

newPuzzle :: PuzzleCommand
newPuzzle (dir, file) = do
  session <- strict (input "session.txt")
  mkdir dir
  cp "boilerplate.hs" (dir</>file)
  cd dir
  let dir' = uncurry (<>) . fmap ("/"<>) . breakOnEnd "/day" . fpathText $ dir
      url  = format ("http://adventofcode.com/"%s%"/input") dir'
      curl = format ("curl --cookie \"" %s% "\" "%s) session url
  output "input.txt" (inshell curl mempty)

runPuzzle :: PuzzleCommand
runPuzzle (dir, file) = do
  cd dir
  stdout (inshell (format ("./"%fp) file) mempty)

compilePuzzle :: PuzzleCommand
compilePuzzle (dir, file) = do
  cd dir
  let ghc = format ("stack ghc  -- "%fp% " -rtsopts -O2 -i ../../Utils.hs -i ../../Zipper.hs") file
  stdout (inshell ghc mempty)

main :: IO ()
main = do
  (y,m,d) <- toGregorian . utctDay <$> date
  let y' = if m < 12 then y-1 else y -- not christmas yet!
  join $ options "Advent of Code" (parseOpts (fromIntegral y'))