mcm-0.6.4.10: mcmtags.hs

-- MCM - Machine Configuration Manager; manages the contents of files and directories
-- Copyright (c) 2013-2016 Anthony Doggett <mcm@interfaces.org.uk>
--
-- Licence:
--     This program is free software: you can redistribute it and/or modify
--     it under the terms of the GNU General Public License as published by
--     the Free Software Foundation, either version 3 of the License, or
--     (at your option) any later version.
--
--     This program is distributed in the hope that it will be useful,
--     but WITHOUT ANY WARRANTY; without even the implied warranty of
--     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--     GNU General Public License for more details.
--
--     You should have received a copy of the GNU General Public License
--     along with this program.  If not, see <http://www.gnu.org/licenses/>.

-- Parses all .mcm files below the current directory
-- (If directories given as arguments, uses those instead)
-- Writes the results to "tags" file (in current directory)
-- Prints warnings for any files that fail to parse
module Main (main)
where

import Parser (mcmParse)
import ParserTypes (Define(..), Section(..), MCMFile(..), DefName(..))
import Paths_mcm (version)

import Control.Monad (filterM, unless)
import Data.Char (isAsciiUpper)
import Data.List (isSuffixOf, intercalate, sort, foldl')
import Data.Version (showVersion)
import qualified Data.Map as Map
import qualified Data.Text.Lazy as T
import qualified Data.Text.Lazy.IO as TextIO
import System.Console.GetOpt
import System.Directory (getDirectoryContents)
import System.Environment (getArgs)
import System.Exit (exitSuccess)
import System.FilePath (joinPath)
import System.Posix.Files (getFileStatus, isDirectory)

usage :: String
usage = unlines ["Usage: mcmtags [DIR..]"
                ,"Parse all *.mcm files below the current directory,"
                ,"or if directories given as arguments, below those directories."
                ,"The resulting tags are written to ./tags."
                ,"Print warnings for any files that fail to parse."
                ]

toWarn :: FilePath -> String
toWarn f = "WARNING: failed to parse " ++ f

tryParse :: FilePath -> IO (Maybe MCMFile)
tryParse f = do
    ss <- TextIO.readFile f
    case mcmParse ss of
        Right a -> return $ Just a
        Left _ -> return Nothing

makeTag :: FilePath -> String -> String -> String
makeTag f n ex_cmd = n ++ "\t" ++ f ++ "\t" ++ ex_cmd

toTags :: (FilePath, MCMFile) -> [String]
toTags (f, MCMFile pp (Section _ _ ds)) = ppTag:map dsTag (Map.elems ds)
    where
        ppTag = makeTag f (lastBitOfPath (show pp)) "/^MCM/"
        dsTag d = makeTag f (strDefName d) ("/^define " ++ strDefName d ++ "(/")
        lastBitOfPath :: String -> String
        lastBitOfPath = reverse . takeWhile (/= '.') . reverse
        strDefName = T.unpack . fromDefName . defName

isDirectory' :: FilePath -> IO Bool
isDirectory' f = do
    s <- getFileStatus f
    return $ isDirectory s

findMcm :: FilePath -> IO [FilePath]
findMcm p = do
    allfiles <- getDirectoryContents p
    let fs = [f | f <- allfiles, f `notElem` [".", ".."]]
        ms = [joinPath [p,f] | f <- fs, ".mcm" `isSuffixOf` f]
        ds = [joinPath [p,f] | f <- fs, isAsciiUpper (head f), '.' `notElem` f]
    dirs <- filterM isDirectory' ds
    children <- mapM findMcm dirs
    return $ ms ++ concat children

splitParsed :: [(FilePath, Maybe MCMFile)] -> ([FilePath], [(FilePath, MCMFile)])
splitParsed [] = ([], [])
splitParsed ((fp, m):xs) =
    let (as, bs) = splitParsed xs
    in case m of
            Nothing -> (fp:as, bs)
            Just f -> (as, (fp, f):bs)

main :: IO ()
main = do
    args <- getArgs
    let (actions, nonOpts, msgs) = getOpt Permute options args
    unless (null msgs) $ error $ concat msgs ++ usageInfo usage options
    _ <- foldl' (>>=) (return defaultOptions) actions
    let toRecurse = case nonOpts of
                        [] -> ["."]
                        _ -> args
    toParse <- mapM findMcm toRecurse
    let toParse' = concat toParse
    parsed <- mapM tryParse toParse'
    let fparsed = zip toParse' parsed
    let (bad, good) = splitParsed fparsed
        tags = sort $ concatMap toTags good
    mapM_ (putStrLn . toWarn) bad
    writeFile "tags" $ intercalate "\n" tags
    return ()

data Options = Options {}

defaultOptions :: Options
defaultOptions = Options {}

options :: [OptDescr (Options -> IO Options)]
options = [Option "V" ["version"] (NoArg displayVersion) "show version and exit"
          ,Option "h" ["help"] (NoArg justHelp) "show this help and exit"
          ]

displayVersion :: Options -> IO Options
displayVersion _ = do
    putStrLn $ "mcmtags " ++ showVersion version
    exitSuccess

justHelp ::  Options -> IO Options
justHelp _ = do
    putStrLn $ usageInfo usage options
    exitSuccess