<commit_before>module NecroInit.Cli.Native where

#include <haskell>
import Paths_necromancy_tool
import Control.Error.Extensions
import Data.Tes3
import Data.Tes3.Get
import Data.Tes3.Put

necroInitHelpHeader :: String
necroInitHelpHeader
  =  "Usage: A1_Necromancy_init [OPTION]...\n"
  ++ "Scan the game directory and prepare necessary data files and plugins.\n"

necroInitHelpFooter :: String
necroInitHelpFooter
  =  "\nReport bugs to <<EMAIL>> (in English or Russian)."
  ++ "\nA1_Necromancy home page: <https://github.com/A1-Triard/necromancy>"

necroInitUsageErrorFooter :: String
necroInitUsageErrorFooter
  = "Try `A1_Necromancy_init --help' for more information."

data NecroInitOptions = NecroInitOptions
  { optRootDir :: Maybe String
  , optShowVersion :: Bool
  , optShowHelp :: Bool
  }

defaultNecroInitOptions :: NecroInitOptions
defaultNecroInitOptions = NecroInitOptions
  { optRootDir = Nothing
  , optShowVersion = False
  , optShowHelp = False
  }

necroInitOptionsDescr :: [OptDescr (NecroInitOptions -> NecroInitOptions)]
necroInitOptionsDescr =
  [ Option ['i'] ["install-path"] (ReqArg (\i o -> o {optRootDir = Just i}) "DIR") "the game install path"
  , Option ['V'] ["version"] (NoArg (\o -> o {optShowVersion = True})) "display the version number and exit"
  , Option ['h'] ["help"] (NoArg (\o -> o {optShowHelp = True})) "display this help and exit"
  ]

necroInitOptions :: [String] -> (NecroInitOptions, [String])
necroInitOptions args =
  let (options, tail, errors) = getOpt Permute necroInitOptionsDescr args in
  (foldl (flip id) defaultNecroInitOptions options, if null errors && not (null tail) then ["Unexpected trailing arguments.\n"] else errors)

necroInit :: IO ()
necroInit = do
  args <- getArgs
  process_options $ necroInitOptions args
  where
    process_options (options, errors)
      | optShowHelp options = putStrLn $ usageInfo necroInitHelpHeader necroInitOptionsDescr ++ necroInitHelpFooter
      | optShowVersion options = putStrLn $ "A1_Necromancy_init " ++ showVersion version
      | not $ null errors = hPutStrLn stderr $ concat errors ++ necroInitUsageErrorFooter
      | otherwise = printErrorsAndExit necroInitErrorText $ necroInitRun (optRootDir options)

printErrorsAndExit :: (e -> String) -> ExceptT e IO () -> IO ()
printErrorsAndExit error_text action = do
  result <- runExceptT action
  case result of
    Left e -> do
      handle (\x -> let _ = x :: IOError in return ()) $ hPutStrLn stderr $ error_text e
      exitFailure
    Right _ ->
      exitSuccess

necroInitErrorText :: IOError -> String
necroInitErrorText e
  | isUserError e = ioeGetErrorString e
  | isDoesNotExistError e = fromMaybe "" (ioeGetFileName e) ++ ": No such file or directory"
  | otherwise = ioeGetErrorString e

#ifdef mingw32_HOST_OS
dir :: String
dir = "\\"

getFullPath :: Maybe String -> FilePath -> FilePath
getFullPath Nothing path = path
getFullPath (Just game_dir) path =
  let game_path = process game_dir in
  if null game_path then path else game_path ++ "\\" ++ path
  where
    process = removeTrailingBackslashes . removeQuotes
    removeQuotes s
      | startswith "\"" s && endswith "\"" s = take (length s - 2) $ drop 1 $ s
      | otherwise = s
    removeTrailingBackslashes s =
      fromMaybe "" $ listToMaybe $ dropWhile (endswith "\\") $ iterate (\x -> take (length x - 1) x) s
#else
dir :: String
dir = "/"

getFullPath :: Maybe String -> FilePath -> FilePath
getFullPath Nothing path = path
getFullPath (Just game_dir) path
  | null game_dir = path
  | game_dir == "/" = "/" ++ path
  | otherwise = game_dir ++ "/" ++ path
#endif

fromCP1251 :: String -> String
fromCP1251 =
  map (\c -> fromMaybe c $ lookup c table)
  where
    table = zip ['\192'..'\255'] ['А'..'я']

catchIniParserError :: CF.CPError -> IOError
catchIniParserError (CF.ParseError s, loc) = userError $ "Invalid Morrrowind.ini (" ++ s ++ ", " ++ loc ++ ")."
catchIniParserError (CF.NoSection s, loc) = userError $ "Cannot find section " ++ s ++ " in Morrrowind.ini (" ++ loc ++ ")."
catchIniParserError (CF.NoOption s, loc) = userError $ "Cannot find option " ++ s ++ " in Morrrowind.ini (" ++ loc ++ ")."
catchIniParserError (_, loc) = userError $ "Unknown error while parsing Morrrowind.ini (" ++ loc ++ ")."

gameFilesSection :: String
gameFilesSection = "Game Files"

dataFiles :: String
dataFiles = "Data Files" ++ dir

npcsDir :: String
npcsDir = dataFiles ++ "NPCs"

npcsFiles :: String
npcsFiles = npcsDir ++ dir

data GameFile = GameFile
  { fileName :: String
  , fileTime :: UTCTime
  }

isMasterFile :: GameFile -> Bool
isMasterFile = endswith ".esm" . map toLower . fileName

isPluginFile :: GameFile -> Bool
isPluginFile = endswith ".esp" . map toLower . fileName

instance Eq GameFile where
  a == b = fileName a == fileName b

instance Ord GameFile where
  a <= b
    | isMasterFile a && isPluginFile b = True
    | isPluginFile a && isMasterFile b = False
    | fileTime a < fileTime b = True
    | fileTime a > fileTime b = False
    | otherwise = fileName a <= fileName b

getGameFiles :: Maybe String -> ExceptT IOError IO [String]
getGameFiles game_dir = do
  let ini_path = getFullPath game_dir "Morrowind.ini"
  bracketE (tryIO $ openFile ini_path ReadMode) (tryIO . hClose) $ \ini_file -> do
    tryIO $ hSetEncoding ini_file char8
    ini <- withExceptT catchIniParserError $ (hoistEither =<<) $ lift $ CF.readhandle CF.emptyCP { CF.optionxform = id } ini_file
    ini_files <- withExceptT catchIniParserError $ hoistEither $ CF.options ini gameFilesSection
    raw_files <- forM ini_files $ withExceptT catchIniParserError . hoistEither . CF.simpleAccess ini gameFilesSection
    return [fromCP1251 f | f <- raw_files]

getGameFileData :: Maybe String -> String -> ExceptT IOError IO GameFile
getGameFileData game_dir file_name = do
  m <- tryIO $ getModificationTime $ getFullPath game_dir $ dataFiles ++ file_name
  return $ GameFile file_name m

necroInitRun :: Maybe String -> ExceptT IOError IO ()
necroInitRun game_dir = do
  file_names <- getGameFiles game_dir
  files <- (sort <$>) $ forM file_names $ getGameFileData game_dir
  tryIO $ createDirectoryIfMissing True $ getFullPath game_dir npcsDir
  hr <- scanNPCs game_dir files
  hm <- scanBodyParts game_dir files $ M.fromList [(x, Nothing) | x <- V.toList hr]
  let (bad_hm, good_hm) = M.mapEither splitMap hm
  if not $ M.null bad_hm
    then throwE $ userError $ "Cannot find models for the following body parts: " ++ intercalate ", " [T.unpack (fst x) | x <- M.toList bad_hm] ++ "."
    else generateHairsPlugin game_dir $ V.map (mapModl good_hm) hr
  where
    splitMap :: Maybe Text -> Either () Text
    splitMap Nothing = Left ()
    splitMap (Just modl) = Right modl
    mapModl :: Map Text Text -> Text -> Text
    mapModl m h =
      case M.lookup h m of
        Nothing -> error "mapModl"
        Just x -> x

scanNPCs :: Maybe String -> [GameFile] -> ExceptT IOError IO (Vector Text)
scanNPCs game_dir files =
  hairs <$> go files (Hairs V.empty M.empty)
  where
    go [] hs = return hs
    go (file : tail) hs = do
      let file_path = getFullPath game_dir (dataFiles ++ fileName file)
      hr <- bracketE (tryIO $ openBinaryFile file_path ReadMode) (tryIO . hClose) $ \h -> do
        (a, b) <- runConduit $ (N.sourceHandle h =$= t3RecordsSource (fileName file)) `fuseBoth` npcsSink game_dir hs
        case (a, b) of
          (Nothing, Right hn) -> return hn
          (Just e, _) -> throwE e
          (_, Left e) -> throwE e
      go tail hr

scanBodyParts :: Maybe String -> [GameFile] -> Map Text (Maybe Text) -> ExceptT IOError IO (Map Text (Maybe Text))
scanBodyParts game_dir files p =
  go files p
  where
    go [] hs = return hs
    go (file : tail) hs = do
      let file_path = getFullPath game_dir (dataFiles ++ fileName file)
      hr <- bracketE (tryIO $ openBinaryFile file_path ReadMode) (tryIO . hClose) $ \h -> do
        (a, b) <- runConduit $ (N.sourceHandle h =$= t3RecordsSource (fileName file)) `fuseBoth` bodyPartsSink hs
        case (a, b) of
          (Nothing, Right hn) -> return hn
          (Just e, _) -> throwE e
          (_, Left e) -> throwE e<commit_msg>ale_clothing_v1_1C<commit_after>module NecroInit.Cli.Native where

#include <haskell>
import Paths_necromancy_tool
import Control.Error.Extensions
import Data.Tes3
import Data.Tes3.Get
import Data.Tes3.Put

necroInitHelpHeader :: String
necroInitHelpHeader
  =  "Usage: A1_Necromancy_init [OPTION]...\n"
  ++ "Scan the game directory and prepare necessary data files and plugins.\n"

necroInitHelpFooter :: String
necroInitHelpFooter
  =  "\nReport bugs to <<EMAIL>> (in English or Russian)."
  ++ "\nA1_Necromancy home page: <https://github.com/A1-Triard/necromancy>"

necroInitUsageErrorFooter :: String
necroInitUsageErrorFooter
  = "Try `A1_Necromancy_init --help' for more information."

data NecroInitOptions = NecroInitOptions
  { optRootDir :: Maybe String
  , optShowVersion :: Bool
  , optShowHelp :: Bool
  }

defaultNecroInitOptions :: NecroInitOptions
defaultNecroInitOptions = NecroInitOptions
  { optRootDir = Nothing
  , optShowVersion = False
  , optShowHelp = False
  }

necroInitOptionsDescr :: [OptDescr (NecroInitOptions -> NecroInitOptions)]
necroInitOptionsDescr =
  [ Option ['i'] ["install-path"] (ReqArg (\i o -> o {optRootDir = Just i}) "DIR") "the game install path"
  , Option ['V'] ["version"] (NoArg (\o -> o {optShowVersion = True})) "display the version number and exit"
  , Option ['h'] ["help"] (NoArg (\o -> o {optShowHelp = True})) "display this help and exit"
  ]

necroInitOptions :: [String] -> (NecroInitOptions, [String])
necroInitOptions args =
  let (options, tail, errors) = getOpt Permute necroInitOptionsDescr args in
  (foldl (flip id) defaultNecroInitOptions options, if null errors && not (null tail) then ["Unexpected trailing arguments.\n"] else errors)

necroInit :: IO ()
necroInit = do
  args <- getArgs
  process_options $ necroInitOptions args
  where
    process_options (options, errors)
      | optShowHelp options = putStrLn $ usageInfo necroInitHelpHeader necroInitOptionsDescr ++ necroInitHelpFooter
      | optShowVersion options = putStrLn $ "A1_Necromancy_init " ++ showVersion version
      | not $ null errors = hPutStrLn stderr $ concat errors ++ necroInitUsageErrorFooter
      | otherwise = printErrorsAndExit necroInitErrorText $ necroInitRun (optRootDir options)

printErrorsAndExit :: (e -> String) -> ExceptT e IO () -> IO ()
printErrorsAndExit error_text action = do
  result <- runExceptT action
  case result of
    Left e -> do
      handle (\x -> let _ = x :: IOError in return ()) $ hPutStrLn stderr $ error_text e
      exitFailure
    Right _ ->
      exitSuccess

necroInitErrorText :: IOError -> String
necroInitErrorText e
  | isUserError e = ioeGetErrorString e
  | isDoesNotExistError e = fromMaybe "" (ioeGetFileName e) ++ ": No such file or directory"
  | otherwise = ioeGetErrorString e

#ifdef mingw32_HOST_OS
dir :: String
dir = "\\"

getFullPath :: Maybe String -> FilePath -> FilePath
getFullPath Nothing path = path
getFullPath (Just game_dir) path =
  let game_path = process game_dir in
  if null game_path then path else game_path ++ "\\" ++ path
  where
    process = removeTrailingBackslashes . removeQuotes
    removeQuotes s
      | startswith "\"" s && endswith "\"" s = take (length s - 2) $ drop 1 $ s
      | otherwise = s
    removeTrailingBackslashes s =
      fromMaybe "" $ listToMaybe $ dropWhile (endswith "\\") $ iterate (\x -> take (length x - 1) x) s
#else
dir :: String
dir = "/"

getFullPath :: Maybe String -> FilePath -> FilePath
getFullPath Nothing path = path
getFullPath (Just game_dir) path
  | null game_dir = path
  | game_dir == "/" = "/" ++ path
  | otherwise = game_dir ++ "/" ++ path
#endif

fromCP1251 :: String -> String
fromCP1251 =
  map (\c -> fromMaybe c $ lookup c table)
  where
    table = zip ['\192'..'\255'] ['А'..'я']

catchIniParserError :: CF.CPError -> IOError
catchIniParserError (CF.ParseError s, loc) = userError $ "Invalid Morrrowind.ini (" ++ s ++ ", " ++ loc ++ ")."
catchIniParserError (CF.NoSection s, loc) = userError $ "Cannot find section " ++ s ++ " in Morrrowind.ini (" ++ loc ++ ")."
catchIniParserError (CF.NoOption s, loc) = userError $ "Cannot find option " ++ s ++ " in Morrrowind.ini (" ++ loc ++ ")."
catchIniParserError (_, loc) = userError $ "Unknown error while parsing Morrrowind.ini (" ++ loc ++ ")."

gameFilesSection :: String
gameFilesSection = "Game Files"

dataFiles :: String
dataFiles = "Data Files" ++ dir

npcsDir :: String
npcsDir = dataFiles ++ "NPCs"

npcsFiles :: String
npcsFiles = npcsDir ++ dir

data GameFile = GameFile
  { fileName :: String
  , fileTime :: UTCTime
  }

isMasterFile :: GameFile -> Bool
isMasterFile = endswith ".esm" . map toLower . fileName

isPluginFile :: GameFile -> Bool
isPluginFile = endswith ".esp" . map toLower . fileName

instance Eq GameFile where
  a == b = fileName a == fileName b

instance Ord GameFile where
  a <= b
    | isMasterFile a && isPluginFile b = True
    | isPluginFile a && isMasterFile b = False
    | fileTime a < fileTime b = True
    | fileTime a > fileTime b = False
    | otherwise = fileName a <= fileName b

getGameFiles :: Maybe String -> ExceptT IOError IO [String]
getGameFiles game_dir = do
  let ini_path = getFullPath game_dir "Morrowind.ini"
  bracketE (tryIO $ openFile ini_path ReadMode) (tryIO . hClose) $ \ini_file -> do
    tryIO $ hSetEncoding ini_file char8
    ini <- withExceptT catchIniParserError $ (hoistEither =<<) $ lift $ CF.readhandle CF.emptyCP { CF.optionxform = id } ini_file
    ini_files <- withExceptT catchIniParserError $ hoistEither $ CF.options ini gameFilesSection
    raw_files <- forM ini_files $ withExceptT catchIniParserError . hoistEither . CF.simpleAccess ini gameFilesSection
    return [fromCP1251 f | f <- raw_files]

getGameFileData :: Maybe String -> String -> ExceptT IOError IO GameFile
getGameFileData game_dir file_name = do
  m <- tryIO $ getModificationTime $ getFullPath game_dir $ dataFiles ++ file_name
  return $ GameFile file_name m

necroInitRun :: Maybe String -> ExceptT IOError IO ()
necroInitRun game_dir = do
  file_names <- getGameFiles game_dir
  files <- (sort <$>) $ forM file_names $ getGameFileData game_dir
  tryIO $ createDirectoryIfMissing True $ getFullPath game_dir npcsDir
  hr <- scanNPCs game_dir files
  hm <- scanBodyParts game_dir files $ M.fromList [(x, Nothing) | x <- V.toList hr]
  generateHairsPlugin game_dir $ V.map (mapModl hm) hr
  where
    mapModl :: Map Text (Maybe Text) -> Text -> Text
    mapModl m h =
      case M.lookup h m of
        Nothing -> error "mapModl"
        Just Nothing -> "b\\B_N_Wood Elf_M_Hair_06.NIF"
        Just (Just x) -> x

scanNPCs :: Maybe String -> [GameFile] -> ExceptT IOError IO (Vector Text)
scanNPCs game_dir files =
  hairs <$> go files (Hairs V.empty M.empty)
  where
    go [] hs = return hs
    go (file : tail) hs = do
      let file_path = getFullPath game_dir (dataFiles ++ fileName file)
      hr <- bracketE (tryIO $ openBinaryFile file_path ReadMode) (tryIO . hClose) $ \h -> do
        (a, b) <- runConduit $ (N.sourceHandle h =$= t3RecordsSource (fileName file)) `fuseBoth` npcsSink game_dir hs
        case (a, b) of
          (Nothing, Right hn) -> return hn
          (Just e, _) -> throwE e
          (_, Left e) -> throwE e
      go tail hr

scanBodyParts :: Maybe String -> [GameFile] -> Map Text (Maybe Text) -> ExceptT IOError IO (Map Text (Maybe Text))
scanBodyParts game_dir files p =
  go files p
  where
    go [] hs = return hs
    go (file : tail) hs = do
      let file_path = getFullPath game_dir (dataFiles ++ fileName file)
      hr <- bracketE (tryIO $ openBinaryFile file_path ReadMode) (tryIO . hClose) $ \h -> do
        (a, b) <- runConduit $ (N.sourceHandle h =$= t3RecordsSource (fileName file)) `fuseBoth` bodyPartsSink hs
        case (a, b) of
          (Nothing, Right hn) -> return hn
          (Just e, _) -> throwE e
          (_, Left e) -> throwE e
{'fraction_non_alphanumeric': 0.11193004372267333, 'fraction_numerical': 0.004497189256714554, 'mean_word_length': 3.491164095371669, 'pattern_counts': {'":': 2, '<': 58, '<?xml version=': 0, '>': 107, 'https://': 2, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7432074', 'n_tokens_mistral': 5322, 'n_tokens_neox': 5180, 'n_words': 1632}