module Text.SmallCaps where
import System.IO ( Handle, hClose, openFile, openTempFile, IOMode (..), stdin, stdout )
import Data.Text.IO ( hGetContents, hPutStr )
import System.FilePath ( (</>), takeDirectory, takeBaseName, makeRelative, hasExtension, replaceExtension )
import System.Directory ( renameFile, canonicalizePath, makeRelativeToCurrentDirectory, createDirectoryIfMissing )
import System.Environment ( getProgName, getArgs )
import System.Exit ( exitFailure )
import System.Console.GetOpt ( OptDescr ( Option ), ArgDescr ( NoArg, ReqArg ), ArgOrder ( Permute ), getOpt, usageInfo )
import Data.Version ( Version ( Version ), versionBranch, versionTags, showVersion )
import Data.Default ( def )
import Data.Attoparsec.Text ( parseOnly )
import Data.Text ( Text, pack, unpack )
import Data.Map ( Map )
import qualified Data.Map as Map ( empty, member, insert, elems )
import Control.Monad ( foldM )
import Text.SmallCaps.Config ( Config (..), Profile, conservative, busy, clean )
import Text.SmallCaps.LaTeX ( LaTeX, unlatex )
import Text.SmallCaps.TeXParser ( tex )
import Text.SmallCaps.TeXLaTeXParser ( parse, latex )
import Text.SmallCaps.DocumentParser ( runDocument, runDocument' )
import Text.SmallCaps.ConfigParser ( replaceMacro, searchList, isolateList, skipList, unskipList, eosList )
import qualified Text.SmallCaps.ConfigParser as ConfigParser ( Style ( .. ) )
version :: Version
version = Version
{ versionBranch = [0,5,1,1]
, versionTags = []
}
smallcapsNoRecursion :: Config -> Profile -> Text -> Either String Text
smallcapsNoRecursion conf prof = fmap unlatex . (runDocument conf prof =<<) . fmap fst . parseLaTeX
parseLaTeX :: Text -> Either String (LaTeX, [Text])
parseLaTeX = fmap (parse latex) . parseOnly tex
smallcaps :: Config -> Profile -> IO ()
smallcaps conf prof = uncurry (runFlags conf prof) =<< opts =<< getArgs
smallcapsHandle :: Handle -> Handle -> Config -> Profile -> IO ()
smallcapsHandle inp out conf prof = hPutStr out =<< runParser =<< hGetContents inp
where runParser = either fail return . smallcapsNoRecursion conf prof
smallcapsPipe :: Config -> Profile -> IO ()
smallcapsPipe = smallcapsHandle stdin stdout
smallcapsFile :: FilePath -> FilePath -> Config -> Profile -> IO ()
smallcapsFile pre inpFN conf prof = either fail (prefixed pre inpFN) . smallcapsNoRecursion conf prof =<< hGetContents =<< openFile inpFN ReadMode
smallcapsRecursiveFile :: FilePath -> FilePath -> Config -> Profile -> IO ()
smallcapsRecursiveFile pre inpFN conf prof = do
inp <- openFile inpFN ReadMode
(inpCode, fs) <- either fail return =<< fmap parseLaTeX (hGetContents inp)
ls <- recursiveContents (takeDirectory inpFN) Map.empty (map unpack fs)
(outCode, ls') <- either fail return $ runDocument' ls conf prof inpCode
prefixed pre inpFN $ unlatex outCode
mapM_ (uncurry ((. unlatex) . prefixed pre)) $ Map.elems ls'
recursiveContents :: FilePath -> Map FilePath (FilePath, LaTeX) -> [FilePath] -> IO (Map FilePath (FilePath, LaTeX))
recursiveContents orig = foldM get where
get ls path =
if path `Map.member` ls
then return ls
else do
fn <- canonicalizePath (orig </> makeRelative orig (texPath path))
fh <- openFile fn ReadMode
(code, fs) <- either fail return =<< fmap parseLaTeX (hGetContents fh)
recursiveContents orig (Map.insert path (fn, code) ls) (map unpack fs)
prefixed :: FilePath -> FilePath -> Text -> IO ()
prefixed pre inpFN text =
if pre == "" || pre == "."
then do
(outFN, out) <- openTempFile (takeDirectory inpFN) (takeBaseName inpFN)
hPutStr out text
hClose out
renameFile outFN inpFN
else do
outFN <- fmap ((</>) pre) (makeRelativeToCurrentDirectory inpFN)
createDirectoryIfMissing True (takeDirectory outFN)
out <- openFile outFN WriteMode
hPutStr out text
hClose out
texPath :: FilePath -> FilePath
texPath path
| hasExtension path = path
| otherwise = replaceExtension path ".tex"
getPrefix :: [Flag] -> String
getPrefix = foldr get "" where
get (Prefix pre) _ = pre
get _ pre' = pre'
data Flag
= ProgVer
| Help
| Prefix String
| Recursive
| Profile String
| Periods String
| BMacro String
| AMacro String
| Search String
| Isolate String
| Skip String
| Unskip String
| Eos String
| NoInline
deriving (Eq, Show)
runFlags :: Config -> Profile -> [Flag] -> [String] -> IO ()
runFlags conf prof flags filenames
| Help `elem` flags = usage
| ProgVer `elem` flags = putVersion
| null filenames = smallcapsPipe (reconf conf flags) prof
| Recursive `elem` flags = smallcapsRecursiveFile (getPrefix flags) (head filenames) (reconf conf flags) prof
| otherwise = smallcapsFile (getPrefix flags) (head filenames) (reconf conf flags) prof
reconf :: Config -> [Flag] -> Config
reconf = foldl fun where
fun _ (Profile s) = chooseConf s
fun conf (Periods s) = conf { periodChars = s }
fun conf (BMacro s) = parse' (flip replaceMacro ConfigParser.NoArg) conf s
fun conf (AMacro s) = parse' (flip replaceMacro ConfigParser.InArg) conf s
fun conf (Search s) = parse' searchList conf s
fun conf (Isolate s) = parse' isolateList conf s
fun conf (Skip s) = parse' skipList conf s
fun conf (Unskip s) = parse' unskipList conf s
fun conf (Eos s) = parse' eosList conf s
fun conf NoInline = conf { inlineConfig = False }
fun conf _ = conf
chooseConf s
| s == "conservative" = conservative
| s == "busy" = busy
| s == "clean" = clean
| otherwise = def
parse' p conf = either (const conf) id . parseOnly (p conf) . pack
options :: [OptDescr Flag]
options =
[ Option [] ["version"] (NoArg ProgVer) "version number"
, Option ['h'] ["help"] (NoArg Help) "program usage"
, Option [] ["prefix"] (ReqArg Prefix "<path>") "output file prefix"
, Option ['r'] ["recursive"] (NoArg Recursive) "follow \\include and \\input statements"
, Option [] ["no-inline"] (NoArg NoInline) "ignore configuration statements in TeX comments"
, Option ['p'] ["profile"] (ReqArg Profile "<name>") "configuration preset (conservative, busy, clean)"
, Option ['x'] ["periods"] (ReqArg Periods "<chars>") "signs marking the end of a sentence (default: \".!?\")"
, Option ['m'] ["macro"] (ReqArg BMacro "<code>") "block macro that transforms small caps (default: \"\\small\")"
, Option ['M'] ["macro-arg"] (ReqArg AMacro "<code>") "argument macro that transforms small caps (default: not set)"
, Option ['s'] ["search"] (ReqArg Search "<list>") "search list (default: \"+ document\")"
, Option ['i'] ["isolate"] (ReqArg Isolate "<list>") "isolate list (default: \"+ \\footnote, \\marginpar\")"
, Option ['S'] ["skip"] (ReqArg Skip "<list>") "skip list (default: \"+ \\small\")"
, Option ['u'] ["unskip"] (ReqArg Skip "<list>") "unskip list (default: \"+ \\tiny, \\large, ...\")"
, Option ['e'] ["eos"] (ReqArg Eos "<list>") "end-of-sentence list (default: \"+ \\par, \\section, ...\")"
]
opts :: [String] -> IO ([Flag], [String])
opts argv = do
case getOpt Permute options argv of
(o,n,[]) -> return (o,n)
(_,_,_ ) -> usage >> exitFailure
usage :: IO ()
usage = do
putVersion >> putStrLn ""
pname <- getProgName
putStrLn $ "Usage: " ++ pname ++ " [options] [filename]\n"
putStr "Options:"
putStr $ usageInfo "" options
putStrLn "\nWithout filename, the program starts in filter mode.\n"
putStrLn "Inline configuration:"
putStrLn " % smallcaps reset profile <name>"
putStrLn " % smallcaps restore profile <name>"
putStrLn " reset configuration profile to <name>"
putStrLn " default: default configuration"
putStrLn " conservative: restrictive settings for few actions only"
putStrLn " busy: search all environments and macros"
putStrLn " clean: suppress all actions"
putStrLn ""
putStrLn " % smallcaps store profile <name>"
putStrLn " store a configuration profile as <name>"
putStrLn ""
putStrLn " % smallcaps periods are <chars>"
putStrLn " reset the end-of-sentence markers to <char>"
putStrLn " only punctuation chars are accepted"
putStrLn ""
putStrLn " % smallcaps substitution <mode> <macro>"
putStrLn " reset the macro to be used to mark small caps"
putStrLn " <mode>:"
putStrLn " in block with: {\\small ABC}"
putStrLn " as argument of: \\caps{ABC}"
putStrLn ""
putStrLn " % smallcaps search + <list>"
putStrLn " add macros or environments to the search list"
putStrLn " % smallcaps search - <list>"
putStrLn " remove macros or environments to the search list"
putStrLn " % smallcaps search *"
putStrLn " all macros and environments are searched"
putStrLn " % smallcaps search /"
putStrLn " no macros nor environments are searched"
putStrLn ""
putStrLn " % smallcaps isolate <options as in search>"
putStrLn " isolate the parser state within the macro arguments"
putStrLn " or environment bodies"
putStrLn " write a profile name before '+' or '*' in order to"
putStrLn " use a specific profile for the isolation."
putStrLn " % smallcaps skip <options as in search>"
putStrLn " skip the following contents until the macro argument"
putStrLn " or the environment ends"
putStrLn " % smallcaps unskip <options as in search>"
putStrLn " undo skip"
putStrLn " % smallcaps eos <options as in search>"
putStrLn " starts a new sentence after the macro or environemt"
putStrLn ""
putStrLn " % smallcaps except <word>"
putStrLn " exclude word from processing"
putStrLn " % smallcaps except <word> put <string>"
putStrLn " exclude word from processing and replace it with string"
putStrLn ""
putStrLn " <list> is a comma-separated list of macro names including"
putStrLn " backslash ('\\') and environment names.\n"
putVersion :: IO ()
putVersion = putStrLn =<< fmap (++ " with SmallCaps library v" ++ showVersion version) getProgName