{-# LANGUAGE NoImplicitPrelude #-}

module Bamboo.Model.Counter where

import Bamboo.Model.Env 
import qualified System.IO as IO

hit :: String -> IO ()
hit x = create_stat_if_none x >> inc_stat
  where
    inc_stat = do
      let i = x.count_path
      c <- i.safe_read_line
      let count = c.read :: Int
      count.(+1).show.write_file i

count_name :: String -> String
count_name = (/ static_config.count_meta)

count_path :: String -> String
count_path = (static_config.stat_uri / ) > count_name

safe_read_line :: String -> IO String
safe_read_line x = with_file x IO.ReadMode IO.hGetLine 

create_stat_if_none :: String -> IO ()
create_stat_if_none x = do
  let i = x.count_path
  whenM (i.file_exist ^ not) $
    i.create_stat

  where
    create_stat x' = mkdir_p (x'.take_directory) 
      >> default_count.show.write_file x'
    default_count = 1 :: Int


read_stat :: String -> IO Int
read_stat x = do
  create_stat_if_none x
  safe_read_line (x.count_path) ^ read