------------------------------------------------------------------------------
-- |
-- Module         : Core
-- Copyright      : (C) 2014 Samuli Thomasson
-- License        : BSD-style (see the file LICENSE)
-- Maintainer     : Samuli Thomasson <samuli.thomasson@paivola.fi>
-- Stability      : experimental
-- Portability    : non-portable
------------------------------------------------------------------------------
module Core
    ( module Core
    , module Control.Monad.Logger
    , asks, local
    , gets, modify, runStateT
    , fromJust
    ) where


import           ClassyPrelude hiding (head, try, (<|>), groupBy, on, isNothing)
import           Data.Maybe (fromJust)
import           Control.Monad.Logger
import           Control.Monad.State (StateT, runStateT, gets, modify)
import           Control.Monad.Reader (asks, local)
import           Control.Monad.Trans.Resource (ResourceT, runResourceT)
import           Data.Aeson       hiding (Value)
import qualified Data.Function    as F
import qualified Data.List        as L
import           Database.Esqueleto as E
import           Database.Esqueleto.Internal.Sql (unsafeSqlFunction, UnsafeSqlFunctionArgument)
import           Network.HTTP.Conduit
import           System.Log.FastLogger
import           System.FilePath
import           System.Directory

import Types

type M = StateT AppState (ReaderT AppConfig (LoggingT IO))

-- * Database

-- | Database actions are allocated resources in ResourceT that are
-- released in the end of "db".
type DB = SqlPersistT (ResourceT M)

db :: DB a -> M a
db a = gets stPool >>= runResourceT . runSqlPool a

-- | Failing get
get' :: Key Dir -> DB Dir
get' = get >=> maybe (fail "get': Database corrupt?") return

-- ** Queries

type TitleEntity = (Entity LibraryEntry, Entity Anime, [Entity File])

type TitleConstraint = SqlExpr (Entity LibraryEntry) -> SqlExpr (Entity Anime) -> SqlExpr (Value Bool)

selectTitles :: TitleConstraint -> DB [TitleEntity]
selectTitles constraint = do
    fs <- getFiltersDB
    (select >=> mapM selectEpisodes) . from $ \(entry `InnerJoin` anime) -> do
        on (anime ^. AnimeId ==. entry ^. LibraryEntryAnime)
        where_ $ L.foldr1 (&&.) (constraint entry anime : fs entry anime)
        orderBy (entryOrder entry ++ animeOrder anime)
        return (entry, anime)

entryOrder :: SqlExpr (Entity LibraryEntry) -> [SqlExpr OrderBy]
entryOrder entry = [asc $ entry ^. LibraryEntryLastWatched]

animeOrder :: SqlExpr (Entity Anime) -> [SqlExpr OrderBy]
animeOrder anime = [asc $ anime ^. AnimeStatus, asc $ anime ^. AnimeSlug]

-- | Select an anime based on the title
selectAnimeFuzzy :: [Text] -> DB [Entity Anime]
selectAnimeFuzzy []    = fail "No tarasks given"
selectAnimeFuzzy parts = select . from $ \anime -> do
    where_ $ fuzzyTitle parts anime
    orderBy (animeOrder anime)
    return anime

-- | Get episodes (files) known for the entry/anime
selectEpisodes :: (Entity LibraryEntry, Entity Anime) -> DB TitleEntity
selectEpisodes (entry, anime) = do
    eps <- select . from $ \file -> do
        where_ (file ^. FileAnime ==. just (val (entityKey anime)))
        orderBy [asc $ file ^. FileEpisode]
        return file
    return (entry, anime, eps) -- map ( fileEpisode . entityVal ) eps)

-- | Resolve to a dir id in db. Create the entry if it does not exist.
resolveDirDb :: FilePath -> DB DirId
resolveDirDb dir = do
    mdir <- getBy $ UniqueDir (takeDirectory dir) (takeBaseName $ takeDirectory dir)
    maybe (insert $ Dir (takeDirectory dir) (takeBaseName $ takeDirectory dir)) (return . entityKey) mdir

-- | Files identified to a series but absent from the library.
-- filesDbNotLibrary :: DB [(Entity Anime, Entity File)]
filesDbNotLibrary :: DB [(Entity Anime, Entity File)]
filesDbNotLibrary = do
    select $ from $ \((file `InnerJoin` anime) `LeftOuterJoin` entry) -> do
        on (file ^. FileAnime ==. entry ?. LibraryEntryAnime)
        on (file ^. FileAnime ==. just (anime ^. AnimeId))
        where_ $ isNothing (entry ?. LibraryEntryId)
        orderBy [asc $ anime ^. AnimeId, asc $ file ^. FileEpisode]
        return (anime, file)

filesNotInFS :: DB [(Entity File, Entity Dir)]
filesNotInFS = select $ from $ \(file `LeftOuterJoin` dir) -> do
    on (dir ^. DirId ==. file ^. FileDir)
    orderBy [asc $ file ^. FileDir, asc $ file ^. FileBasename]
    return (file, dir)

-- *** Query parts

-- | Fuzzy LIKE of an anime title
fuzzyTitle :: [Text] -> SqlExpr (Entity Anime) -> SqlExpr (Value Bool)
fuzzyTitle parts anime = L.foldr1 (||.)
    [ anime ^. AnimeSlug `likeLower` matchExpression
    , anime ^. AnimeTitle `likeLower` matchExpression
    , exists . from $ \alt -> where_ $
         (alt ^. AltCanonical ==. anime ^. AnimeTitle) &&.
         (alt ^. AltAlias ==. val (unwords parts))
    ]
  where
    matchExpression = foldl' (\a b -> a ++. val (toLower b) ++. (%)) (%) parts

likeLower :: (UnsafeSqlFunctionArgument a) => a -> SqlExpr (E.Value Text) -> SqlExpr (E.Value Bool)
likeLower x expr = unsafeSqlFunction "LOWER" x `like` expr

-- | "likeAny xs" matches if "LIKE '% || x || %'" for any x in xs.
likeAny :: UnsafeSqlFunctionArgument a => a -> [Text] -> SqlExpr (E.Value Bool)
likeAny _   [] = val True
likeAny ent xs = L.foldl1 (||.) $ map (\x -> likeLower ent $ (%) ++. val (toLower x) ++. (%)) xs

-- *** Internal

-- * Logging

myLogger :: MonadIO m => LoggerSet -> Bool -> LoggingT m a -> m a
myLogger logger loud = (`runLoggingT` myOutput)
    where myOutput loc src level str
            | level == LevelDebug && not loud = return ()
            | otherwise = do
                pushLogStr logger $ if loud
                    then defaultLogStr loc src level str
                    else mconcat ["[", toLogStr (drop 5 $ show level), "] ", str, "\n"]
                flushLogStr logger

-- * Utility

io :: MonadIO m => IO a -> m a
io = liftIO

-- * Utility

toAbsolute :: MonadIO m => FilePath -> m FilePath
toAbsolute fp = liftM (</> fp) $ io getCurrentDirectory

groupByFirstKey :: ToBackendKey SqlBackend entity => [(Entity entity, b)] -> [[(Entity entity, b)]]
groupByFirstKey = L.groupBy ((==) `F.on` (fromSqlKey . entityKey . fst))

episodes :: [Entity File] -> [Int]
episodes = L.nub . filter (> 0) . map (fileEpisode . entityVal)

episodes' :: [Entity File] -> ([Int], [Int])
episodes' = sepEpisodes . map (fileEpisode . entityVal)

-- | 'partition (< 0)'
sepEpisodes :: [Int] -> ([Int], [Int])
sepEpisodes = partition (< 0)

-- | '(titlestat, watchingstat, matching, ignoring)'
getFilters :: M (Maybe [TitleStatus], Maybe [WatchingStatus], Maybe [Text], Maybe [Text])
getFilters = do
    tf <- asks coTitleStatusFilters
    wf <- asks coWatchingStatusFilters
    ma <- asks coMatching
    ig <- asks coIgnoring
    return (tf, wf, ma, ig)

-- | '\libentry anime -> predicate'
getFiltersDB :: DB (SqlExpr (Entity LibraryEntry) -> SqlExpr (Entity Anime) -> [SqlExpr (Value Bool)])
getFiltersDB = do
    (tf, wf, ma, ig) <- lift $ lift getFilters
    return $ \entry anime ->
        maybe    [] (\x -> [ entry ^. LibraryEntryStatus `in_` valList (map tshow x) ]) wf
        ++ maybe [] (\x -> [ anime ^. AnimeStatus        `in_` valList (map tshow x) ]) tf
        ++ maybe [] (\x -> [ anime ^. AnimeTitle         `likeAny` x ]) ma
        ++ maybe [] (\x -> [ not_ $ anime ^. AnimeTitle  `likeAny` x ]) ig

withFilterDefaults :: [TitleStatus] -> [WatchingStatus] -> M a -> M a
withFilterDefaults dtf dwf = local $ \a -> a
    { coWatchingStatusFilters = if null dwf then Nothing else Just $ fromMaybe dwf $ coWatchingStatusFilters a
    , coTitleStatusFilters    = if null dtf then Nothing else Just $ fromMaybe dtf $ coTitleStatusFilters a }


-- * Network

-- | "getPage url" fetches and returns the page at url.
getPage :: Text -> M Text
getPage page = do
    logDebugN $ "GET TEXT " <> page
    io . liftM (decodeUtf8 . toStrict) . simpleHttp $ unpack page

getPageJSON :: (FromJSON a) => Text -> M a
getPageJSON page = do
    logDebugN $ "GET JSON " <> page
    io $ simpleHttp (unpack page) >>= either fail return . eitherDecode'
