{- This file is part of funbot.
 -
 - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

-- For the 'MonadSettings' instance
{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances #-}

-- For JSON field names and irc-fun-color StyledString
{-# LANGUAGE OverloadedStrings #-}

module FunBot.Settings
    ( respondGet'
    , respondSet'
    , respondReset'
    , initTree
    --, addChanLogOpt
    --, addChanLogVal
    , loadBotSettings
    , mkSaveBotSettings
    )
where

import Control.Applicative ((<$>), (<*>))
import Control.Monad (mzero)
import Control.Monad.IO.Class (liftIO)
import Data.Aeson hiding (encode)
import Data.Bool (bool)
import Data.Char (toLower)
import qualified Data.HashMap.Lazy as M
import Data.List (intercalate, intersperse, isSuffixOf)
import Data.Monoid
import Data.Settings.Interface
import Data.Settings.Option
import Data.Settings.Route (showRoute)
import Data.Settings.Persist
import Data.Settings.Section (insert)
import Data.Settings.Types
import Data.Time.Units (Second)
import FunBot.Types
import Network.IRC.Fun.Bot.Chat
import Network.IRC.Fun.Bot.IrcLog
import Network.IRC.Fun.Bot.Nicks
import Network.IRC.Fun.Bot.State
import Network.IRC.Fun.Color

instance MonadSettings BotSession Settings where
    getSettings      = getStateS settings

    putSettings s    = modifyState $ \ st -> st { settings = s }

    modifySettings f = modifyState $ \ st -> st { settings = f $ settings st }

    getSTree         = getStateS stree

instance OptionValue Bool where
    readOption s
        | s' `elem` ["off", "false", "no",  "n", "0", "[_]"] = Just False
        | s' `elem` ["on",  "true",  "yes", "y", "1", "[x]"] = Just True
        | otherwise                                          = Nothing
        where
        s' = map toLower s
    showOption = show
    typeName = const "Boolean"

instance OptionValue String where
    readOption = Just
    showOption = id
    typeName = const "String"

parseList :: String -> Maybe [String]
parseList s  =
    case break (== ',') s of
        ("", _)     -> Nothing
        (p, "")     -> Just [p]
        (p, (c:cs)) ->
            case parseList cs of
                Nothing -> Nothing
                Just ps -> Just $ p : ps

instance OptionValue [String] where
    readOption s = parseList s >>= mapM readOption
    showOption   = intercalate "," . map showOption
    typeName     = const "List"

instance FromJSON NewsItemFields where
    parseJSON (Object o) =
        NewsItemFields <$>
        o .: "show-feed-title" <*>
        o .: "show-author" <*>
        o .: "show-url"
    parseJSON _          = mzero

instance ToJSON NewsItemFields where
    toJSON (NewsItemFields ftitle author url) = object
        [ "show-feed-title" .= ftitle
        , "show-author"     .= author
        , "show-url"        .= url
        ]

instance FromJSON NewsAnnSpec where
    parseJSON (Object o) =
        NewsAnnSpec <$>
        o .: "channels" <*>
        o .: "fields"
    parseJSON _          = mzero

instance ToJSON NewsAnnSpec where
    toJSON (NewsAnnSpec channels fields) = object
        [ "channels" .= channels
        , "fields"   .= fields
        ]

instance FromJSON Settings where
    parseJSON (Object o) =
        Settings <$>
        o .: "feeds"
    parseJSON _          = mzero

instance ToJSON Settings where
    toJSON (Settings feeds) = object
        [ "feeds" .= feeds
        ]

-- An option whose value is held by funbot's 'Settings' and saved into its
-- settings file
mkOptionF :: OptionValue v
          => (Settings -> v)             -- Get
          -> (v -> Settings -> Settings) -- Set which never fails
          -> v                           -- Default value for reset
          -> SettingsOption
mkOptionF get set defval = mkOptionS get set' reset cb
    where
    set' v s = Just $ set v s
    reset s = (Just defval, set defval s)
    cb = const saveBotSettings

-- An option whose value is held by irc-fun-bot's 'BotState' and saved into its
-- state file
mkOptionB :: OptionValue v
          => BotSession v         -- Get
          -> (v -> BotSession ()) -- Set which never fails
          -> v                    -- Default value for reset
          -> SettingsOption
mkOptionB get set defval = mkOptionV get set' reset
    where
    setTo val = set val >> cb val
    set' val = setTo val >> return True
    reset = setTo defval
    cb = const saveBotState

{-chanLogOpt chan =
    mkOptionF
        (M.lookupDefault False chan . chanLogging)
        (\ b s -> s { chanLogging = M.insert chan b $ chanLogging s })
        False-}

feedSec :: String -> SettingsTree
feedSec label = Section
    { secOpts = M.fromList
        [ ( "channels"
          , mkOptionF
                getChans
                (\ chans s ->
                    let feeds = watchedFeeds s
                        (url, spec) = getPair s
                        pair = (url, spec { nAnnChannels = chans })
                    in  s { watchedFeeds = M.insert label pair feeds }
                )
                defChans
          )
        ]
    , secSubs = M.fromList
        [ ( "show"
          , Section
                { secOpts = M.fromList
                    [ ( "feed-title"
                      , mkOptionF
                            (dispFeedTitle . getFields)
                            (\ b s ->
                                let (url, spec) = getPair s
                                    fieldsOld = nAnnFields spec
                                    fields = fieldsOld { dispFeedTitle = b }
                                    pair = (url, spec { nAnnFields = fields })
                                in  s { watchedFeeds = M.insert label pair $
                                                       watchedFeeds s }
                            )
                            (dispFeedTitle defFields)
                      )
                    , ( "author"
                      , mkOptionF
                            (dispAuthor . getFields)
                            (\ b s ->
                                let (url, spec) = getPair s
                                    fieldsOld = nAnnFields spec
                                    fields = fieldsOld { dispAuthor = b }
                                    pair = (url, spec { nAnnFields = fields })
                                in  s { watchedFeeds = M.insert label pair $
                                                       watchedFeeds s }
                            )
                            (dispAuthor defFields)
                      )
                    , ( "url"
                      , mkOptionF
                            (dispUrl . getFields)
                            (\ b s ->
                                let (url, spec) = getPair s
                                    fieldsOld = nAnnFields spec
                                    fields = fieldsOld { dispUrl = b }
                                    pair = (url, spec { nAnnFields = fields })
                                in  s { watchedFeeds = M.insert label pair $
                                                       watchedFeeds s }
                            )
                            (dispUrl defFields)
                      )
                    ]
                , secSubs = M.empty
                }
          )
        ]
    }
    where
    defChans = []
    defFields = NewsItemFields True True True
    defSpec = NewsAnnSpec defChans defFields
    defUrl = ""
    defPair = (defUrl, defSpec)

    getPair = M.lookupDefault defPair label . watchedFeeds
    getUrl = maybe defUrl fst . M.lookup label . watchedFeeds
    getSpec = maybe defSpec snd . M.lookup label . watchedFeeds
    getChans = nAnnChannels . getSpec
    getFields = nAnnFields . getSpec

chanSec :: String -> SettingsTree
chanSec chan = Section
    { secOpts = M.fromList
        [ ( "track"
          , mkOptionB
                (channelIsTracked chan)
                (bool (stopTrackingChannel chan) (startTrackingChannel chan))
                False
          )
        , ( "log"
          , mkOptionB
                (channelIsLogged chan)
                (bool (stopLoggingChannel chan) (startLoggingChannel chan))
                False
          )
        ]
    , secSubs = M.empty
    }

initTree :: BotSession ()
initTree = do
    cstates <- getChannelState
    sets <- getSettings
    let mapKey f = M.mapWithKey $ \ key _val -> f key
        tree = Section
            { secOpts = M.empty
            , secSubs = M.fromList
                [ ( "channels"
                  , Section
                        { secOpts = M.empty
                        , secSubs = mapKey chanSec cstates
                        }
                  )
                , ( "feeds"
                  , Section
                        { secOpts = M.empty
                        , secSubs = mapKey feedSec $ watchedFeeds sets
                        }
                  )
                ]
            }
    modifyState $ \ s -> s { stree = tree }

{-addChanLogOpt :: String -> SettingsTree -> SettingsTree
addChanLogOpt chan = insert ["chanlog", chan] $ chanLogOpt chan

addChanLogVal :: String -> Bool -> Settings -> Settings
addChanLogVal chan b s = s { chanLogging = M.insert chan b $ chanLogging s }-}

showError :: SettingsError -> String
showError (InvalidPath s)         = s ++ " : Invalid path"
showError (NoSuchNode r)          = showRoute r ++ " : No such option/section"
showError (NoSuchOption r)        = showRoute r ++ " : No such option"
showError (NoSuchSection r)       = showRoute r ++ " : No such section"
showError (InvalidValueForType s) = s ++ " : Invalid value for option type"
showError (InvalidValue s)        = s ++ " : Invalid value"

showGet :: String -> String -> String
showGet opt val = opt ++ " = " ++ val

showSec :: String -> [String] -> [String] -> String
showSec path subs opts =
    let showSub = Pure . ('‣' :)
        showOpt = Pure . ('•' :)
        showList = mconcat . intersperse " "
        pathF = Pure path
        subsF = Green #> (showList $ map showSub subs)
        optsF = Purple #> (showList $ map showOpt opts)
    in  encode $ case (null subs, null opts) of
            (False, False) -> pathF <> " : " <> subsF <> " | " <> optsF
            (False, True)  -> pathF <> " : " <> subsF
            (True, False)  -> pathF <> " : " <> optsF
            (True, True)   -> pathF <> " : Empty section"

respondGet' :: String -> String -> BotSession ()
respondGet' opt chan
    | opt == "*"            = respSec ""
    | ".*" `isSuffixOf` opt = respSec $ take (length opt - 2) opt
    | otherwise             = respAny opt
    where
    respAny path = do
        result <- query path
        sendToChannel chan $ case result of
            Left err                  -> showError err
            Right (Left (subs, opts)) -> showSec path subs opts
            Right (Right val)         -> showGet path val
    respSec path = do
        result <- querySection path
        sendToChannel chan $ case result of
            Left err           -> showError err
            Right (subs, opts) -> showSec path subs opts

showSet :: String -> String -> String
showSet opt val = opt ++ " ← " ++ val

respondSet' :: String -> String -> String -> BotSession ()
respondSet' opt val chan = do
    merr <- updateOption opt val
    case merr of
        Just err -> sendToChannel chan (showError err)
        Nothing  -> sendToChannel chan (showSet opt val)

showReset :: String -> String -> String
showReset opt val = opt ++ " ↩ " ++ val

showResetStrange :: String -> String
showResetStrange opt = opt ++ " : got reset, but I can't find it now"

respondReset' :: String -> String -> BotSession ()
respondReset' opt chan = do
    merr <- resetOption opt
    case merr of
        Just err -> sendToChannel chan $ showError err
        Nothing  -> do
            me <- queryOption opt
            sendToChannel chan $ case me of
                Left _    -> showResetStrange opt
                Right val -> showReset opt val

settingsFilename = "state/settings.json"

saveInterval = 3 :: Second

loadBotSettings :: IO Settings
loadBotSettings = do
    r <- loadSettings settingsFilename
    case r of
        Left (False, e) -> error $ "Failed to read settings file: " ++ e
        Left (True, e)  -> error $ "Failed to parse settings file: " ++ e
        Right s         -> return s

mkSaveBotSettings :: IO (Settings -> IO ())
mkSaveBotSettings = mkSaveSettings saveInterval settingsFilename

saveBotSettings :: BotSession ()
saveBotSettings = do
    sets <- getSettings
    save <- askEnvS saveSettings
    liftIO $ save sets