summaryrefslogtreecommitdiff
path: root/indexing/hsindex/src/hsindex.hs
diff options
context:
space:
mode:
Diffstat (limited to 'indexing/hsindex/src/hsindex.hs')
-rw-r--r--indexing/hsindex/src/hsindex.hs395
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
+
+
+
+
+
+
+
+