{-# LANGUAGE ScopedTypeVariables #-}
module Vimeta.Core.MappingFile
( Parser
, parseMappingFile
) where
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
import Vimeta.Core.Vimeta
import Prelude
type Parser a = ParsecT Text () Identity a
data Token a = Comment | Entry FilePath a
parseMappingFile :: (MonadIO m)
=> FilePath
-> Parser a
-> 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)
checkFileMapping :: (MonadIO m)
=> [(FilePath, a)]
-> 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
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 = []
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"
whitespace :: Parser (Token a)
whitespace = skipMany1 space >> return Comment
spaceWithoutNewline :: Parser ()
spaceWithoutNewline = skipMany1 $ satisfy (\c -> isSpace c && c /= '\n')
comment :: Parser (Token a)
comment = (char '#' >> manyTill anyChar newline >> return Comment) <?> "comment"