{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module Ircbrowse.Types where

import Ircbrowse.Data
import Ircbrowse.Types.Import
import Ircbrowse.Monads

import Control.Applicative
import Data.Text
import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.FromRow
import Network.Mail.Mime (Address)
import Snap.App.Cache
import Snap.App.Types
import Data.Time

-- | Site-wide configuration.
data Config = Config
  { configPostgres        :: !ConnectInfo
  , configDomain          :: !String
  , configAdmin           :: !Address
  , configSiteAddy        :: !Address
  , configCacheDir        :: !FilePath
  , configLogDir          :: !FilePath
  }

instance AppConfig Config where
  getConfigDomain = configDomain

instance CacheDir Config where
  getCacheDir = configCacheDir

data PState = PState

-- | Statistics.
data Stats = Stats
  { stEventCount         :: !Integer
  , stMsgCount           :: !Integer
  , stNickCount          :: !Integer
  , stActiveTimes        :: ![(Integer,Integer)]
  , stDailyActivity      :: ![(Integer,Integer)]
  , stActiveNicks        :: ![(String,Integer)]
  , stNetworks           :: ![(String,String)]
  , stChannels           :: ![(String,String)]
  , stActivityByYear     :: ![(Integer,Integer)]
  , stConversationByYear :: ![(Integer,Integer)]
  } deriving Show

instance Default Stats where
  def = Stats
    { stEventCount = 0
    , stMsgCount   = 0
    , stNickCount = 0
    , stActiveNicks = []
    , stActiveTimes = []
    , stDailyActivity = []
    , stNetworks = []
    , stChannels = []
    , stConversationByYear = []
    , stActivityByYear = []
    }

instance AppLiftModel Config PState where
  liftModel action = do
    conn <- env controllerStateConn
    anns <- env controllerState
    conf <- env controllerStateConfig
    let st = ModelState conn anns conf
    io $ runReaderT (runModel action) st

data Range = Range
  { rangeFrom :: !Day, rangeTo :: !Day }
  deriving (Eq,Show)

data CacheKey
  = StatsOverview Channel
  | Overview
  | NickCloud Channel
  | Social (Maybe Channel)
  | BrowseDay Channel Day Text
  | BrowseToday Channel Text
  | Profile Text Bool
  | AllNicks Channel Text
  | UniquePDFs Channel
  | Calendar Channel
  | Channel Channel

instance Key CacheKey where
  keyToString (Calendar channel) = norm $ "calendar-" ++ showChan channel ++ ".html"
  keyToString (BrowseToday channel mode) = norm $ "browse-today-" ++ showChan channel ++ "-" ++ unpack mode ++ ".html"
  keyToString (BrowseDay channel day mode) = norm $ "browse-day-" ++ showDay day ++ "-" ++ showChan channel ++ "-" ++ unpack mode ++ ".html"
  keyToString (UniquePDFs channel) = norm $ "unique-pdfs-" ++ showChan channel ++ ".html"
  keyToString (StatsOverview channel) = norm $ contexted "overview" (Just channel)
  keyToString Overview = norm $ "overview.html"
  keyToString (NickCloud channel) = norm $ contexted "nick-cloud" (Just channel)
  keyToString (Social channel) = norm $ contexted "social" channel
  keyToString (Profile nick recent) = norm $
   "profile-" ++ unpack nick ++ "-" ++ (if recent then "recent" else "all") ++
   ".html"
  keyToString (AllNicks channel mode) = norm $
    "nicks-" ++ showChan channel ++ "-" ++ unpack mode ++
    ".html"
  keyToString (Channel channel) = norm $ "channel-" ++ showChan channel ++ ".html"

norm :: [Char] -> [Char]
norm = go where
  go (x:xs) | isDigit x || isLetter x || x == '.' || x == '-'  = x : go xs
            | otherwise = show (fromEnum x) ++ go xs
  go [] = []

contexted :: [Char] -> Maybe Channel -> [Char]
contexted name channel =
  name ++ "-" ++ opt (fmap showChan channel) ++ ".html"
    where opt Nothing = "_"
          opt (Just x) = x

showDay :: Day -> String
showDay = formatTime defaultTimeLocale "%Y-%m-%d"

data Event = Event
  { eventId        :: !Int
  , eventTimestamp :: !ZonedTime
  , eventNetwork   :: !Int
  , eventChannel   :: !Int
  , eventType      :: !Text
  , eventNick      :: !(Maybe Text)
  , eventText      :: !Text
  } deriving (Show)

instance FromRow Event where
  fromRow = Event <$> field <*> field <*> field <*> field <*> field <*> field <*> field
