module Email (
    Template,
    Configuration,
    compileTemplate,
    getConfiguration,
    sendMail) where

import qualified Data.ByteString.Char8 as B
import qualified Data.Text as T
import qualified Data.Map as M
import qualified Network.Mail.SMTP as Mail
import qualified Data.Text.Lazy as L
import qualified Network.Mail.Mime as Mime
import User
import Data.Word
import Network.Socket.Internal
import Data.List
import Role

-- | An alias for the template contents 
type Template = T.Text




-- | Configuration object
data Configuration = Configuration { 
    host       :: String,
    port       :: PortNumber,
    emailAddr  :: String,
    username   :: String,
    password   :: String,
    ident      :: UserIdentifier
} deriving (Show)

type Error = String

-- | Parses an expression using traslateTags
compileTemplate :: Template -> M.Map String String -> Either Error L.Text
compileTemplate tmpl tmap = translateTags tmpl tmap

-- | Get template text from a file path
getTemplate :: FilePath -> IO T.Text
getTemplate fp = do
    contents <- readFile fp
    return $ T.pack contents

-- | Get configuration from a file path
getConfiguration :: FilePath -> IO Configuration
getConfiguration fp = do
    contents <- readFile fp
    return $ confFromStr contents

confFromStr :: String -> Configuration
confFromStr str = Configuration {
      host = drop 2 $ dropWhile (/= '=') (lns !! 0),
      port = toEnum (read (drop 2 $ dropWhile (/= '=') (lns !! 1)) :: Int),
      emailAddr = drop 2 $ dropWhile (/= '=') (lns !! 2),
      username = drop 2 $ dropWhile (/= '=') (lns !! 3),
      password = drop 2 $ dropWhile (/= '=') (lns !! 4),
      ident = drop 2 $ dropWhile (/= '=') (lns !! 5)
   }
   where lns = lines str

-- | Sends an e-mail with given text to list of users 
-- | using given configuration. Throws appropriate error upon failure. 
-- | Provide subject of the email as the last argument.
sendMail :: IO Configuration -> IO T.Text -> IO [User] -> String -> IO ()
sendMail iocnfg iotxt usrlist subj = do
    txt <- iotxt
    cnfg <- iocnfg
    list <- usrlist
    let mails = map (\x -> (T.pack $ email x, unwrapEither $ compileTemplate txt (createTemplateMap (ident cnfg) x), identifier x)) list
    --mapM_ (\(x,y,z) -> sendSingleMail x y z cnfg subj) mails -- sends all emails
    mapM_ (\(x,y,_) -> putStrLn $ (T.unpack x ++ " -> \n" ++ L.unpack y)) mails -- prints all emails
    
-- | Prepares and sends email
sendSingleMail :: T.Text -> L.Text -> String -> Configuration -> String -> IO ()
sendSingleMail addr txt recipName cnfg subj = do
    let from = Mime.Address (Just $ T.pack $ ident cnfg) (T.pack $ emailAddr cnfg)
    let to = [Mime.Address (Just $ T.pack recipName) (addr)]
    let cc = []
    let bcc = []
    let subject = T.pack subj
    let plainTextPart = Mail.plainTextPart txt
    let parts = [plainTextPart]
    let simpleMail = Mail.simpleMail from to cc bcc subject parts
    Mail.sendMailWithLogin' (host cnfg) (port cnfg) (username cnfg) (password cnfg) simpleMail


-- | Available tags and booleans have their values stored in a
-- | Data.Map and are looked up when needed
createTemplateMap :: UserIdentifier -> User -> M.Map String String
createTemplateMap authorName user = M.fromList 
    [("<<AuthorName>>", authorName)
    ,("<<UserName>>", identifier user)
    ,("isStudent", isStudent user)
    ,("isTA", isTA user)
    ,("isProf", isProf user)
    ,("True", "True")
    ,("False", "False")
    ]


-- | Traverses the text line by line and word by word to find tags
-- | and <<If>> statements. 
translateTags :: T.Text -> M.Map String String -> Either Error L.Text
translateTags txt tmap = Right ( L.pack $ translateTagsLines (lines $ T.unpack txt) [])
    where translateTagsLines [] t = unlines t
          translateTagsLines (x:xs) t = if isInfixOf "<<If>>" x
                                        then if checkCondition (head xs) tmap
                                             then translateTagsLines (drop 2 $ dropWhile (\l -> not $ isInfixOf "<</If>>" l) xs) (t ++ [translateTagsLines (drop 2 $ takeWhile (\l -> not $ isInfixOf "<<Else>>" l) xs) []])
                                             else translateTagsLines (drop 2 $ dropWhile (\l -> not $ isInfixOf "<</If>>" l) xs) (t ++ [translateTagsLines (drop 1 $ dropWhile (\l -> not $ isInfixOf "<<Else>>" l) $ takeWhile (\l -> not $ isInfixOf "<</If>>" l) xs) []])
                                        else translateTagsLines xs (t ++ [translateTagsWords (words x) []])
          translateTagsWords [] t = unwords t
          translateTagsWords (x:xs) t = translateTagsWords xs (t ++ [checkWord x])
          checkWord word = if (length elems) > 0
                           then (prefx ++ changedWord ++ sufx)
                           else word
                           where elems = M.elems (M.filterWithKey (\k _ -> isInfixOf k word) tmap)
                                 changedWord = unwords elems
                                 prefx = takeWhile (\l -> l /= '<') word
                                 sufx  = drop 2 $ dropWhile (\l -> l /= '>') word


data Expr = And Expr Expr | Or Expr Expr | Not Expr | Val Bool
    deriving (Show,Read)

eval' :: Expr -> Bool
eval' (Val x)   = x
eval' (Not x)   = not $ eval' x
eval' (Or x y)  = eval' x || eval' y
eval' (And x y) = eval' x && eval' y

addSpaces :: String -> String
addSpaces [] = ""
addSpaces ('(':xs) = "( " ++ addSpaces xs
addSpaces (')':xs) = " )" ++ addSpaces xs
addSpaces (x:xs)   = [x] ++ addSpaces xs

checkCondition :: String -> M.Map String String -> Bool
checkCondition x tmap = eval' (read (cc (words (addSpaces x)) "") :: Expr)
    where cc [] exp = exp
          cc (x:xs) exp = if M.member x tmap
                          then cc xs (exp ++ "Val " ++ unwrapMaybe(M.lookup x tmap))
                          else cc xs (exp ++ x)

isStudent :: User -> String
isStudent (User _ _ _ (Student _)) = "True"
isStudent (User _ _ _ _) = "False"

isTA :: User -> String
isTA (User _ _ _ (TA _ _)) = "True"
isTA (User _ _ _ _) = "False"

isProf :: User -> String
isProf (User _ _ _ Professor) = "True"
isProf (User _ _ _ _) = "False"

unwrapMaybe :: Maybe String -> String
unwrapMaybe a = case a of
    Just a -> a
    Nothing -> ""

unwrapEither :: Either a b -> b
unwrapEither a = case a of
    Right x -> x
    Left err -> error "err"