hmp3-ng-2.20.0: src/Playlist.hs

-- Copyright (c) 2005-8 Don Stewart - http://www.cse.unsw.edu.au/~dons
-- Copyright (c) 2019-2020, 2025-2026 Galen Huntington
-- SPDX-License-Identifier: GPL-2.0-or-later

module Playlist (module Playlist, RawFilePath) where

import Base
import Text (fromBS, isLineSafe, SText)

import Data.Array
import Data.ByteString.Char8 qualified as P
import Data.Map.Strict qualified as M
import GHC.Records (HasField)
import System.Posix.FilePath
import System.Posix.Files.ByteString (getFileStatus, isDirectory, fileAccess)
import System.Posix.Directory.Traversals (getDirectoryContents)


-- | A filesystem hierarchy is flattened to just the end nodes
type DirArray = Array Int Dir

-- | The complete list of .mp3 files
type FileArray = Array Int File

type HasText a = HasField "text" a SText

data Dir = Dir
    { path  :: !RawFilePath     -- ^ directory name
    , start :: !Int             -- ^ index of first entry in FileArray
    , text  :: !SText           -- ^ displayed text
    }

data File = File
    { base :: !RawFilePath      -- ^ basename of file
    , dir  :: !Int              -- ^ index of Dir entry
    , text :: !SText            -- ^ displayed text
    }

data Playlist = Playlist !DirArray !FileArray

-- | Given the start directories, populate the dirs and files arrays
buildPlaylist :: [RawFilePath] -> IO Playlist
buildPlaylist fs = do
    -- note we will lose the ordering of files given on cmd line.
    (os, dirs) <- catch @SomeException (sift $ filter isLineSafe fs)
        \e -> print e *> exitWith (ExitFailure 1)

    let loop []     = pure []
        loop (a:xs) = do
            (m, ds) <- expandDir a
            ms      <- loop $ ds ++ xs  -- add to work list
            pure $ m : ms

    ms' <- catMaybes <$> loop dirs

    let extras = merge . doOrphans $ os
        ms = ms' ++ extras

    let (_,n,dirls,filels) = foldl' make (0,0,[],[]) ms
        dirsArray = listArray (0,length dirls - 1) (reverse dirls)
        fileArray = listArray (0, n-1) (reverse filels)

    pure $! Playlist dirsArray fileArray

-- | Is the playlist empty?
isEmpty :: Playlist -> Bool
isEmpty (Playlist _ files) = null files

-- | Create nodes based on dirname for orphan files on cmdline
doOrphans :: [RawFilePath] -> [(RawFilePath, [RawFilePath])]
doOrphans = map \f -> (takeDirectory f, [takeFileName f])

-- | Merge entries with the same root node into a single node
merge :: [(RawFilePath, [RawFilePath])] -> [(RawFilePath, [RawFilePath])]
merge = M.assocs . M.fromListWith (flip (++))

-- | fold builder, for generating Dirs and Files
make :: (Int,Int,[Dir],[File]) -> (RawFilePath,[RawFilePath]) -> (Int,Int,[Dir],[File])
make (i,n,acc1,acc2) (d,fs) =
    let (dir, n') = listToDir n d fs
        fs'= map makeFile fs
    in (i+1, n', dir:acc1, reverse fs' ++ acc2)
  where
    makeFile f =
        let fn = P.copy (takeFileName f)
        in File fn i (fromBS $ dropExtension fn)

------------------------------------------------------------------------

-- | Expand a single directory into a maybe a pair of the dir name and any files
-- Return any extra directories to search in
--
-- Assumes no evil sym links
--
expandDir :: RawFilePath -> IO (Maybe (RawFilePath, [RawFilePath]),  [RawFilePath])
expandDir !f = do
    ls <- map (f </>) . sort . filter isLineSafe . filter notHidden . map snd
        <$> getDirectoryContents f
    (fs', ds) <- sift ls
    let fs = filter isMp3 fs'
        v = guard (not $ null fs) *> Just (f, fs)
    pure (v, ds)
  where
    notHidden = not . P.isPrefixOf "."
    isMp3     = (== ".mp3") . P.map toLower . takeExtension

-- | Given an index into the files array, a directory name, and
-- a list of files in that dir, build a Dir and return the next index
-- into the array
listToDir :: Int -> RawFilePath -> [RawFilePath] -> (Dir, Int)
listToDir n d fs = (dir, n') where
    path = dropTrailingPathSeparator d
    dir = Dir { path, start = n, text = fromBS (takeFileName path) }
    len = length fs
    n'  = n + len

-- | Break a pair of sublists of files and directories, filtering
-- out ones without permission.
sift :: [RawFilePath] -> IO ([RawFilePath], [RawFilePath])
sift []     = pure ([], [])
sift (p:ps) = do
    it@(fs, ds) <- sift ps
    isDir <- isDirectory <$> getFileStatus p
    perm <- fileAccess p True False isDir
    pure if
        | not perm -> it
        | isDir    -> (fs, p:ds)
        | True     -> (p:fs, ds)