MappingFile.hs

{-# LANGUAGE ScopedTypeVariables #-}

{-

This file is part of the vimeta package. It is subject to the license
terms in the LICENSE file found in the top-level directory of this
distribution and at git://pmade.com/vimeta/LICENSE. No part of the
vimeta package, including this file, may be copied, modified,
propagated, or distributed except according to the terms contained in
the LICENSE file.

-}

--------------------------------------------------------------------------------
-- | Mapping files can be used to map file names to other information.
module Vimeta.Core.MappingFile
       ( Parser
       , parseMappingFile
       ) where

--------------------------------------------------------------------------------
-- Library imports:
import Control.Applicative hiding ((<|>))
import Control.Monad.Identity
import Data.Char (isSpace)
import Data.Either
import Data.List
import Data.Text (Text)
import qualified Data.Text.IO as Text
import System.Directory (doesFileExist)
import System.FilePath (takeExtension)
import Text.Parsec

--------------------------------------------------------------------------------
-- Local imports:
import Vimeta.Core.Vimeta

--------------------------------------------------------------------------------
-- The following is a kludge to avoid the "redundant import" warning
-- when using GHC >= 7.10.x.  This should be removed after we decide
-- to stop supporting GHC < 7.10.x.
import Prelude

--------------------------------------------------------------------------------
-- | Parser type.
type Parser a = ParsecT Text () Identity a

--------------------------------------------------------------------------------
-- | Internal token used for parsing.
data Token a = Comment | Entry FilePath a

--------------------------------------------------------------------------------
-- | Parse a mapping file.
parseMappingFile :: (MonadIO m)
                 => FilePath    -- ^ File name for the mapping file.
                 -> Parser a    -- ^ Parser for the second column.
                 -> Vimeta m [(FilePath, a)]
parseMappingFile filename p = do
  contents <- runIO $ Text.readFile filename

  case runIdentity $ runParserT (mapping p) () filename contents of
    Left  e -> die (show e)
    Right m -> checkFileMappingOrDie m

--------------------------------------------------------------------------------
checkFileMappingOrDie :: (MonadIO m)
                      => [(FilePath, a)]
                      -> Vimeta m [(FilePath, a)]
checkFileMappingOrDie xs =
  do ys <- checkFileMapping xs
     if null (lefts ys)
       then return (rights ys)
       else die $ report (lefts ys)
  where
    report :: [(FilePath, a)] -> String
    report fs = "the following files are listed in the mapping file " ++
                "but they don't exist: \n" ++ intercalate "\n" (map fst fs)

--------------------------------------------------------------------------------
-- | Checks to see that all of the file names mentioned exist.  If a
-- file doesn't exist the @m4v@ file extension is added to it and the
-- existence checking happens again.
checkFileMapping :: (MonadIO m)
                 => [(FilePath, a)] -- ^ The mapping.
                 -> Vimeta m [Either (FilePath, a) (FilePath, a)]
checkFileMapping = mapM checkFile where
  checkFile :: (MonadIO m) => (FilePath, a)
            -> Vimeta m (Either (FilePath, a) (FilePath, a))
  checkFile f@(filename, a) = do
    let ext = takeExtension filename
    exists <- runIO (doesFileExist filename)

    case exists of
      False | null ext  -> checkFile (filename ++ ".m4v", a)
            | otherwise -> return $ Left  f
      True              -> return $ Right f

--------------------------------------------------------------------------------
-- | The actual file parser.
mapping :: Parser a -> Parser [(FilePath, a)]
mapping p = entries <$> manyTill (whitespace <|> comment <|> fileName p) eof
  where
    entries :: [Token a] -> [(FilePath, a)]
    entries = concatMap extract . filter predicate

    predicate :: Token a -> Bool
    predicate (Entry _ _) = True
    predicate Comment     = False

    extract :: Token a -> [(FilePath, a)]
    extract (Entry f a) = [(f, a)]
    extract Comment     = []

--------------------------------------------------------------------------------
-- | Parse a file name followed by whatever the second column parser
-- extracts.
fileName :: Parser a -> Parser (Token a)
fileName p =
  do first  <- anyChar
     others <- manyTill anyChar (lookAhead space)
     a      <- spaceWithoutNewline >> p
     return $ Entry (first:others) a
  <?> "filename and mapping"

--------------------------------------------------------------------------------
-- | Skip whitespace.
whitespace :: Parser (Token a)
whitespace = skipMany1 space >> return Comment

--------------------------------------------------------------------------------
-- | Like whitespace, but doesn't span multiple lines.
spaceWithoutNewline :: Parser ()
spaceWithoutNewline = skipMany1 $ satisfy (\c -> isSpace c && c /= '\n')

--------------------------------------------------------------------------------
-- | Skip comments.
comment :: Parser (Token a)
comment = (char '#' >> manyTill anyChar newline >> return Comment) <?> "comment"