geekingfrog/bot-aoc.cabal

## bot-aoc.cabal
name:                bot-aoc
version:             0.1.0.0
synopsis:            Simple project template from stack
description:         Please see README.md
homepage:            https://github.com/githubuser/bot-aoc#readme
license:             BSD3
license-file:        LICENSE
author:              Author name here
maintainer:          [email protected]
copyright:           2016 Author name here
category:            Web
build-type:          Simple
cabal-version:       >=1.10
extra-source-files:  README.md

executable bot-aoc
  hs-source-dirs:      src
  main-is:             Main.hs
  default-language:    Haskell2010
  build-depends:       base >= 4.7 && < 5
                     , req >= 0.1 && < 0.2
                     , text >= 1.2.2 && < 1.2.3
                     , bytestring >= 0.10.8 && < 0.10.11
                     , aeson >= 1.0.2 && < 1.0.3
                     , unordered-containers >= 0.2.7 && < 0.2.8
                     , data-default >= 0.7.1 && < 0.7.2
                     , datetime >= 0.3.1 && < 0.4
                     , time >= 1.6.0 && < 1.7
                     , hashable-time >= 0.2 && < 0.3
                     , hashable >= 1.2.4 && < 1.3

## main.hs
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RecordWildCards #-}

module Main where

import Control.Monad
import GHC.Generics
import Data.Text (Text, unpack, pack)
import Control.Exception (throwIO)
import Data.DateTime
import qualified Data.HashMap.Strict as Map
import Data.Aeson
import Data.Aeson.Types
import qualified Data.ByteString as BS
import Data.Monoid ((<>))
import Data.Maybe
import Data.Ord (comparing)
import Data.List (sortBy, foldl')
import Data.Hashable
import Data.Time.Clock (UTCTime)
import Data.Hashable.Time

import Network.HTTP.Req

-- number of point for the first one to solve a given puzzle
basePoint :: Int
basePoint = 10

instance MonadHttp IO where
    handleHttpException = throwIO

data Member = Member
    { lastStarTs :: !DateTime
    , mid :: !Text
    , starCount :: !Int
    , name :: !Text
    , stars :: Map.HashMap (Int, Int) (Maybe DateTime)
    } deriving (Generic, Show, Eq)

instance Hashable Member

main :: IO ()
main = do
    m <- BS.readFile "snapshot.json"
    let parsed = eitherDecodeStrict m >>= parseEither members
    case parsed of
        Left err -> error err
        Right ms -> do
            -- putStrLn $ "got " <> show (Prelude.length ms) <> " members"
            let total = totalPoints ms
            print $ fmap (\(m, p) -> name m <> " got " <> pack (show p)) total
            -- let d1 =
            --         fmap (\(m, Just ts) -> (name m, ts)) $
            --         filter (isJust . snd) $ fmap (\m -> (m, getStarTS 1 1 m)) ms
            -- print (sortBy (comparing snd) d1)

totalPoints :: [Member] -> [(Member, Int)]
totalPoints members =
    let
        initialPoints = Map.empty
        -- args = [(d, step) | d <- [1..25], step <- [1..2]]
        args = [(d, step) | d <- [7], step <- [1..2]]
    in
        Map.toList $ Data.List.foldl' (\acc (d, s) -> updatePoints d s members acc) Map.empty args

-- res <- req GET (http "localhost" /: "snapshot.json") NoReqBody jsonResponse (port 5000) -- :: IO (Map.HashMap Text Member)
-- print (responseBody res :: Value)
getStarTS :: Int -> Int -> [Member] -> [(Member, DateTime)]
getStarTS day problemNumber members =
    let
        mbTs = fmap (\m -> (m, join $ Map.lookup (day, problemNumber) (stars m))) members
        takeCompleted :: [(Member, Maybe DateTime)] -> [(Member, DateTime)]
        takeCompleted [] = []
        takeCompleted ((m, Nothing) : rest) = takeCompleted rest
        takeCompleted ((m, Just ts) : rest) = (m, ts) : takeCompleted rest
    in
        takeCompleted mbTs

updatePoints :: Int -> Int -> [Member] -> Map.HashMap Member Int -> Map.HashMap Member Int
updatePoints day problemNum members standings =
    let
        starsForDay = sortBy (comparing snd) (getStarTS 1 1 members)
        points = iterate (\x -> max (x-1) 0) basePoint
        updateMap = Map.fromList (zip (fmap fst starsForDay) points)
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RecordWildCards #-}

module Main where

import GHC.Generics
import Prelude hiding (readFile)
import Control.Monad (join)
import Data.Text (Text, unpack, pack)
import Data.DateTime (DateTime)
import qualified Data.HashMap.Strict as Map
import Data.ByteString (readFile)
import Data.Monoid ((<>))
import Data.Ord (comparing, Down(..))
import Data.List (sortBy, foldl')
import Data.Hashable (Hashable)
-- because UTCTime has no Hashable instance by default, need to get import that
import Data.Hashable.Time ()

import Data.Aeson
import Data.Aeson.Types

points :: [Int]
points = 25 : 18 : 15 : 12 : 10 : 8 : 6 : 4 : 2 : 1 : repeat 0

data Member = Member
    { lastStarTs :: !DateTime
    , mid :: !Text
    , starCount :: !Int
    , name :: !Text
    , stars :: Map.HashMap (Int, Int) (Maybe DateTime)
    } deriving (Generic, Show, Eq)

instance Hashable Member

main :: IO ()
main = do
    raw <- readFile "snapshot.json"
    let parsed = eitherDecodeStrict raw >>= parseEither memberList
    case parsed of
        Left err -> error err
        Right ms -> do
            let total = totalPoints ms
            let sortedTotal = sortBy (comparing (Down . snd)) total
            print $ fmap (\(m, p) -> name m <> " got " <> pack (show p)) sortedTotal

totalPoints :: [Member] -> [(Member, Int)]
totalPoints members =
    let initialPoints = Map.empty
        args =
            [ (d, step)
            | d <- [1 .. 25]
            , step <- [1 .. 2] ]
    in Map.toList $ foldl' (\acc (d, s) -> updatePoints d s members acc) initialPoints args

getStarTS :: Int -> Int -> [Member] -> [(Member, DateTime)]
getStarTS day problemNumber members =
    let mbTs = fmap (\m -> (m, join $ Map.lookup (day, problemNumber) (stars m))) members
        takeCompleted :: [(Member, Maybe DateTime)] -> [(Member, DateTime)]
        takeCompleted [] = []
        takeCompleted ((_, Nothing):rest) = takeCompleted rest
        takeCompleted ((m, Just ts):rest) = (m, ts) : takeCompleted rest
    in takeCompleted mbTs

updatePoints :: Int -> Int -> [Member] -> Map.HashMap Member Int -> Map.HashMap Member Int
updatePoints day problemNum members standings =
    let starsForDay = sortBy (comparing snd) (getStarTS day problemNum members)
        updateMap = Map.fromList (zip (fmap fst starsForDay) points)
    in Map.unionWith (+) updateMap standings

-- parsing stuff
memberList :: Value -> Parser [Member]
memberList =
    withObject "members" $
    \o -> do
        ms <- o .: "members"
        withObject "members object" (traverse member . Map.elems) ms

member :: Value -> Parser Member
member =
    withObject "member" $
    \o -> do
        lastStarTs <- o .: "last_star_ts"
        mid <- o .: "id"
        starCount <- o .: "stars"
        name <- o .: "name"
        stars <- o .: "completion_day_level" >>= memberStars
        return
            Member
            { ..
            }

memberStars :: Value -> Parser (Map.HashMap (Int, Int) (Maybe DateTime))
memberStars =
    withObject "memberStars" $
    \o -> do
        halfParsed <- mapM parseDay o
        return $
            Map.foldlWithKey'
                (\acc day (day1ts, day2ts) ->
                      Map.insert (read $ unpack day, 2) day2ts $
                      Map.insert (read $ unpack day, 1) day1ts acc)
                Map.empty
                halfParsed

parseDay :: Value -> Parser (Maybe DateTime, Maybe DateTime)
parseDay =
    withObject "completion_day inner" $
    \o -> do
        one <- o .:? "1" >>= parseDay'
        two <- o .:? "2" >>= parseDay'
        return (one, two)
  where
    parseDay' (Just (Object d)) = Just <$> d .: "get_star_ts"
    parseDay' _ = return Nothing

tempMembers :: IO [Member]
tempMembers = do
    m <- readFile "snapshot.json"
    let Right parsed = eitherDecodeStrict m >>= parseEither memberList
    return parsed

## script.hs
#!/usr/bin/env stack
{- stack --resolver lts-7.12 --install-ghc
    runghc
    --package base
    --package text
    --package datetime
    --package bytestring
    --package aeson
    --package unordered-containers
    --package hashable
    --package hashable-time
-}


{-
To run the script, you need to have a file called "snapshot.json" from where
you run it. It should be the json dump of our leaderboard.
   -}

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RecordWildCards #-}

import GHC.Generics
import Prelude hiding (readFile)
import Control.Monad (join)
import Data.Text (Text, unpack, pack)
import Data.DateTime (DateTime)
import qualified Data.HashMap.Strict as Map
import Data.ByteString (readFile)
import Data.Monoid ((<>))
import Data.Ord (comparing, Down(..))
import Data.List (sortBy, foldl')
import Data.Hashable (Hashable)
-- because UTCTime has no Hashable instance by default, need to get import that
import Data.Hashable.Time ()

import Data.Aeson
import Data.Aeson.Types

points :: [Int]
points = 25 : 18 : 15 : 12 : 10 : 8 : 6 : 4 : 2 : 1 : repeat 0

data Member = Member
    { lastStarTs :: !DateTime
    , mid :: !Text
    , starCount :: !Int
    , name :: !Text
    , stars :: Map.HashMap (Int, Int) (Maybe DateTime)
    } deriving (Generic, Show, Eq)

instance Hashable Member

main :: IO ()
main = do
    raw <- readFile "snapshot.json"
    let parsed = eitherDecodeStrict raw >>= parseEither memberList
    case parsed of
        Left err -> error err
        Right ms -> do
            let total = totalPoints ms
            let sortedTotal = sortBy (comparing (Down . snd)) total
            print $ fmap (\(m, p) -> name m <> " got " <> pack (show p)) sortedTotal

totalPoints :: [Member] -> [(Member, Int)]
totalPoints members =
    let initialPoints = Map.empty
        args =
            [ (d, step)
            | d <- [1 .. 25]
            , step <- [1 .. 2] ]
    in Map.toList $ foldl' (\acc (d, s) -> updatePoints d s members acc) initialPoints args

getStarTS :: Int -> Int -> [Member] -> [(Member, DateTime)]
getStarTS day problemNumber members =
    let mbTs = fmap (\m -> (m, join $ Map.lookup (day, problemNumber) (stars m))) members
        takeCompleted :: [(Member, Maybe DateTime)] -> [(Member, DateTime)]
        takeCompleted [] = []
        takeCompleted ((_, Nothing):rest) = takeCompleted rest
        takeCompleted ((m, Just ts):rest) = (m, ts) : takeCompleted rest
    in takeCompleted mbTs

updatePoints :: Int -> Int -> [Member] -> Map.HashMap Member Int -> Map.HashMap Member Int
updatePoints day problemNum members standings =
    let starsForDay = sortBy (comparing snd) (getStarTS day problemNum members)
        updateMap = Map.fromList (zip (fmap fst starsForDay) points)
    in Map.unionWith (+) updateMap standings

-- parsing stuff
memberList :: Value -> Parser [Member]
memberList =
    withObject "members" $
    \o -> do
        ms <- o .: "members"
        withObject "members object" (traverse member . Map.elems) ms

member :: Value -> Parser Member
member =
    withObject "member" $
    \o -> do
        lastStarTs <- o .: "last_star_ts"
        mid <- o .: "id"
        starCount <- o .: "stars"
        name <- o .: "name"
        stars <- o .: "completion_day_level" >>= memberStars
        return
            Member
            { ..
            }

memberStars :: Value -> Parser (Map.HashMap (Int, Int) (Maybe DateTime))
memberStars =
    withObject "memberStars" $
    \o -> do
        halfParsed <- mapM parseDay o
        return $
            Map.foldlWithKey'
                (\acc day (day1ts, day2ts) ->
                      Map.insert (read $ unpack day, 2) day2ts $
                      Map.insert (read $ unpack day, 1) day1ts acc)
                Map.empty
                halfParsed

parseDay :: Value -> Parser (Maybe DateTime, Maybe DateTime)
parseDay =
    withObject "completion_day inner" $
    \o -> do
        one <- o .:? "1" >>= parseDay'
        two <- o .:? "2" >>= parseDay'
        return (one, two)
  where
    parseDay' (Just (Object d)) = Just <$> d .: "get_star_ts"
    parseDay' _ = return Nothing

tempMembers :: IO [Member]
tempMembers = do
    m <- readFile "snapshot.json"
    let Right parsed = eitherDecodeStrict m >>= parseEither memberList
    return parsed


## stack.yaml
# This file was automatically generated by 'stack init'
#
# Some commonly used options have been documented as comments in this file.
# For advanced use and comprehensive documentation of the format, please see:
# http://docs.haskellstack.org/en/stable/yaml_configuration/

# Resolver to choose a 'specific' stackage snapshot or a compiler version.
# A snapshot resolver dictates the compiler version and the set of packages
# to be used for project dependencies. For example:
#
# resolver: lts-3.5
# resolver: nightly-2015-09-21
# resolver: ghc-7.10.2
# resolver: ghcjs-0.1.0_ghc-7.10.2
# resolver:
#  name: custom-snapshot
#  location: "./custom-snapshot.yaml"
resolver: lts-7.12

# User packages to be built.
# Various formats can be used as shown in the example below.
#
# packages:
# - some-directory
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
# - location:
#    git: https://github.com/commercialhaskell/stack.git
#    commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
#   extra-dep: true
#  subdirs:
#  - auto-update
#  - wai
#
# A package marked 'extra-dep: true' will only be built if demanded by a
# non-dependency (i.e. a user package), and its test suites and benchmarks
# will not be run. This is useful for tweaking upstream packages.
packages:
- '.'
# Dependency packages to be pulled from upstream that are not in the resolver
# (e.g., acme-missiles-0.3)
extra-deps:
  - hindent-5.2.1
  - haskell-src-exts-1.19.0
  - req-0.1.0
  - http-client-0.5.4
  - http-client-tls-0.3.3
  - aeson-1.0.2.1
  - containers-0.5.8.1
  - datetime-0.3.1

# Override default flag values for local packages and extra-deps
flags: {}

# Extra package databases containing global packages
extra-package-dbs: []

# Control whether we use the GHC we find on the path
# system-ghc: true
#
# Require a specific version of stack, using version ranges
# require-stack-version: -any # Default
# require-stack-version: ">=1.2"
#
# Override the architecture used by stack, especially useful on Windows
# arch: i386
# arch: x86_64
#
# Extra directories used by stack for building
# extra-include-dirs: [/path/to/dir]
# extra-lib-dirs: [/path/to/dir]
#
# Allow a newer minor version of GHC than the snapshot specifies
# compiler-check: newer-minor
	name: bot-aoc
	version: 0.1.0.0
	synopsis: Simple project template from stack
	description: Please see README.md
	homepage: https://github.com/githubuser/bot-aoc#readme
	license: BSD3
	license-file: LICENSE
	author: Author name here
	maintainer: [email protected]
	copyright: 2016 Author name here
	category: Web
	build-type: Simple
	cabal-version: >=1.10
	extra-source-files: README.md

	executable bot-aoc
	hs-source-dirs: src
	main-is: Main.hs
	default-language: Haskell2010
	build-depends: base >= 4.7 && < 5
	, req >= 0.1 && < 0.2
	, text >= 1.2.2 && < 1.2.3
	, bytestring >= 0.10.8 && < 0.10.11
	, aeson >= 1.0.2 && < 1.0.3
	, unordered-containers >= 0.2.7 && < 0.2.8
	, data-default >= 0.7.1 && < 0.7.2
	, datetime >= 0.3.1 && < 0.4
	, time >= 1.6.0 && < 1.7
	, hashable-time >= 0.2 && < 0.3
	, hashable >= 1.2.4 && < 1.3
	{-# LANGUAGE OverloadedStrings #-}
	{-# LANGUAGE DeriveGeneric #-}
	{-# LANGUAGE RecordWildCards #-}

	module Main where

	import Control.Monad
	import GHC.Generics
	import Data.Text (Text, unpack, pack)
	import Control.Exception (throwIO)
	import Data.DateTime
	import qualified Data.HashMap.Strict as Map
	import Data.Aeson
	import Data.Aeson.Types
	import qualified Data.ByteString as BS
	import Data.Monoid ((<>))
	import Data.Maybe
	import Data.Ord (comparing)
	import Data.List (sortBy, foldl')
	import Data.Hashable
	import Data.Time.Clock (UTCTime)
	import Data.Hashable.Time

	import Network.HTTP.Req

	-- number of point for the first one to solve a given puzzle
	basePoint :: Int
	basePoint = 10

	instance MonadHttp IO where
	handleHttpException = throwIO

	data Member = Member
	{ lastStarTs :: !DateTime
	, mid :: !Text
	, starCount :: !Int
	, name :: !Text
	, stars :: Map.HashMap (Int, Int) (Maybe DateTime)
	} deriving (Generic, Show, Eq)

	instance Hashable Member

	main :: IO ()
	main = do
	m <- BS.readFile "snapshot.json"
	let parsed = eitherDecodeStrict m >>= parseEither members
	case parsed of
	Left err -> error err
	Right ms -> do
	-- putStrLn $ "got " <> show (Prelude.length ms) <> " members"
	let total = totalPoints ms
	print $ fmap (\(m, p) -> name m <> " got " <> pack (show p)) total
	-- let d1 =
	-- fmap (\(m, Just ts) -> (name m, ts)) $
	-- filter (isJust . snd) $ fmap (\m -> (m, getStarTS 1 1 m)) ms
	-- print (sortBy (comparing snd) d1)

	totalPoints :: [Member] -> [(Member, Int)]
	totalPoints members =
	let
	initialPoints = Map.empty
	-- args = [(d, step) \| d <- [1..25], step <- [1..2]]
	args = [(d, step) \| d <- [7], step <- [1..2]]
	in
	Map.toList $ Data.List.foldl' (\acc (d, s) -> updatePoints d s members acc) Map.empty args

	-- res <- req GET (http "localhost" /: "snapshot.json") NoReqBody jsonResponse (port 5000) -- :: IO (Map.HashMap Text Member)
	-- print (responseBody res :: Value)
	getStarTS :: Int -> Int -> [Member] -> [(Member, DateTime)]
	getStarTS day problemNumber members =
	let
	mbTs = fmap (\m -> (m, join $ Map.lookup (day, problemNumber) (stars m))) members
	takeCompleted :: [(Member, Maybe DateTime)] -> [(Member, DateTime)]
	takeCompleted [] = []
	takeCompleted ((m, Nothing) : rest) = takeCompleted rest
	takeCompleted ((m, Just ts) : rest) = (m, ts) : takeCompleted rest
	in
	takeCompleted mbTs

	updatePoints :: Int -> Int -> [Member] -> Map.HashMap Member Int -> Map.HashMap Member Int
	updatePoints day problemNum members standings =
	let
	starsForDay = sortBy (comparing snd) (getStarTS 1 1 members)
	points = iterate (\x -> max (x-1) 0) basePoint
	updateMap = Map.fromList (zip (fmap fst starsForDay) points)
	{-# LANGUAGE OverloadedStrings #-}
	{-# LANGUAGE DeriveGeneric #-}
	{-# LANGUAGE RecordWildCards #-}

	module Main where

	import GHC.Generics
	import Prelude hiding (readFile)
	import Control.Monad (join)
	import Data.Text (Text, unpack, pack)
	import Data.DateTime (DateTime)
	import qualified Data.HashMap.Strict as Map
	import Data.ByteString (readFile)
	import Data.Monoid ((<>))
	import Data.Ord (comparing, Down(..))
	import Data.List (sortBy, foldl')
	import Data.Hashable (Hashable)
	-- because UTCTime has no Hashable instance by default, need to get import that
	import Data.Hashable.Time ()

	import Data.Aeson
	import Data.Aeson.Types

	points :: [Int]
	points = 25 : 18 : 15 : 12 : 10 : 8 : 6 : 4 : 2 : 1 : repeat 0

	data Member = Member
	{ lastStarTs :: !DateTime
	, mid :: !Text
	, starCount :: !Int
	, name :: !Text
	, stars :: Map.HashMap (Int, Int) (Maybe DateTime)
	} deriving (Generic, Show, Eq)

	instance Hashable Member

	main :: IO ()
	main = do
	raw <- readFile "snapshot.json"
	let parsed = eitherDecodeStrict raw >>= parseEither memberList
	case parsed of
	Left err -> error err
	Right ms -> do
	let total = totalPoints ms
	let sortedTotal = sortBy (comparing (Down . snd)) total
	print $ fmap (\(m, p) -> name m <> " got " <> pack (show p)) sortedTotal

	totalPoints :: [Member] -> [(Member, Int)]
	totalPoints members =
	let initialPoints = Map.empty
	args =
	[ (d, step)
	\| d <- [1 .. 25]
	, step <- [1 .. 2] ]
	in Map.toList $ foldl' (\acc (d, s) -> updatePoints d s members acc) initialPoints args

	getStarTS :: Int -> Int -> [Member] -> [(Member, DateTime)]
	getStarTS day problemNumber members =
	let mbTs = fmap (\m -> (m, join $ Map.lookup (day, problemNumber) (stars m))) members
	takeCompleted :: [(Member, Maybe DateTime)] -> [(Member, DateTime)]
	takeCompleted [] = []
	takeCompleted ((_, Nothing):rest) = takeCompleted rest
	takeCompleted ((m, Just ts):rest) = (m, ts) : takeCompleted rest
	in takeCompleted mbTs

	updatePoints :: Int -> Int -> [Member] -> Map.HashMap Member Int -> Map.HashMap Member Int
	updatePoints day problemNum members standings =
	let starsForDay = sortBy (comparing snd) (getStarTS day problemNum members)
	updateMap = Map.fromList (zip (fmap fst starsForDay) points)
	in Map.unionWith (+) updateMap standings

	-- parsing stuff
	memberList :: Value -> Parser [Member]
	memberList =
	withObject "members" $
	\o -> do
	ms <- o .: "members"
	withObject "members object" (traverse member . Map.elems) ms

	member :: Value -> Parser Member
	member =
	withObject "member" $
	\o -> do
	lastStarTs <- o .: "last_star_ts"
	mid <- o .: "id"
	starCount <- o .: "stars"
	name <- o .: "name"
	stars <- o .: "completion_day_level" >>= memberStars
	return
	Member
	{ ..
	}

	memberStars :: Value -> Parser (Map.HashMap (Int, Int) (Maybe DateTime))
	memberStars =
	withObject "memberStars" $
	\o -> do
	halfParsed <- mapM parseDay o
	return $
	Map.foldlWithKey'
	(\acc day (day1ts, day2ts) ->
	Map.insert (read $ unpack day, 2) day2ts $
	Map.insert (read $ unpack day, 1) day1ts acc)
	Map.empty
	halfParsed

	parseDay :: Value -> Parser (Maybe DateTime, Maybe DateTime)
	parseDay =
	withObject "completion_day inner" $
	\o -> do
	one <- o .:? "1" >>= parseDay'
	two <- o .:? "2" >>= parseDay'
	return (one, two)
	where
	parseDay' (Just (Object d)) = Just <$> d .: "get_star_ts"
	parseDay' _ = return Nothing

	tempMembers :: IO [Member]
	tempMembers = do
	m <- readFile "snapshot.json"
	let Right parsed = eitherDecodeStrict m >>= parseEither memberList
	return parsed
	#!/usr/bin/env stack
	{- stack --resolver lts-7.12 --install-ghc
	runghc
	--package base
	--package text
	--package datetime
	--package bytestring
	--package aeson
	--package unordered-containers
	--package hashable
	--package hashable-time
	-}


	{-
	To run the script, you need to have a file called "snapshot.json" from where
	you run it. It should be the json dump of our leaderboard.
	-}

	{-# LANGUAGE OverloadedStrings #-}
	{-# LANGUAGE DeriveGeneric #-}
	{-# LANGUAGE RecordWildCards #-}

	import GHC.Generics
	import Prelude hiding (readFile)
	import Control.Monad (join)
	import Data.Text (Text, unpack, pack)
	import Data.DateTime (DateTime)
	import qualified Data.HashMap.Strict as Map
	import Data.ByteString (readFile)
	import Data.Monoid ((<>))
	import Data.Ord (comparing, Down(..))
	import Data.List (sortBy, foldl')
	import Data.Hashable (Hashable)
	-- because UTCTime has no Hashable instance by default, need to get import that
	import Data.Hashable.Time ()

	import Data.Aeson
	import Data.Aeson.Types

	points :: [Int]
	points = 25 : 18 : 15 : 12 : 10 : 8 : 6 : 4 : 2 : 1 : repeat 0

	data Member = Member
	{ lastStarTs :: !DateTime
	, mid :: !Text
	, starCount :: !Int
	, name :: !Text
	, stars :: Map.HashMap (Int, Int) (Maybe DateTime)
	} deriving (Generic, Show, Eq)

	instance Hashable Member

	main :: IO ()
	main = do
	raw <- readFile "snapshot.json"
	let parsed = eitherDecodeStrict raw >>= parseEither memberList
	case parsed of
	Left err -> error err
	Right ms -> do
	let total = totalPoints ms
	let sortedTotal = sortBy (comparing (Down . snd)) total
	print $ fmap (\(m, p) -> name m <> " got " <> pack (show p)) sortedTotal

	totalPoints :: [Member] -> [(Member, Int)]
	totalPoints members =
	let initialPoints = Map.empty
	args =
	[ (d, step)
	\| d <- [1 .. 25]
	, step <- [1 .. 2] ]
	in Map.toList $ foldl' (\acc (d, s) -> updatePoints d s members acc) initialPoints args

	getStarTS :: Int -> Int -> [Member] -> [(Member, DateTime)]
	getStarTS day problemNumber members =
	let mbTs = fmap (\m -> (m, join $ Map.lookup (day, problemNumber) (stars m))) members
	takeCompleted :: [(Member, Maybe DateTime)] -> [(Member, DateTime)]
	takeCompleted [] = []
	takeCompleted ((_, Nothing):rest) = takeCompleted rest
	takeCompleted ((m, Just ts):rest) = (m, ts) : takeCompleted rest
	in takeCompleted mbTs

	updatePoints :: Int -> Int -> [Member] -> Map.HashMap Member Int -> Map.HashMap Member Int
	updatePoints day problemNum members standings =
	let starsForDay = sortBy (comparing snd) (getStarTS day problemNum members)
	updateMap = Map.fromList (zip (fmap fst starsForDay) points)
	in Map.unionWith (+) updateMap standings

	-- parsing stuff
	memberList :: Value -> Parser [Member]
	memberList =
	withObject "members" $
	\o -> do
	ms <- o .: "members"
	withObject "members object" (traverse member . Map.elems) ms

	member :: Value -> Parser Member
	member =
	withObject "member" $
	\o -> do
	lastStarTs <- o .: "last_star_ts"
	mid <- o .: "id"
	starCount <- o .: "stars"
	name <- o .: "name"
	stars <- o .: "completion_day_level" >>= memberStars
	return
	Member
	{ ..
	}

	memberStars :: Value -> Parser (Map.HashMap (Int, Int) (Maybe DateTime))
	memberStars =
	withObject "memberStars" $
	\o -> do
	halfParsed <- mapM parseDay o
	return $
	Map.foldlWithKey'
	(\acc day (day1ts, day2ts) ->
	Map.insert (read $ unpack day, 2) day2ts $
	Map.insert (read $ unpack day, 1) day1ts acc)
	Map.empty
	halfParsed

	parseDay :: Value -> Parser (Maybe DateTime, Maybe DateTime)
	parseDay =
	withObject "completion_day inner" $
	\o -> do
	one <- o .:? "1" >>= parseDay'
	two <- o .:? "2" >>= parseDay'
	return (one, two)
	where
	parseDay' (Just (Object d)) = Just <$> d .: "get_star_ts"
	parseDay' _ = return Nothing

	tempMembers :: IO [Member]
	tempMembers = do
	m <- readFile "snapshot.json"
	let Right parsed = eitherDecodeStrict m >>= parseEither memberList
	return parsed
	# This file was automatically generated by 'stack init'
	#
	# Some commonly used options have been documented as comments in this file.
	# For advanced use and comprehensive documentation of the format, please see:
	# http://docs.haskellstack.org/en/stable/yaml_configuration/

	# Resolver to choose a 'specific' stackage snapshot or a compiler version.
	# A snapshot resolver dictates the compiler version and the set of packages
	# to be used for project dependencies. For example:
	#
	# resolver: lts-3.5
	# resolver: nightly-2015-09-21
	# resolver: ghc-7.10.2
	# resolver: ghcjs-0.1.0_ghc-7.10.2
	# resolver:
	# name: custom-snapshot
	# location: "./custom-snapshot.yaml"
	resolver: lts-7.12

	# User packages to be built.
	# Various formats can be used as shown in the example below.
	#
	# packages:
	# - some-directory
	# - https://example.com/foo/bar/baz-0.0.2.tar.gz
	# - location:
	# git: https://github.com/commercialhaskell/stack.git
	# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
	# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
	# extra-dep: true
	# subdirs:
	# - auto-update
	# - wai
	#
	# A package marked 'extra-dep: true' will only be built if demanded by a
	# non-dependency (i.e. a user package), and its test suites and benchmarks
	# will not be run. This is useful for tweaking upstream packages.
	packages:
	- '.'
	# Dependency packages to be pulled from upstream that are not in the resolver
	# (e.g., acme-missiles-0.3)
	extra-deps:
	- hindent-5.2.1
	- haskell-src-exts-1.19.0
	- req-0.1.0
	- http-client-0.5.4
	- http-client-tls-0.3.3
	- aeson-1.0.2.1
	- containers-0.5.8.1
	- datetime-0.3.1

	# Override default flag values for local packages and extra-deps
	flags: {}

	# Extra package databases containing global packages
	extra-package-dbs: []

	# Control whether we use the GHC we find on the path
	# system-ghc: true
	#
	# Require a specific version of stack, using version ranges
	# require-stack-version: -any # Default
	# require-stack-version: ">=1.2"
	#
	# Override the architecture used by stack, especially useful on Windows
	# arch: i386
	# arch: x86_64
	#
	# Extra directories used by stack for building
	# extra-include-dirs: [/path/to/dir]
	# extra-lib-dirs: [/path/to/dir]
	#
	# Allow a newer minor version of GHC than the snapshot specifies
	# compiler-check: newer-minor