{-# LANGUAGE OverloadedStrings #-}
module Data.Time.Calendar.Laohuangli where

import qualified Data.Text as T
import Text.Printf

import Data.Time
import Data.Time.Calendar.WeekDate

import qualified Data.Set as Set

data Laohuangli =
  Laohuangli { today            :: (Integer, Int, Int, DayOfWeek)
             , goodActivities   :: [Activity]
             , badActivities    :: [Activity]
             , direction        :: Direction
             , drinks           :: [Drink]
             , goddessCloseness :: GoddessCloseness
             }

printLaohuangli :: Laohuangli -> IO ()
printLaohuangli Laohuangli {today=(y, m, d, w), goodActivities=gs, badActivities=bs,
                   direction=dir, drinks=ds, goddessCloseness = gc}
  = do
  gns <- mapM getActivityName gs
  bns <- mapM getActivityName bs
  putStrLn $ printf "今天是%d年%d月%d日 %s\n" y m d (showDayOfWeekLocalized w)
    ++ printf "宜:%s\n" (join ", " gns)
    ++ printf "忌:%s\n" (join ", " bns)
    ++ printf "座位朝向：面向%s写程序，BUG 最少。\n" (show dir)
    ++ printf "今日宜饮：%s\n"  (join "," ds)
    ++ printf "女神亲近指数：%s\n" (show gc)
    where
      join s txts = T.unpack $ T.intercalate s txts

showDayOfWeekLocalized :: DayOfWeek -> String
showDayOfWeekLocalized d =
  case d of
    Monday    -> "星期一"
    Tuesday   -> "星期二"
    Wednesday -> "星期三"
    Thursday  -> "星期四"
    Friday    -> "星期五"
    Saturday  -> "星期六"
    Sunday    -> "星期日"

isWeekend :: DayOfWeek -> Bool
isWeekend d = notElem d [Saturday, Sunday]

toDayOfWeek :: Int -> DayOfWeek
toDayOfWeek = toEnum

-- activity
data Activity = Activity { actName :: T.Text
                         , goodDesc :: T.Text
                         , badDesc :: T.Text
                         , isWeekendAct :: Bool
                         } deriving Show

getActivityName :: Activity -> IO T.Text
getActivityName a
  | "%v" `T.isInfixOf` rowName = getNanmmingActivityName a
  | "%t" `T.isInfixOf` rowName = getToolingActivityName a
  | "%l" `T.isInfixOf` rowName = getLineActivityName a
  | otherwise = return rowName
  where
    rowName = actName a

getNanmmingActivityName :: Activity -> IO T.Text
getNanmmingActivityName a = do
  varIndex <- mod <$> random 12 <*> (pure $ length varNames)
  return $ T.replace "%v" (varNames !! varIndex) (actName a)
  where
    varNames = ["jieguo", "huodong", "pay", "expire", "zhangdan", "every", "free", "i1", "a", "virtual", "ad", "spider", "mima", "pass", "ui"]

getToolingActivityName :: Activity -> IO T.Text
getToolingActivityName a = do
  toolIndex <- mod <$> random 11 <*> (pure $ length tools)
  return $ T.replace "%t" (tools !! toolIndex) (actName a)
  where
    tools = ["Eclipse写程序", "MSOffice写文档", "记事本写程序", "Windows8", "Linux", "MacOS", "IE", "Android设备", "iOS设备"]

getLineActivityName :: Activity -> IO T.Text
getLineActivityName a = do
  line <- (\n -> n `mod` 247 + 30) <$> random 12
  return $ T.replace "%l" (T.pack $ show line) (actName a)

-- direction
data Direction = North | East | South | West
               | Northeast | Southeast | Southwest | Northwest

instance Show Direction where
  show North = "北方"
  show East  = "东方"
  show South = "南方"
  show West  = "西方"
  show Northeast = "东北方"
  show Southeast = "东南方"
  show Southwest = "西南方"
  show Northwest = "西北方"

directions :: [Direction]
directions = [North, Northeast, East, Southeast, South, Southwest, West, Northwest]

-- GoddessCloseness
newtype GoddessCloseness = GoddessCloseness Int

instance Show GoddessCloseness where
  show (GoddessCloseness value) = drop (5 - value) (take  (10 - value) "★★★★★☆☆☆☆☆")

-- drink
type Drink = T.Text

-- random util
random :: Int -> IO Int
random seed = do
  (y, m, d) <- getToday
  let n = (fromInteger y * 10000 + m * 100 + d) `mod` 11117
  let numSeq = iterate (\x -> x^2 `mod` 11117) n
  return $ numSeq !! (seed + 100)

modRandom :: Int -> Int -> IO Int
modRandom seed modulus = mod <$> random seed <*> (pure modulus)

pickRandom :: [a] -> Int -> IO [a]
pickRandom xs n = do
  dropIndices <- Set.fromList <$> actualIndices <$> sequence [(`mod` (len - i)) <$> (random i) | i <- [0..len - n - 1]]
  return [ x | (x, i) <- zip xs [0..], i `Set.notMember` dropIndices]
  where
    len = length xs
    actualIndices (y:ys) = actualIndices' ys [y]
    actualIndices' [] acc = acc
    actualIndices' (z:zs) acc = actualIndices' zs ((actualIndex z acc):acc)
    actualIndex m acc
      | all (<= m) acc = m + length acc
      | all (> m) acc = m
      | otherwise  = let m' = m + (length $ filter (<= m) acc)
                     in actualIndex m' (filter (> m) acc)

-- getter
getToday' :: IO Day
getToday' = getZonedTime >>= (return . localDay . zonedTimeToLocalTime)

getToday :: IO (Integer, Int, Int)
getToday = getToday' >>= (return . toGregorian)

getDayOfWeek :: IO DayOfWeek
getDayOfWeek = do
  day <- getToday'
  let (_, _, weekNum) = toWeekDate day
  return $ toDayOfWeek weekNum

getGoddessCloseness :: IO GoddessCloseness
getGoddessCloseness = (+1) <$> modRandom 6 5 >>= (return . GoddessCloseness)

getDirection :: IO Direction
getDirection = do
  index <- modRandom 2 (length directions)
  return $ (directions !! index)

getDrinks :: IO [Drink]
getDrinks = pickRandom defaultDrinks 2
  where
    defaultDrinks = ["水","茶","红茶","绿茶","咖啡","奶茶","可乐","鲜奶","豆奶","果汁","果味汽水","苏打水","运动饮料","酸奶","酒"]

getTodayLaohuangli :: IO Laohuangli
getTodayLaohuangli = do
  (y, m, d) <- getToday
  w <- getDayOfWeek
  numGood <- (+2) <$> modRandom 98 3
  numBad <- (+2) <$> modRandom 87 3
  let filteredActs = if isWeekend w then filter isWeekendAct activities else activities
  randActs <-  pickRandom filteredActs (numGood + numBad)
  dir <- getDirection
  ds <- getDrinks
  gc <- getGoddessCloseness
  return Laohuangli {today=(y, m, d, w), goodActivities=take numGood randActs, badActivities=drop numGood randActs, direction=dir, drinks=ds, goddessCloseness=gc}

activities :: [Activity]
activities = [ Activity {actName="写单元测试", goodDesc="写单元测试将减少出错", badDesc="写单元测试会降低你的开发效率", isWeekendAct=False}
             , Activity {actName="洗澡", goodDesc="你几天没洗澡了？", badDesc="会把设计方面的灵感洗掉", isWeekendAct=True}
             , Activity {actName="锻炼一下身体", goodDesc="", badDesc="能量没消耗多少，吃得却更多", isWeekendAct=True}
             , Activity {actName="抽烟", goodDesc="抽烟有利于提神，增加思维敏捷", badDesc="除非你活够了，死得早点没关系", isWeekendAct=True}
             , Activity {actName="白天上线", goodDesc="今天白天上线是安全的", badDesc="可能导致灾难性后果",  isWeekendAct=False}
             , Activity {actName="重构", goodDesc="代码质量得到提高", badDesc="你很有可能会陷入泥潭", isWeekendAct=False}
             , Activity {actName="使用%t", goodDesc="你看起来更有品位", badDesc="别人会觉得你在装逼", isWeekendAct=False}
             , Activity {actName="跳槽", goodDesc="该放手时就放手", badDesc="鉴于当前的经济形势，你的下一份工作未必比现在强", isWeekendAct=False}
             , Activity {actName="招人", goodDesc="你面前这位有成为牛人的潜质", badDesc="这人会写程序吗？", isWeekendAct=False}
             , Activity {actName="面试", goodDesc="面试官今天心情很好", badDesc="面试官不爽，会拿你出气", isWeekendAct=False}
             , Activity {actName="提交辞职申请", goodDesc="公司找到了一个比你更能干更便宜的家伙，巴不得你赶快滚蛋", badDesc="鉴于当前的经济形势，你的下一份工作未必比现在强", isWeekendAct=False}
             , Activity {actName="申请加薪", goodDesc="老板今天心情很好", badDesc="公司正在考虑裁员", isWeekendAct=False}
             , Activity {actName="晚上加班", goodDesc="晚上是程序员精神最好的时候", badDesc="", isWeekendAct=True}
             , Activity {actName="在妹子面前吹牛", goodDesc="改善你矮穷挫的形象", badDesc="会被识破", isWeekendAct=True}
             , Activity {actName="撸管", goodDesc="避免缓冲区溢出", badDesc="强撸灰飞烟灭",isWeekendAct=True}
             , Activity {actName="浏览成人网站", goodDesc="重拾对生活的信心", badDesc="你会心神不宁", isWeekendAct=True}
             , Activity {actName="命名变量%v", goodDesc="", badDesc="", isWeekendAct= False}
             , Activity {actName="写超过%l行的方法", goodDesc="你的代码组织的很好，长一点没关系", badDesc="你的代码将混乱不堪，你自己都看不懂", isWeekendAct=False}
             , Activity {actName="提交代码", goodDesc="遇到冲突的几率是最低的", badDesc="你遇到的一大堆冲突会让你觉得自己是不是时间穿越了", isWeekendAct=False}
             , Activity {actName="代码复审", goodDesc="发现重要问题的几率大大增加", badDesc="你什么问题都发现不了，白白浪费时间", isWeekendAct=False}
             , Activity {actName="开会", goodDesc="写代码之余放松一下打个盹，有益健康", badDesc="小心被扣屎盆子背黑锅", isWeekendAct=False}
             , Activity {actName="打DOTA", goodDesc="你将有如神助", badDesc="你会被虐的很惨", isWeekendAct=True}
             , Activity {actName="晚上上线", goodDesc="晚上是程序员精神最好的时候", badDesc="你白天已经筋疲力尽了", isWeekendAct=False}
             , Activity {actName="修复BUG", goodDesc="你今天对BUG的嗅觉大大提高", badDesc="新产生的BUG将比修复的更多", isWeekendAct=False}
             , Activity {actName="设计评审", goodDesc="设计评审会议将变成头脑风暴", badDesc="人人筋疲力尽，评审就这么过了", isWeekendAct=False}
             , Activity {actName="需求评审", goodDesc="", badDesc="", isWeekendAct=False}
             , Activity {actName="上微博", goodDesc="今天发生的事不能错过", badDesc="今天的微博充满负能量", isWeekendAct=True}
             , Activity {actName="上AB站", goodDesc="还需要理由吗？", badDesc="满屏兄贵亮瞎你的眼", isWeekendAct=True}
             , Activity {actName="玩FlappyBird", goodDesc="今天破纪录的几率很高", badDesc="除非你想玩到把手机砸了", isWeekendAct=True}]
