"Fossies" - the Fresh Open Source Software Archive

Member "pp-2.14.3/app/pp.hs" (24 Nov 2021, 8242 Bytes) of package /linux/privat/pp-2.14.3.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Haskell source code syntax highlighting (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file. See also the latest Fossies "Diffs" side-by-side code changes report for "pp.hs": 2.14.2_vs_2.14.3.

    1 {- PP
    2 
    3 Copyright (C) 2015-2021 Christophe Delord
    4 
    5 http://cdelord.fr/pp
    6 
    7 This file is part of PP.
    8 
    9 PP is free software: you can redistribute it and/or modify
   10 it under the terms of the GNU General Public License as published by
   11 the Free Software Foundation, either version 3 of the License, or
   12 (at your option) any later version.
   13 
   14 PP is distributed in the hope that it will be useful,
   15 but WITHOUT ANY WARRANTY; without even the implied warranty of
   16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   17 GNU General Public License for more details.
   18 
   19 You should have received a copy of the GNU General Public License
   20 along with PP.  If not, see <http://www.gnu.org/licenses/>.
   21 -}
   22 
   23 import Control.Monad
   24 import Data.List
   25 import Data.Maybe
   26 import System.Environment
   27 import System.Exit
   28 import System.IO
   29 
   30 import ErrorMessages
   31 import Environment
   32 import Formats
   33 import Localization
   34 import Preprocessor
   35 import UTF8
   36 import qualified Version
   37 
   38 exitMacros :: [String]
   39 exitMacros = [ "langs", "formats", "dialects" ]
   40            ++ map show langs
   41            ++ map show formats
   42            ++ map show dialects
   43            ++ [ "os", "arch" ]
   44            ++ [ "macros", "usermacros" ]
   45 
   46 -- The main function builds the initial environment, parses the input
   47 -- and print the output on stdout.
   48 main :: IO ()
   49 main = do
   50     -- work with UTF-8 documents
   51     setUTF8Encoding stdin
   52     setUTF8Encoding stdout
   53     -- parse the arguments and produce the preprocessed output
   54     env <- initialEnvironment (head langs) (head dialects)
   55     unless (checkParserConsistency env) defaultParserConfigurationError
   56     (env', doc) <- getArgs >>= doArgs env
   57     case makeTarget env' of
   58         Just target ->
   59             -- -M option => print dependencies
   60             putStrLn $ target ++ ": " ++ (unwords.nub.reverse) (dependencies env')
   61         _ ->
   62             -- just write the preprocessed output to stdout
   63             putStr doc
   64     -- finally save the literate content (if any)
   65     saveLiterateContent env' (litMacros env') (litFiles env')
   66 
   67 -- "doArgs env args" parses the command line arguments
   68 -- and returns an updated environment and the preprocessed output
   69 doArgs :: Env -> [String] -> IO (Env, String)
   70 
   71 -- Parse all the arguments.
   72 doArgs env (arg:args) = do
   73     (env', doc, args') <- doArg env arg args
   74     (env'', doc') <- doArgs env' args'
   75     return (env'', doc ++ doc')
   76 
   77 -- No more argument
   78 -- mainFileTag is put in the environment only when a file has been preprocessed.
   79 -- This variable is not set when no file is given on the command line.
   80 -- In this case, pp preprocesses stdin.
   81 doArgs env [] = case (mainFile env, ignoreStdin env) of
   82     -- nothing has been preprocessed, let's try stdin
   83     (Nothing, False) -> do
   84         (env', doc, _) <- doArg env "-" []
   85         return (env', doc)
   86     -- something has already been preprocessed
   87     -- or stdin is ignored when some macros are use on the command line
   88     _ -> return (env, "")
   89 
   90 -- "doArg env arg" parses one argument
   91 -- and returns an updated environment, the output produced by the argument and the remaining arguments.
   92 doArg :: Env -> String -> [String] -> IO (Env, String, [String])
   93 
   94 -- "doArg" env "-v" shows the current version of pp
   95 doArg _ "-v" _ = putStrLn Version.copyright >> exitSuccess
   96 
   97 -- "doArg" env "-h" shows a short help message
   98 doArg _ "-h" _ = putStrLn Version.help >> exitSuccess
   99 
  100 -- "doArg" env "-help" show a longer help message
  101 doArg env "-help" _ = putStrLn (longHelp env) >> exitSuccess
  102 
  103 -- "doArg" env "-userhelp" show a longer help message (user macros only)
  104 doArg env "-userhelp" _ = putStrLn (longUserHelp env) >> exitSuccess
  105 
  106 -- "doArg env "-D name=value"" adds a new definition to the environment.
  107 doArg env "-D" (def:args) = return (env{vars=(Def name, Val (drop 1 value)) : clean (Def name) (vars env)}, "", args)
  108     where (name, value) = span (/= '=') def
  109 
  110 -- "doArg env "-Dname=value"" adds a new definition to the environment.
  111 doArg env ('-':'D':def) args = return (env{vars=(Def name, Val (drop 1 value)) : clean (Def name) (vars env)}, "", args)
  112     where (name, value) = span (/= '=') def
  113 
  114 -- "doArg env "-U name"" removes a definition from the environment.
  115 doArg env "-U" (name:args) = return (env{vars=clean (Def name) (vars env)}, "", args)
  116 
  117 -- "doArg env "-Uname"" removes a definition from the environment.
  118 doArg env ('-':'U':name) args = return (env{vars=clean (Def name) (vars env)}, "", args)
  119 
  120 -- "doArg env "-fr|-en"" changes the current language
  121 doArg env ('-':lang) args | isJust maybeLang =
  122     return (env{currentLang=fromJust maybeLang}, "", args) where maybeLang = readCap lang
  123 
  124 -- "doArg env "-html|-pdf|-odt|-epub|-mobi"" changes the current format
  125 doArg env ('-':fmt) args | isJust maybeFmt =
  126     return (env{fileFormat=maybeFmt}, "", args) where maybeFmt = readCap fmt
  127 
  128 -- "doArg env "-md|-rst"" changes the current dialect
  129 doArg env ('-':dial) args | isJust maybeDial =
  130     return (env{currentDialect=fromJust maybeDial}, "", args) where maybeDial = readCap dial
  131 
  132 -- "doArg env "-img prefix"" changes the output image path prefix
  133 doArg env "-img" (prefix:args) =
  134     return (env{imagePath=prefix}, "", args)
  135 
  136 -- "doArg env "-img=prefix"" changes the output image path prefix
  137 doArg env ('-':'i':'m':'g':'=':prefix) args =
  138     return (env{imagePath=prefix}, "", args)
  139 
  140 -- "doArg env "-import name" preprocesses a file and discards its output
  141 -- It can be used to load macro definitinos for instance
  142 doArg env "-import" (name:args) = do
  143     (env', _) <- ppFile env{currentFile=Just name} name
  144     return (env', "", args)
  145 
  146 -- "doArg env "-import=name" preprocesses a file and discards its output
  147 -- It can be used to load macro definitinos for instance
  148 doArg env ('-':'i':'m':'p':'o':'r':'t':'=':name) args = do
  149     (env', _) <- ppFile env{currentFile=Just name} name
  150     return (env', "", args)
  151 
  152 -- "doArg" env "-M" target enables the tracking of dependencies (i.e. included and imported files)
  153 -- target is the name of the Makefile target
  154 doArg env "-M" (target:args) =
  155     return (env{makeTarget=Just target}, "", args)
  156 
  157 -- "doArg" env "-M=target" enables the tracking of dependencies (i.e. included and imported files)
  158 -- target is the name of the Makefile target
  159 doArg env ('-':'M':'=':target) args =
  160     return (env{makeTarget=Just target}, "", args)
  161 
  162 -- "doArg" env "-plantuml" <path to plantuml.jar> uses a specific plantuml.jar instead of the embedded one
  163 doArg env "-plantuml" (plantumlJar:args) =
  164     return (env{customPlantuml=Just plantumlJar}, "", args)
  165 
  166 -- "doArg" env "-plantuml=<path to plantuml.jar>" uses a specific plantuml.jar instead of the embedded one
  167 doArg env ('-':'p':'l':'a':'n':'t':'u':'m':'l':'=':plantumlJar) args =
  168     return (env{customPlantuml=Just plantumlJar}, "", args)
  169 
  170 -- "doArg" env "-ditaa" <path to ditaa.jar> uses a specific ditaa.jar instead of the embedded one
  171 doArg env "-ditaa" (ditaaJar:args) =
  172     return (env{customDitaa=Just ditaaJar}, "", args)
  173 
  174 -- "doArg" env "-ditaa=<path to ditaa.jar>" uses a specific ditaa.jar instead of the embedded one
  175 doArg env ('-':'d':'i':'t':'t':'a':'=':ditaaJar) args =
  176     return (env{customDitaa=Just ditaaJar}, "", args)
  177 
  178 doArg env ('-':arg) args
  179     | not (null arg) = case maybeMacro of
  180         -- Macros can be called from the command line
  181         Just _ -> do
  182             (env', s) <- pp env code
  183             let env'' = env'{ignoreStdin = ignoreStdin env' || name `elem` exitMacros}
  184             return (env'', if null s then s else s++"\n", args)
  185         -- Other arguments starting with "-" are invalid.
  186         Nothing -> errorWithoutStackTrace $ "Unexpected argument: " ++ arg
  187     where
  188         (functor, params') = span (/='=') arg
  189         (name, params) = span isValidMacroNameChar functor
  190         code = head (macroChars env) : name
  191                ++ params
  192                ++ if not (null params')
  193                 then replicate 70 '~' ++ params' ++ replicate 70 '~'
  194                 else ""
  195         maybeMacro = lookupMacro name builtin
  196 
  197 -- "doArg env filename" preprocessed the content of a file using the current environment.
  198 -- The mainFileTag variable is added to the environment.
  199 -- It contains the name of the file being preprocessed.
  200 doArg env name args = do
  201     (env', doc) <- ppFile env{mainFile=Just name} name
  202     return (env', doc, args)