diff options
Diffstat (limited to 'indexing/hsindex/src/hsindex.hs')
-rw-r--r-- | indexing/hsindex/src/hsindex.hs | 395 |
1 files changed, 395 insertions, 0 deletions
diff --git a/indexing/hsindex/src/hsindex.hs b/indexing/hsindex/src/hsindex.hs new file mode 100644 index 0000000000..bee37119cf --- /dev/null +++ b/indexing/hsindex/src/hsindex.hs @@ -0,0 +1,395 @@ +-- | +-- Module : HsIndex.Files +-- Copyright : Jean-Luc JOULIN 2018-2020 +-- License : General Public Licence (GPLv3) +-- Maintainer : Jean-Luc JOULIN <jean-luc-joulin@orange.fr> +-- Stability : alpha +-- Portability : portable +-- The Main program for the index generator +-- + + +import Prelude hiding (getContents, putStrLn) + + + +import Control.Monad + +import Data.Char +import Data.Function +import Data.List +import Data.Maybe +import Data.Ord +import Debug.Trace +import GHC.IO.Encoding -- solve bug commitBuffer: invalid argument (invalid character) +import HsIndex.CharLists.English +import HsIndex.CharLists.French +import HsIndex.CharLists.German +import HsIndex.CharLists.Russian +import HsIndex.Files +import HsIndex.Functions +import HsIndex.Parser +import HsIndex.Show +import HsIndex.Sorting +import HsIndex.Types +import qualified Prelude (getContents, putStrLn) +import System.Console.CmdArgs.Explicit +import System.Console.CmdArgs.Text +import System.Environment +import System.Exit +import System.IO +import Text.Parsec +import Text.Printf + +import System.Directory +import System.FilePath + + +-- | The ASCII art for the CLI title. +logo = + [ + " _ _ _____ _____ __ __ " + , " | | | | |_ _| | __ \\ \\ \\ / / " + , " | |__| |___ | | _ __ | | | | ___ \\ V / " + , " | __ / __| | | | '_ \\| | | |/ _ \\ > < " + , " | | | \\__ \\_| |_| | | | |__| | __// . \\ " + , " |_| |_|___/_____|_| |_|_____/ \\___/_/ \\_\\ " + ] + + +-- | Available options for the CLI. +data MyModes = + + IndexRussian { fileIn :: FilePath -- ^ The input file + , fileOut :: FilePath -- ^ The output file + , fileStyle :: IndexType -- ^ The style type + , autoRange :: Bool + , caseSens :: Bool + } + | IndexFrench { fileIn :: FilePath + , fileOut :: FilePath + , fileStyle :: IndexType -- ^ The style type + , autoRange :: Bool + , caseSens :: Bool + } + | IndexGerman { fileIn :: FilePath + , fileOut :: FilePath + , fileStyle :: IndexType -- ^ The style type + , autoRange :: Bool + , caseSens :: Bool + } + | IndexEnglish { fileIn :: FilePath + , fileOut :: FilePath + , fileStyle :: IndexType -- ^ The style type + , autoRange :: Bool + , caseSens :: Bool + } + | IndexCustom { fileIn :: FilePath + , fileOut :: FilePath + , fileStyle :: IndexType -- ^ The style type + , autoRange :: Bool + , caseSens :: Bool + , fileDef :: FilePath + } + | IndexCheck { checkInternalStyle :: Bool + , checkLanguageDef :: Maybe String + } + + | ArgHelp + | ArgVersion + + +-- | The basic options for English language. +initialOptsIndexEnglish = IndexEnglish "" "" StyleBasic False True + +-- | The basic options for French language. +initialOptsIndexFrench = IndexFrench "" "" StyleBasic False True + +-- | The basic options for German language. +initialOptsIndexGerman = IndexGerman "" "" StyleBasic False True + +-- | The basic options for Russian language. +initialOptsIndexRussian = IndexRussian "" "" StyleBasic False True + +-- | The basic options for custom language. +initialOptsIndexCustom = IndexCustom "" "" StyleBasic False True "" + +-- | The basic options for cheking the program. +initialOptsCheck = IndexCheck False Nothing + + +-- | The cli mode for English language. +modeGenIndexEnglish :: Mode MyModes +modeGenIndexEnglish = mode "english" initialOptsIndexEnglish description unnamedArg convertFlags + where + description = "Generate a English index" + unnamedArg = Arg { argValue = updateUnnamed, argType = "", argRequire = False } + where updateUnnamed str opts = Left ("Error unknown argument : " ++ str) + + convertFlags = + [ flagReq ["input", "i"] setInputFile "<File>" "Input file" + , flagReq ["output", "o"] setOutpuFile "<File>" "Output file" + , flagReq ["style", "s"] setStyleFile "<File>" "Style file" + , flagNone ["range"] setRange "Convert sequences of page into range" + , flagNone ["nocase"] setNoCase "Case insensitive ordering" + , flagNone ["dbl"] setDblHeader "Two letters headers" + ] + +-- | The cli mode for French language. +modeGenIndexFrench :: Mode MyModes +modeGenIndexFrench = mode "french" initialOptsIndexFrench description unnamedArg convertFlags + where + description = "Generate a French index" + unnamedArg = Arg { argValue = updateUnnamed, argType = "", argRequire = False } + where updateUnnamed str opts = Left ("Error unknown argument : " ++ str) + convertFlags = + [ flagReq ["input", "i"] setInputFile "<File>" "Input file" + , flagReq ["output", "o"] setOutpuFile "<File>" "Output file" + , flagReq ["style", "s"] setStyleFile "<File>" "Style file" + , flagNone ["range"] setRange "Convert sequences of page into range" + , flagNone ["nocase"] setNoCase "Case insensitive ordering" + , flagNone ["dbl"] setDblHeader "Two letters headers" + ] + +-- | The cli mode for German language. +modeGenIndexGerman :: Mode MyModes +modeGenIndexGerman = mode "german" initialOptsIndexGerman description unnamedArg convertFlags + where + description = "Generate a German index" + unnamedArg = Arg { argValue = updateUnnamed, argType = "", argRequire = False } + where updateUnnamed str opts = Left ("Error unknown argument : " ++ str) + convertFlags = + [ flagReq ["input", "i"] setInputFile "<File>" "Input file" + , flagReq ["output", "o"] setOutpuFile "<File>" "Output file" + , flagReq ["style", "s"] setStyleFile "<File>" "Style file" + , flagNone ["range"] setRange "Convert sequences of page into range" + , flagNone ["nocase"] setNoCase "Case insensitive ordering" + , flagNone ["dbl"] setDblHeader "Two letters headers" + ] + +-- | The cli mode for Russian language. +modeGenIndexRussian :: Mode MyModes +modeGenIndexRussian = mode "russian" initialOptsIndexRussian description unnamedArg convertFlags + where + description = "Generate a Russian index" + unnamedArg = Arg { argValue = updateUnnamed, argType = "", argRequire = False } + where updateUnnamed str opts = Left ("Error unknown argument : " ++ str) + convertFlags = + [ flagReq ["input", "i"] setInputFile "<File>" "Input file" + , flagReq ["output", "o"] setOutpuFile "<File>" "Output file" + , flagReq ["style", "s"] setStyleFile "<File>" "Style file" + , flagNone ["range"] setRange "Convert sequences of page into range" + , flagNone ["nocase"] setNoCase "Case insensitive ordering" + , flagNone ["dbl"] setDblHeader "Two letters headers" + ] + +-- | The cli mode for a custom language. +modeGenIndexCustom :: Mode MyModes +modeGenIndexCustom = mode "custom" initialOptsIndexCustom description unnamedArg convertFlags + where + description = "Generate a index with a custom language" + unnamedArg = Arg { argValue = updateUnnamed, argType = "", argRequire = False } + where updateUnnamed str opts = Left ("Error unknown argument : " ++ str) + + convertFlags = + [ flagReq ["input", "i"] setInputFile "<File>" "Input file" + , flagReq ["output", "o"] setOutpuFile "<File>" "Output file" + , flagReq ["style", "s"] setStyleFile "<File>" "Style file" + , flagReq ["def", "d"] setDefFile "<File>" "Definition file" + , flagNone ["range"] setRange "Convert sequences of page into range" + , flagNone ["nocase"] setNoCase "Case insensitive ordering" + , flagNone ["dbl"] setDblHeader "Two letters headers" + ] + +-- | The cli mode for a checking the program. +modeGenCheck :: Mode MyModes +modeGenCheck = mode "check" initialOptsCheck description unnamedArg convertFlags + where + description = "Check the internal parameter of the program" + unnamedArg = Arg { argValue = updateUnnamed, argType = "", argRequire = False } + where updateUnnamed str opts = Left ("Error unknown argument : " ++ str) + + convertFlags = + [ flagNone ["style"] setCheckStyle "Check built-in default style" + , flagReq ["language", "l"] setCheckLanguage "<Lang>" "Check built-in language definition" + ] + + + + +-- | Set the input file. +setInputFile str opts = Right $ opts { fileIn = str } + +-- | Set the output file. +setOutpuFile str opts = Right $ opts { fileOut = str } + +-- | Set the style file. +setStyleFile str opts = Right $ opts { fileStyle = Stylecustom str } + +-- | Set the definition file. +setDefFile str opts = Right $ opts { fileDef = str } + +-- | Enable automatic conversion of pages sequences into ranges. +setRange opts = opts { autoRange = True } + +-- | Enable the checking of the internal default style. +setCheckStyle opts = opts { checkInternalStyle = True } + +-- | Disable case sensitivity in ordering. +setNoCase opts = opts { caseSens = False } + +-- | Enable the two letters defaults header +setDblHeader opts = opts { fileStyle = StyleDouble } + + +-- | Set the language definition to check +setCheckLanguage "english" opts = Right $ opts { checkLanguageDef = Just "english" } +setCheckLanguage "french" opts = Right $ opts { checkLanguageDef = Just "french" } +setCheckLanguage "german" opts = Right $ opts { checkLanguageDef = Just "german" } +setCheckLanguage "russian" opts = Right $ opts { checkLanguageDef = Just "russian" } +setCheckLanguage str opts = Left $ "/!\\ ERROR The language " ++ str ++ " is not recognized" + + +-- | List of all possibles cli modes. +lstModes :: [Mode MyModes] +lstModes = + [ modeGenIndexEnglish + , modeGenIndexFrench + , modeGenIndexGerman + , modeGenIndexRussian + , modeGenIndexCustom + , modeGenCheck + ] + + + +-- | The main cli mode. +-- +-- Contain all the languages modes with the help and version flags. +modesCLI mods = (modes _ProgName ArgHelp "" mods) { modeGroupFlags = toGroup [helpFlag, versionFlag] } + where + helpFlag = flagNone ["help", "h", "?"] (const ArgHelp) "Help message" + versionFlag = flagNone ["version", "V"] (const ArgVersion) "Version informations" + + + +_ProgName = "hsindex" +_ProgDetails = "A program to create indexes for LaTeX and XeTeX" +_Auteur = "(c) Jean-Luc JOULIN 2018-2020" +_Version = "0.12.0" + + +-- | The main function. +main :: IO () +main = do + setLocaleEncoding utf8 -- solve bug commitBuffer: invalid argument (invalid character) + opts <- processArgs $ modesCLI lstModes + outputScreen opts + + +-- | Main function to output result to screen. +outputScreen opts@(IndexEnglish fin fou fsty rng cas ) = do + let fout = if null fou then ((dropExtension fin) ++ ".ind") else fou + readAllFile + fin + fsty + parseIndexFile + (\ent idx -> do + let entc = concatPagesItems ent + ents = sortItems cas langDefEnglish (equivItems True langDefEnglish entc) + entd = splitIndex idx ents + writeIndex fout idx rng entd + ) + +outputScreen opts@(IndexFrench fin fou fsty rng cas ) = do + let fout = if null fou then ((dropExtension fin) ++ ".ind") else fou + readAllFile + fin + fsty + parseIndexFile + (\ent idx -> do + let entc = concatPagesItems ent + ents = sortItems cas langDefFrench (equivItems True langDefFrench entc) + entd = splitIndex idx ents + writeIndex fout idx rng entd + ) + +outputScreen opts@(IndexGerman fin fou fsty rng cas ) = do + let fout = if null fou then ((dropExtension fin) ++ ".ind") else fou + readAllFile + fin + fsty + parseIndexFile + (\ent idx -> do + let entc = concatPagesItems ent + ents = sortItems cas langDefGerman (equivItems True langDefGerman entc) + entd = splitIndex idx ents + writeIndex fout idx rng entd + ) + +outputScreen opts@(IndexRussian fin fou fsty rng cas ) = do + let fout = if null fou then ((dropExtension fin) ++ ".ind") else fou + readAllFile + fin + fsty + parseIndexFile + (\ent idx -> do + let entc = concatPagesItems ent + ents = sortItems cas langDefRussian (equivItems True langDefRussian entc) + entd = splitIndex idx ents + writeIndex fout idx rng entd + ) + +outputScreen opts@(IndexCustom fin fou fsty rng cas fdef) = do + let fout = if null fou then ((dropExtension fin) ++ ".ind") else fou + readDefinitionFile + fdef + (\def -> readAllFile + fin + fsty + parseIndexFile + (\ent idx -> do + let entc = concatPagesItems ent + ents = sortItems cas def { lstLetters = (lstLetters def) } (equivItems True def entc) + entd = splitIndex idx ents + putStrLn $ "Building index with custom language definition" + putStrLn $ showLangDef def + writeIndex fout idx rng entd + ) + ) + +outputScreen opts@(IndexCheck sty mblang ) = do + if sty + then do + putStrLn $ showStyle styleBasic + else putStrLn "" + case mblang of + Nothing -> do + putStrLn "" + Just "english" -> putStrLn $ showLangDef langDefEnglish + Just "french" -> putStrLn $ showLangDef langDefFrench + Just "german" -> putStrLn $ showLangDef langDefGerman + Just "russian" -> putStrLn $ showLangDef langDefRussian + +outputScreen opts@ArgHelp = do + putStrLn $ unlines logo + putStrLn $ " " ++ _ProgDetails + putStrLn $ " " ++ _Auteur + putStrLn $ " Version : " ++ _Version + print $ helpText [] HelpFormatAll (modesCLI lstModes) + exitSuccess + +outputScreen opts@ArgVersion = do + putStrLn $ unlines logo + putStrLn $ " " ++ _ProgDetails + putStrLn $ " " ++ _Auteur + putStrLn $ " Version : " ++ _Version + exitSuccess + + + + + + + + |