{-# LANGUAGE TemplateHaskell, TypeFamilies, DeriveDataTypeable,
    FlexibleInstances, MultiParamTypeClasses, FlexibleContexts,
    UndecidableInstances, TypeOperators
    #-}

module HouseTab.State where

import Happstack.Data
import Happstack.State
import Control.Monad (replicateM)
import Control.Monad.Reader (ask)
import Control.Monad.State (modify)
import Data.List (find)
import Data.List.Split (splitOn)
import Happstack.Crypto.SHA1 (sha1)
import Data.List (sortBy)
import qualified Data.Map as M
import Happstack.Auth (AuthState(..))
import HouseTab.Utils
import Data.Maybe (fromJust)

type HouseTabId = String

$(deriveAll [''Eq, ''Ord, ''Default]
  [d|
      -- |Date: simple date.
      data Date = Date {year :: Integer
                 ,month :: Integer
                 ,day :: Integer}
      |])

instance Show Date where
    show (Date year month day) = (show year) ++ "." ++ (show month) ++ "." ++ (show day)

$(deriveSerialize ''Date)
instance Version Date

instance Read Date where
    readsPrec _ value = pd $ splitOn (".") value
        where pd (year:month:day:[]) = mkDate (maybeRead year) (maybeRead month) (maybeRead day)
              pd _ = []
              mkDate (Just y) (Just m) (Just d) = [(Date y m d, "")]
              mkDate _ _ _ = []

$(deriveAll [''Show, ''Eq, ''Default]
  [d|
      -- |Person: a person on the housetab
      data Person = Person { name :: String
                           , letter :: Char
                           , percs :: [(Date, Double)]}
   |])

$(deriveSerialize ''Person)
instance Version Person
instance Ord Person where
    compare (Person n1 _ _) (Person n2 _ _)
                    | n1 == n2    =  EQ
                    | n1 <= n2    =  LT
                    | otherwise =  GT

$(deriveAll [''Show, ''Eq, ''Ord, ''Default]
  [d|
      data HouseTabEntry = HouseTabEntry
          { eid :: HouseTabId
          , ewho  :: String
          , ewhat :: String
          , ewhen    :: Date
          , ehowmuch :: Double
          , ewhopays :: String
          }

      data HouseTab = HouseTab { houseTabEntries :: [HouseTabEntry]
                               , houseTabPeople :: [Person]}

      data Account = Account
          { aname :: String
          , aemails :: [String]
          , ahousetab :: HouseTab }

      data Accounts = Accounts 
          { active :: M.Map String Account -- key is account name
          , resets :: M.Map String String -- key is token, value is account name
          , inactive :: M.Map String Account } -- key is activation token
   |])

$(deriveSerialize ''HouseTabEntry)
instance Version HouseTabEntry
$(deriveSerialize ''HouseTab)
instance Version HouseTab
$(deriveSerialize ''Account)
instance Version Account
$(deriveSerialize ''Accounts)
instance Version Accounts

readAccounts :: Query Accounts Accounts
readAccounts = ask

replaceAccounts :: Accounts -> Update Accounts ()
replaceAccounts accounts = modify $ \_ -> accounts

readAccount :: String -> Query Accounts (Maybe Account)
readAccount name = do acnts <- ask
                      return $ M.lookup name (active acnts)

makeActive :: String -> Account -> Update Accounts ()
makeActive token acnt = modify $ \(Accounts a r i) -> (Accounts (M.insert (aname acnt) acnt a) r (M.delete token i))

addAccount :: String -> Account -> Update Accounts ()
addAccount token a = modify $ \accounts -> accounts{inactive=M.insert token a (inactive accounts)}

delAccount :: Account -> Update Accounts ()
delAccount a = modify $ \accounts -> accounts{active=M.delete (aname a) (active accounts)}

delInactiveAccount :: String -> Update Accounts ()
delInactiveAccount token = modify $ \accounts -> accounts{inactive=M.delete token (inactive accounts)}

addReset :: String -> String -> Update Accounts ()
addReset token name = modify $ \accounts -> accounts{resets=M.insert token name (resets accounts)}

delReset :: String -> Update Accounts ()
delReset token = modify $ \accounts -> accounts{resets=M.delete token (resets accounts)}

modAccount acnt fn = modify $ \accounts -> accounts{active=(adj (active accounts))}
    where adj m = M.update (\a -> Just (fn a)) (aname acnt) m

modEntries acnt fn = modAccount acnt $ \a -> a{ahousetab = (ahousetab a){houseTabEntries = fn (houseTabEntries (ahousetab a))}}

modPeople acnt fn = modAccount acnt $ \a -> a{ahousetab = (ahousetab a){houseTabPeople = fn (houseTabPeople (ahousetab a))}}

changeEmails :: Account -> [String] -> Update Accounts ()
changeEmails acnt ems = modAccount acnt $ \a -> a{aemails = ems}

-- | replaces the entire 'HouseTab' with another one. For use with backups.
replaceHouseTab :: Account -> HouseTab -> Update Accounts ()
replaceHouseTab acnt ht = modAccount acnt (\a -> a{ahousetab = ht})

hashEntry fields = sha1 $ concat fields

-- | add a 'HouseTabEntry' to the 'HouseTab'
addHouseTabEntry :: Account -> HouseTabEntry -> Update Accounts ()
addHouseTabEntry a e = modEntries a $ \es -> 
                       (e{eid=hashEntry([ewho e,
                                         ewhat e,
                                         show $ ewhen e,
                                         show $ ehowmuch e,
                                         ewhopays e])}:es)

-- | get a 'HouseTabEntry' from it's id
getHouseTabEntry :: Account -> HouseTabId -> (Maybe HouseTabEntry)
getHouseTabEntry a id = find (\e -> eid e == id) (houseTabEntries $ ahousetab a)

-- | delete a 'HouseTabEntry' from the 'HouseTab', by id.
-- will do nothing if the entry is not found.
delHouseTabEntry :: Account -> HouseTabId -> Update Accounts ()
delHouseTabEntry a id = modEntries a $ \es -> (filter (\e -> id /= eid e) es)

-- | add a 'Person' to the 'HouseTab'. unique identifier is letter.
-- will silently not add anything if a duplicate is attempted.
addPerson :: Account -> Person -> Update Accounts ()
addPerson a p = modPeople a $ \ps -> (if (letter p) `notElem` (map letter ps) 
                                      then (p:ps) 
                                      else ps)

-- | delete a 'Person' from the 'HouseTab'
delPerson :: Account -> Char -> Update Accounts ()
delPerson a l = modPeople a $ \ps -> (filter (\p -> l /= letter p) ps)


-- | get all the initials from an account
getInitials :: Account -> [Char]
getInitials a = map letter (houseTabPeople (ahousetab a))

-- | get a 'Person' by their letter from the Account
getPerson :: Account -> Char -> (Maybe Person)
getPerson a l = find (\p -> letter p == l) (houseTabPeople (ahousetab a))

-- | get a 'Person's entries by their letter form the Account
getPersonEntries :: Account-> Char -> [HouseTabEntry]
getPersonEntries a l = filter (\e -> ewho e == (l:[])) (houseTabEntries (ahousetab a))
                              
-- | add a 'Percent' to the 'HouseTab'. unique identifier for person is letter.
-- will silently not add anything if a letter is not found.
-- uniqueness guaranteed on Date, percents ordered by date.
addPercent :: Account -> Char -> (Date, Double) -> Update Accounts ()
addPercent a l perc = modPeople a $ \ps -> (addP (find (\p -> l == letter p) ps)
                                            (filter (\p -> l /= letter p) ps))
    where addP Nothing persons = persons 
          addP (Just p) persons = if (fst perc) `elem` (map fst (percs p))
                                    then p:persons
                                    else p{percs = 
                                           (sortBy (\a b -> compare (fst a) (fst b))
                                            ((percs p) ++ [perc]))} : persons

-- | delete a 'Percent' from a 'HouseTab'. unique identifier for person is letter.
-- will silently not delete anything if a letter is not found.
delPercent :: Account -> Char -> Date -> Update Accounts ()
delPercent a l date = modPeople a $ \ps -> (delP (find (\p -> l == letter p) ps)
                                            (filter (\p -> l /= letter p) ps))
    where delP Nothing persons = persons
          delP (Just p) persons = p{percs = (filter (\(d,_) -> d /= date) (percs p))} : persons

-- |make HouseTab its own Component
instance Component Accounts where
  type Dependencies Accounts =  AuthState :+: End
  initialValue = defaultValue

$(mkMethods ''Accounts ['readAccounts, 'replaceAccounts, 'readAccount, 'makeActive, 'addAccount, 'delInactiveAccount, 'addReset, 'delReset, 'delAccount, 'replaceHouseTab, 'addHouseTabEntry, 'delHouseTabEntry, 'addPerson, 'delPerson, 'addPercent, 'delPercent, 'changeEmails])