{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}

module MusicScroll.DatabaseUtils
  ( getDBLyrics,
    getDBSong,
    sqlDBCreate,
    InsertStategy,
    insertStrat,
    updateStrat,
    getDBPath,
  )
where

import Control.Applicative (Alternative (..))
import Control.Concurrent.MVar
import Control.DeepSeq (rnf)
import Control.Exception (evaluate)
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Trans.Reader (ReaderT, ask)
import Crypto.Hash (SHA1, hashFinalize, hashInit, hashUpdate)
import Data.ByteString (hGet, null)
import Data.Coerce
import Data.Text (Text)
import Database.SQLite.Simple
import MusicScroll.Providers.Utils (Lyrics (..))
import MusicScroll.TrackInfo (SongFilePath, TrackInfo (..))
import System.Directory (createDirectory)
import System.Environment.XDG.BaseDir (getUserCacheDir)
import System.IO (IOMode (..), withFile)
import Prelude hiding (null)

getDBLyrics :: SongFilePath -> ReaderT (MVar Connection) IO Lyrics
getDBLyrics :: [Char] -> ReaderT (MVar Connection) IO Lyrics
getDBLyrics [Char]
songUrl = (TrackInfo, Lyrics) -> Lyrics
forall a b. (a, b) -> b
snd ((TrackInfo, Lyrics) -> Lyrics)
-> ReaderT (MVar Connection) IO (TrackInfo, Lyrics)
-> ReaderT (MVar Connection) IO Lyrics
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> ReaderT (MVar Connection) IO (TrackInfo, Lyrics)
getDBSong [Char]
songUrl

getDBSong :: SongFilePath -> ReaderT (MVar Connection) IO (TrackInfo, Lyrics)
getDBSong :: [Char] -> ReaderT (MVar Connection) IO (TrackInfo, Lyrics)
getDBSong [Char]
songUrl =
  ReaderT (MVar Connection) IO (MVar Connection)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask ReaderT (MVar Connection) IO (MVar Connection)
-> (MVar Connection
    -> ReaderT (MVar Connection) IO (TrackInfo, Lyrics))
-> ReaderT (MVar Connection) IO (TrackInfo, Lyrics)
forall a b.
ReaderT (MVar Connection) IO a
-> (a -> ReaderT (MVar Connection) IO b)
-> ReaderT (MVar Connection) IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MVar Connection
mconn -> IO (TrackInfo, Lyrics)
-> ReaderT (MVar Connection) IO (TrackInfo, Lyrics)
forall a. IO a -> ReaderT (MVar Connection) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TrackInfo, Lyrics)
 -> ReaderT (MVar Connection) IO (TrackInfo, Lyrics))
-> IO (TrackInfo, Lyrics)
-> ReaderT (MVar Connection) IO (TrackInfo, Lyrics)
forall a b. (a -> b) -> a -> b
$
    do
      [Char]
songHash <- [Char] -> IO [Char]
fileHash [Char]
songUrl
      [(Text, Text, Text)]
songRaw <-
        MVar Connection
-> (Connection -> IO [(Text, Text, Text)])
-> IO [(Text, Text, Text)]
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar
          MVar Connection
mconn
          (\Connection
conn -> Connection -> Query -> Only [Char] -> IO [(Text, Text, Text)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
query Connection
conn Query
sqlExtractSong ([Char] -> Only [Char]
forall a. a -> Only a
Only [Char]
songHash))
      case ([(Text, Text, Text)]
songRaw :: [(Text, Text, Text)]) of
        [] -> IO (TrackInfo, Lyrics)
forall a. IO a
forall (f :: * -> *) a. Alternative f => f a
empty
        (Text
title, Text
artist, Text
lyrics) : [(Text, Text, Text)]
_ ->
          let track :: TrackInfo
track = Text -> Text -> [Char] -> TrackInfo
TrackInfo Text
title Text
artist [Char]
songUrl
           in (TrackInfo, Lyrics) -> IO (TrackInfo, Lyrics)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TrackInfo
track, Text -> Lyrics
forall a b. Coercible a b => a -> b
coerce Text
lyrics)

type InsertStategy = TrackInfo -> Lyrics -> ReaderT (MVar Connection) IO ()

insertStrat :: InsertStategy
insertStrat :: InsertStategy
insertStrat (TrackInfo {[Char]
Text
tTitle :: Text
tArtist :: Text
tUrl :: [Char]
tTitle :: TrackInfo -> Text
tArtist :: TrackInfo -> Text
tUrl :: TrackInfo -> [Char]
..}) Lyrics
lyrics =
  ReaderT (MVar Connection) IO (MVar Connection)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask ReaderT (MVar Connection) IO (MVar Connection)
-> (MVar Connection -> ReaderT (MVar Connection) IO ())
-> ReaderT (MVar Connection) IO ()
forall a b.
ReaderT (MVar Connection) IO a
-> (a -> ReaderT (MVar Connection) IO b)
-> ReaderT (MVar Connection) IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MVar Connection
mconn -> IO () -> ReaderT (MVar Connection) IO ()
forall a. IO a -> ReaderT (MVar Connection) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT (MVar Connection) IO ())
-> IO () -> ReaderT (MVar Connection) IO ()
forall a b. (a -> b) -> a -> b
$
    do
      [Char]
songHash <- [Char] -> IO [Char]
fileHash [Char]
tUrl
      let params :: ([Char], Text, Text, Text)
params = ([Char]
songHash, Text
tArtist, Text
tTitle, Lyrics -> Text
forall a b. Coercible a b => a -> b
coerce Lyrics
lyrics :: Text)
      MVar Connection -> (Connection -> IO ()) -> IO ()
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar Connection
mconn ((Connection -> IO ()) -> IO ()) -> (Connection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Connection
conn -> Connection -> Query -> ([Char], Text, Text, Text) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query
sqlInsertSong ([Char], Text, Text, Text)
params

updateStrat :: InsertStategy
updateStrat :: InsertStategy
updateStrat (TrackInfo {[Char]
Text
tTitle :: TrackInfo -> Text
tArtist :: TrackInfo -> Text
tUrl :: TrackInfo -> [Char]
tTitle :: Text
tArtist :: Text
tUrl :: [Char]
..}) Lyrics
lyrics =
  ReaderT (MVar Connection) IO (MVar Connection)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask ReaderT (MVar Connection) IO (MVar Connection)
-> (MVar Connection -> ReaderT (MVar Connection) IO ())
-> ReaderT (MVar Connection) IO ()
forall a b.
ReaderT (MVar Connection) IO a
-> (a -> ReaderT (MVar Connection) IO b)
-> ReaderT (MVar Connection) IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MVar Connection
mconn -> IO () -> ReaderT (MVar Connection) IO ()
forall a. IO a -> ReaderT (MVar Connection) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT (MVar Connection) IO ())
-> IO () -> ReaderT (MVar Connection) IO ()
forall a b. (a -> b) -> a -> b
$
    do
      [Char]
songHash <- [Char] -> IO [Char]
fileHash [Char]
tUrl
      let params :: (Text, [Char])
params = (Lyrics -> Text
forall a b. Coercible a b => a -> b
coerce Lyrics
lyrics :: Text, [Char]
songHash)
      MVar Connection -> (Connection -> IO ()) -> IO ()
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar Connection
mconn ((Connection -> IO ()) -> IO ()) -> (Connection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Connection
conn -> Connection -> Query -> (Text, [Char]) -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query
sqlUpdateSong (Text, [Char])
params

getDBPath :: IO FilePath
getDBPath :: IO [Char]
getDBPath = do
  [Char]
cacheDir <- [Char] -> IO [Char]
getUserCacheDir [Char]
"musicScroll"
  [Char] -> IO ()
createDirectory [Char]
cacheDir IO () -> IO () -> IO ()
forall a. IO a -> IO a -> IO a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
cacheDir [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"lyrics.db"

-- | We use the exception thrown by withFile.
fileHash :: FilePath -> IO String
fileHash :: [Char] -> IO [Char]
fileHash [Char]
fp = [Char] -> IOMode -> (Handle -> IO [Char]) -> IO [Char]
forall r. [Char] -> IOMode -> (Handle -> IO r) -> IO r
withFile [Char]
fp IOMode
ReadMode ((Handle -> IO [Char]) -> IO [Char])
-> (Handle -> IO [Char]) -> IO [Char]
forall a b. (a -> b) -> a -> b
$ \Handle
hdl ->
  let chunkSize :: Int
chunkSize = Int
512 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024
      looper :: Context a -> IO [Char]
looper Context a
ctx =
        do
          ByteString
upd <- Handle -> Int -> IO ByteString
hGet Handle
hdl Int
chunkSize
          if ByteString -> Bool
null ByteString
upd
            then [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Digest a -> [Char]
forall a. Show a => a -> [Char]
show (Context a -> Digest a
forall a. HashAlgorithm a => Context a -> Digest a
hashFinalize Context a
ctx))
            else do
              let newCtx :: Context a
newCtx = Context a -> ByteString -> Context a
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
hashUpdate Context a
ctx ByteString
upd
              () -> IO ()
forall a. a -> IO a
evaluate (Context a -> ()
forall a. NFData a => a -> ()
rnf Context a
newCtx) -- Important!
              Context a -> IO [Char]
looper Context a
newCtx
   in Context SHA1 -> IO [Char]
forall {a}. HashAlgorithm a => Context a -> IO [Char]
looper (forall a. HashAlgorithm a => Context a
hashInit @SHA1)

sqlDBCreate, sqlInsertSong, sqlExtractSong, sqlUpdateSong :: Query
sqlDBCreate :: Query
sqlDBCreate =
  Query
"create table if not exists MusicScrollTable(\n\
  \  songHash text primary key,\n\
  \  artist text,\n\
  \  title text, \n\
  \  lyrics text );"
sqlInsertSong :: Query
sqlInsertSong = Query
"insert into MusicScrollTable values (?, ?, ?, ?);"
sqlExtractSong :: Query
sqlExtractSong =
  Query
"select title, artist, lyrics from MusicScrollTable where songHash == ?;"
sqlUpdateSong :: Query
sqlUpdateSong =
  Query
"update MusicScrollTable set lyrics = ? where songHash = ? ;"