{-# language OverloadedStrings, TypeApplications, RecordWildCards #-} module MusicScroll.DatabaseUtils ( getDBLyrics , getDBSong , insertDBLyrics , getDBPath , sqlDBCreate ) where import Prelude hiding (null) import Control.Applicative (Alternative(..)) import Control.Exception (evaluate) import Control.Monad.Trans.Reader (ReaderT, ask) import Control.Monad.IO.Class (MonadIO(..)) import Control.DeepSeq (rnf) import Crypto.Hash (SHA1, hashUpdate, hashInit, hashFinalize) import Data.ByteString (hGet, null) import System.IO (withFile, IOMode(..)) import Data.Text (Text) import Database.SQLite.Simple import System.Environment.XDG.BaseDir (getUserCacheDir) import Data.Coerce import System.Directory (createDirectory) import MusicScroll.TrackInfo (TrackInfo(..), SongFilePath) import MusicScroll.Providers.Utils (Lyrics(..)) getDBLyrics :: SongFilePath -> ReaderT Connection IO Lyrics getDBLyrics songUrl = snd <$> getDBSong songUrl getDBSong :: SongFilePath -> ReaderT Connection IO (TrackInfo, Lyrics) getDBSong songUrl = do conn <- ask liftIO $ do songHash <- fileHash songUrl songRaw <- query conn sqlExtractSong (Only songHash) case (songRaw :: [ (Text, Text, Text) ]) of [] -> empty (title, artist, lyrics):_ -> let track = TrackInfo title artist songUrl in return (track, coerce lyrics) insertDBLyrics :: TrackInfo -> Lyrics -> ReaderT Connection IO () insertDBLyrics (TrackInfo {..}) lyrics = do conn <- ask liftIO $ do songHash <- fileHash tUrl let params = (songHash, tArtist, tTitle, coerce lyrics :: Text) execute conn sqlInsertSong params getDBPath :: IO FilePath getDBPath = do cacheDir <- getUserCacheDir "musicScroll" createDirectory cacheDir <|> return () return $ cacheDir ++ "/" ++ "lyrics.db" -- | We use the exception thrown by withFile. fileHash :: FilePath -> IO String fileHash fp = withFile fp ReadMode $ \hdl -> let chunkSize = 512 * 1024 looper ctx = do upd <- hGet hdl chunkSize if null upd then return (show (hashFinalize ctx)) else do let newCtx = hashUpdate ctx upd evaluate (rnf newCtx) -- Important! looper newCtx in looper (hashInit @SHA1) sqlDBCreate, sqlInsertSong, sqlExtractSong :: Query sqlDBCreate = "create table if not exists MusicScrollTable(\n\ \ songHash text primary key,\n\ \ artist text,\n\ \ title text, \n\ \ lyrics text );" sqlInsertSong = "insert into MusicScrollTable values (?, ?, ?, ?);" sqlExtractSong = "select title, artist, lyrics from MusicScrollTable where songHash == ?;"