{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies, FlexibleContexts, ConstraintKinds #-}
{-# LANGUAGE QuasiQuotes #-}


module Handler.Utils
  ( module Handler.Utils
  ) where



import Import.NoFoundation
  
import Handler.Utils.DateTime as Handler.Utils
import Handler.Utils.Term as Handler.Utils
import Handler.Utils.Form as Handler.Utils
import Handler.Utils.Table as Handler.Utils
import Handler.Utils.Table.Pagination as Handler.Utils

import Handler.Utils.Zip as Handler.Utils
import Handler.Utils.Rating as Handler.Utils
import Handler.Utils.Submission as Handler.Utils
import Handler.Utils.Templates as Handler.Utils

import Text.Blaze (Markup, ToMarkup)

import Data.Map (Map)
import qualified Data.Map as Map
import qualified Data.List as List

import Database.Persist.Class

tickmark :: IsString a => a
tickmark = fromString "✔"

text2Html :: Text -> Html
text2Html = toHtml -- prevents ambiguous types

toWgt :: (ToMarkup a, MonadBaseControl IO m, MonadThrow m, MonadIO m) =>
  a -> WidgetT site m ()
toWgt = toWidget . toHtml

text2widget :: (MonadBaseControl IO m, MonadThrow m, MonadIO m) =>
                Text -> WidgetT site m ()
text2widget t = [whamlet|#{t}|]

str2widget :: (MonadBaseControl IO m, MonadThrow m, MonadIO m) =>
                String -> WidgetT site m ()
str2widget s = [whamlet|#{s}|]


withFragment :: ( Monad m
                ) => MForm m (a, WidgetT site IO ()) -> Markup -> MForm m (a, WidgetT site IO ())
withFragment form html = (flip fmap) form $ \(x, widget) -> (x, toWidget html >> widget)

-----------
-- Maybe --
-----------
whenIsJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
whenIsJust (Just x) f = f x
whenIsJust Nothing  _ = return ()



----------
-- Maps --
----------
entities2map :: PersistEntity record => [Entity record] -> Map (Key record) record
entities2map = foldl' (\m entity -> Map.insert (entityKey entity) (entityVal entity) m) Map.empty


------------
-- Routes --
------------

-- -- redirectBack :: Handler Html
-- -- redirectBack :: HandlerT UniWorX IO Html
-- redirectBack = defaultLayout $ do
--   [whamlet| BACK |]
--   -- [julius| window.history.back(); |]


--------------
-- Database --
--------------

-- getKeyBy :: PersistEntity val => Unique val -> ReaderT backend0 m0 (Maybe (Entity val))
-- getKeyBy :: Unique a -> YesodDB site (Key a)

getKeyBy :: (PersistEntityBackend record ~ BaseBackend backend, PersistEntity record, PersistUniqueRead backend, MonadIO m)
  => Unique record -> ReaderT backend m (Maybe (Key record))
getKeyBy u = (fmap entityKey) <$> getBy u -- TODO optimize this, so that DB does not deliver entire record!

getKeyBy404 :: (PersistEntityBackend record ~ BaseBackend backend, PersistEntity record, PersistUniqueRead backend, MonadIO m)
  => Unique record -> ReaderT backend m (Key record)
getKeyBy404 = (fmap entityKey) . getBy404 -- TODO optimize this, so that DB does not deliver entire record!


myReplaceUnique
    :: (MonadIO m
       ,Eq (Unique record)
       ,PersistRecordBackend record backend
       ,PersistUniqueWrite backend)
    => Key record -> record -> ReaderT backend m (Maybe (Unique record))
myReplaceUnique key datumNew = getJust key >>= replaceOriginal
  where
    uniqueKeysNew = persistUniqueKeys datumNew
    replaceOriginal original = do
        conflict <- checkUniqueKeys changedKeys
        case conflict of
            Nothing -> replace key datumNew >> return Nothing
            (Just conflictingKey) -> return $ Just conflictingKey
      where
        changedKeys = uniqueKeysNew List.\\ uniqueKeysOriginal
        uniqueKeysOriginal = persistUniqueKeys original

checkUniqueKeys
    :: (MonadIO m
       ,PersistEntity record
       ,PersistUniqueRead backend
       ,PersistRecordBackend record backend)
    => [Unique record] -> ReaderT backend m (Maybe (Unique record))
checkUniqueKeys [] = return Nothing
checkUniqueKeys (x:xs) = do
    y <- getBy x
    case y of
        Nothing -> checkUniqueKeys xs
        Just _ -> return (Just x)