From 2277a8a59f82857e99537c33f94dd13dc58ada08 Mon Sep 17 00:00:00 2001 From: hashirama Date: Fri, 12 Sep 2025 21:36:11 -0400 Subject: [PATCH] fix & update --- README.md | 23 +--- examples/Main.hi | Bin 0 -> 3053 bytes examples/Main.hs | 9 +- examples/Main.o | Bin 0 -> 4424 bytes src/FileUtils.hs | 180 ------------------------- src/IconToolbar.hs | 290 ----------------------------------------- src/KanaConv.hs | 36 ----- src/Wazahs.hi | Bin 0 -> 3375 bytes src/Wazahs.hs | 19 +++ src/Wazahs.hs~ | 19 +++ src/Wazahs.o | Bin 0 -> 8152 bytes src/getDictionaries.hs | 51 -------- src/getIcons.hs | 161 ----------------------- src/make_package.hs | 208 ----------------------------- 14 files changed, 46 insertions(+), 950 deletions(-) create mode 100644 examples/Main.hi create mode 100644 examples/Main.o delete mode 100644 src/FileUtils.hs delete mode 100644 src/IconToolbar.hs delete mode 100644 src/KanaConv.hs create mode 100644 src/Wazahs.hi create mode 100644 src/Wazahs.hs create mode 100644 src/Wazahs.hs~ create mode 100644 src/Wazahs.o delete mode 100644 src/getDictionaries.hs delete mode 100644 src/getIcons.hs delete mode 100644 src/make_package.hs diff --git a/README.md b/README.md index af69d0e..a24bb0e 100644 --- a/README.md +++ b/README.md @@ -5,26 +5,9 @@ wazajisho library for handling japanese text in haskell cover -### FileUtils.h -for managing dictionaries we have a custom data structure, and you can use it that way: - -```haskell --- Access all directories in the list of FileGroups -let directories = map directory fileGroups -print directories -- ["/mnt/data1", "/mnt/data2"] - --- Access all file lists in the list of FileGroups -let filesList = map files fileGroups -print filesList -- [["file1.mdx", "file2.css"], ["file3.mdx", "file4.png"]] - --- Filter the FileGroups where any file in the files list contains ".mdx" -let mdict_filter = filter (\group -> any (isSuffixOf ".mdx") (files group)) fileGroups - --- Access all files of the filtered FileGroups -let mdict_files = map files mdict_files +### usage: +``` shell +$ ghc -o myprog examples/Main.hs -i./src ``` -you can for example, pass that list as a parameter for loading all of those dictionaries in [mdict-cpp](https://github.com/dictlab/mdict-cpp) - -TODO: move those functions to be some kind of helpers or operators \ No newline at end of file diff --git a/examples/Main.hi b/examples/Main.hi new file mode 100644 index 0000000000000000000000000000000000000000..b46653b79ae75bd28d8b2c9a46de3452ac0aeb18 GIT binary patch literal 3053 zcmaJ?dsGzX6~9Y|R|MrDKEMcRjizmO++CJe-|WJ|3JVLnywc~e^RYWPJG0Ep3d|P*i5eTz%1P3uwvtwpv{72pTC3I^8c(7&IWe}rqcuj+grpuJJ>~R%GwcE}r~8=Q z@4oN--FrXNN5^=k!eT22fCb|KNt5`!0bm07^RG^hpS}F{=y$gr894X;^tsLEmmc5q z)adOGCto#fy8ZK8Ti<(SuE?58=kO>Q65oAF&vAK zghD8Sdyrr7X(;#%6s&@Rd!b-86s&=q`yl_bQ1m${`aI;{56NaoVIhAlEVIB0D=;=- zitWJQrv#W%V9J0g2c`m;F97pJV7>&*mx1{TFkc1cYrs?j;{e79OcgNIkm7=r8c3;y zR5zrqgS0wGtA{iXq%}ZVBcypDy$Q0KAXg>wvrmAn)st_YGL` zO<4Xd8W~1e_-!cs4is@v)ColaJ!l?Flhl|Dz>ueR{`=C!gL^0C(F;>AY}xt5=4TKr zV7i`t#}y?!)8n+upw(y8kcrqMraxwiGA)0f9gU`jgn`Uk%}y?^A_`A7c#gA)@+kG z=Fx2vgOj^W8=pRV^S4(|pKsTV97_IRVBiYMU|*m!>JDE?e}l29+wTsZ-}N)$`TY~; z9y<8oiz{bXmni=#ecXT~-8Ox6Uk4`42@>PMM@k#l&xO=XPEoj+*}|5vcGkjlaw=Ka zDM*|`Y2|DMYsu}5X++f&K?)+tYNc|k0>Q zdSapa92C;f6H!!DEJY7imgh9iY`COmsX-RMW|y_M&QWSBwmI!3B^_?T(bL@TtXRYo z5>ZJHy0N1HYc?+^B%sL{9CcjE+OkPsfJ8JwmZ%S_g|%mO2_lJbT1Z#2v9>jH2zruc zJLhh6db`&(#;gu0T-3CTyV9DZ?}^=E~k0RrJQXni@!zv$n0QP4-w? zTUIMXm7_|4P#A1%sd-%mX zWu3j!-rri1*#TC_az91ElVTeh{z#2nCp5XiWwT|GkhRFQxn28d29rHFUAZd zwM$mQ2FfKAl#Hk(^r5vfn$G=ENff#eA#*@hXi7E;x!Kk$HWS6`3AK>o%8nYrqjog* zOZKQFD?CvMkJ59R2X!j2OKSOmqG^`shG0`&liXC-)*lF4gw-4Lo}l>C6s=}=PnV;9 zy~kJS>Zy=Dn%_~`Q_eM5X2du#C@X>%3e%1$$Asvz=^sKx1aRp z7nE(0I^{mXFP}?uMO7R&))AF>k)$V-4LygxIO0y0>Rbnoxli97s3eF8?i`oCkldT? zM5Gm2WIeLP@vP79Sw5fQr!B@-D~hb7*VH;$mnd^u8vWz3!B5O>K^Z+CEM6C|Qq`EgyuOVJW+Lm6vLuYv>> zi>edyb>%y_ULit^GGZVeE|Sno5Pf9UShj9tu9z`%KGG8@7!8#L()?d|mMuR8j$SHEFYD7$N#ukn5 zc>}u!S!#%iVjO)VSaoTQ*$Sq)#96GfeK z?|jF`L^aP`ABh^~$8%>fPrCS7e=X~a;U4ZY#(}0k7mHcy+`=2}Z|o35VrHKtA~W)x zq55zT=>=)zJAd`)6K>3gOBQ)5mg-fA80AU2FQ(!}g`KZ21=`GNx+tic3-5n5eU+wo Ja5_Z-{{yhI7e4?1 literal 0 HcmV?d00001 diff --git a/examples/Main.hs b/examples/Main.hs index 7146c80..8a92753 100644 --- a/examples/Main.hs +++ b/examples/Main.hs @@ -1,7 +1,8 @@ -import KanaConv (convertHalfToFull) +module Main where + +import Wazahs (listFiles) main :: IO () main = do - let input = "おいそこのｷﾐ｡あっはいはいはいは～い｡" - let output = convertHalfToFull input - putStrLn output + files <- listFiles "/mnt/Data/Japanese_Resources/Dictionaries/Own_Collection/" + mapM_ putStrLn files diff --git a/examples/Main.o b/examples/Main.o new file mode 100644 index 0000000000000000000000000000000000000000..5123f7623870172b0ab0d542ac2c3187cb149167 GIT binary patch literal 4424 zcmeH~U1%It6vuCpR-?8ytzQ)>u2dAPZrX^_s@P5Q(cO|wHHjD^Wjeb%*{tr)3^TJP zSp|hqY=lAtAAGE$FQtegLQ&8>q~_5)=0QZCtWaTn%YzWlf99Oc&A1bb&mNdP=lt?$Z@@Xbu+p8qupAuO8fj=Fw>tRf26}Us$jB}Juzk?Y!@1Q97b#^AxuAlj-DF_C zyXb<*H1mti@6iq`*Xj>zZ(sL1<~_DksZZ;rMoEdRV;s`Iu;$raUk}IHJRH`EK1h6> zPVO|Gb`yr$-h?Q5l==VPTUi0xJE8Q}?4Wnh49wm$rfb@kZy95j@6^4b<@XL&ib2J( zO|L?Yv$M7_;8d$t$a+=Ytk|lCA9XrAkUEj>OCOK+Uy3qgKb{_aMRlrPnQZR@8QvE+y5+`EA<)wW4wV$?v2-JUnrEkU%@0P2hzDUQgf)3H<#8emQ}Ep1^-h z;D09YL$pBc=9@|2pAtVntJ)nctTHGs=2W4Y?Y{KX>D)zLa$}`1A&GjlZ zgLZ$TGB6%^6}xQIZPzTm!L7!OQLH+C-LurIW}{)w_(rwj2g8-B<+pl}x9*mVY0s=# zQEnj9HEd(r^aEvEvjhFZ;rNA_1Xnk5EtvHDj?epnRclmoXAQR=P+cQ-Yp~EEEcg^$ z8>Q(yJ>MmAl|n-g90-lduv0CWg=**~_EdgqbVuKs>E;{tmJ3hCC5cLGfoQ7ng366@ zgI8gzYr=7}rd_I9p5fJP96VaVQv(17PNFEK4rErbyEQTI(jA!aMrp~%jiSSmVWLJU z@bXTnPV?R|T6`op+DY;yLEA~;)cI>Ol0&@F?jqgIHq_&6<2=$&wI?;MpI)->ksp`j zf0O-j)*_ei_n2c`Tp}N`0ft9G&VY}ZBggG*L;b`y_+GZ5eq|e6zBzz?)3|(70o~NN zj0v=hpGTQjmHi%J9-mhq^Z2}8U>>h$Q1icsb3=`29Al>dNhV^vKf)?tE_GgI{sHrN zojA83@j99azJF322#)I|Zf95v4?iM_;e87Mmz-!z9Jsy@C(%g)uJ5<= zfF$7h{&YhcaeZEM8rS#3yD^^O_L9aAunqNv#`XNyG_K#@WsU3mVNK%?unpDJIKEj# zHrT*?ah^OU9RMUyy1%@~#s6gJMQg74Kg0~`pvJL2@|PY2?b_hh&B48MU^b%7}k#D>4CvgCgWVG=yMtuBZ%;Mu8j{_tliItcP3i%hdA2pKVAyudH9x8`U0EEJse?czV;!;=23ZIgKX-}DS6umAu6 literal 0 HcmV?d00001 diff --git a/src/FileUtils.hs b/src/FileUtils.hs deleted file mode 100644 index f21155f..0000000 --- a/src/FileUtils.hs +++ /dev/null @@ -1,180 +0,0 @@ --- Copyright © 2024 Hashirama Senju - -import System.Clock -- To measure time -import System.Console.ANSI -- For colored output --- -import Z.Data.CBytes (pack, unpack) -import Z.IO.FileSystem (scandirRecursively) -import System.FilePath (takeDirectory) -import Data.List (groupBy, isSuffixOf, isPrefixOf, nub) -import System.IO -import qualified Data.Map as Map -import Control.Concurrent.Async (mapConcurrently) -import Control.Concurrent -import Control.Monad -import Data.Char (isSpace) - --- Derived version with automatic string handling -scanDirectoryRecursivelyStr :: String -> IO [String] -scanDirectoryRecursivelyStr path = do - result <- scandirRecursively (pack path) (\p _ -> return True) - return (map unpack result) -- Ensures all results are decoded to Strings (UTF-8) - --- Function to filter files with a specific extension -filterMdx :: [String] -> String -> [String] -filterMdx files ext = filter (isSuffixOf ext) files - --- Custom implementation of takeDirectory for UTF-8 strings -takeDirectory' :: String -> String -takeDirectory' path = reverse . dropWhile (/= '/') . reverse $ path - -data FileGroup = FileGroup - { directory :: String -- The directory part of the file path (UTF-8 String) - , files :: [String] -- List of file paths in that directory (UTF-8 Strings) - } deriving (Show, Eq) - --- Create a map from directory to list of .mdx files -groupMdxByDirectory :: [String] -> Map.Map String [String] -groupMdxByDirectory mdxFiles = - Map.fromListWith (++) [(takeDirectory' file, [file]) | file <- mdxFiles] - --- Group files by their directory, including additional files that belong to the same directory -groupFilesByDirectory :: [String] -> [String] -> IO [FileGroup] -groupFilesByDirectory mdxFiles additionalFiles = do - -- Create a map of directories to .mdx files - let mdxMap = groupMdxByDirectory mdxFiles - - -- Function to process each directory group in parallel - let processGroup dir mdxFilesInDir = do - let -- Filter additional files that belong to the same directory - additionalFilesInDir = filter (\f -> takeDirectory' f == dir) additionalFiles - -- Remove matching files from additional files (those that are already in the .mdx list) - remainingAdditionalFiles = filter (\f -> not (f `elem` mdxFilesInDir)) additionalFilesInDir - -- Combine and remove duplicates - allFiles = nub (mdxFilesInDir ++ remainingAdditionalFiles) - return $ FileGroup dir allFiles - - -- Process each directory group concurrently - groupedFiles <- mapConcurrently (\(dir, mdxFilesInDir) -> processGroup dir mdxFilesInDir) (Map.toList mdxMap) - return groupedFiles - --- Function to convert FileGroup to a string representation for file output -fileGroupToString :: FileGroup -> String -fileGroupToString (FileGroup dir files) = - "Directory: " ++ dir ++ "\n" ++ - unlines (map (" " ++) files) - - --- Box-like animation function with green color -boxAnimation :: IO () -boxAnimation = do - let frames = ["[ ]", "[. ]", "[ . ]", "[ .]"] -- Frame progression for box - let loop frames' = do - mapM_ (\frame -> do - setSGR [SetColor Foreground Vivid Green] -- Set the box color to green - putStr "\r" -- Move cursor to the start of the line - putStr frame -- Print the current frame - hFlush stdout -- Flush output buffer - threadDelay 200000) frames' -- Wait 0.2 seconds between frames - loop frames' -- Recursively call to keep the loop running - loop frames -- Start the looping animation - - - --- A simple trim function to remove leading/trailing whitespace -trim :: String -> String -trim = f . f - where f = reverse . dropWhile isSpace - --- Process lines to produce a list of (directory, [file paths]) tuples. --- It ignores lines until the first "Directory:" is found (and discards it), --- then uses subsequent "Directory:" lines to start new groups. -processLines :: [String] -> [(String, [String])] -processLines = reverse . go False [] - where - -- The Bool flag indicates whether we've encountered the first "Directory:" line. - go :: Bool -> [(String, [String])] -> [String] -> [(String, [String])] - go _ acc [] = acc - -- Before the first "Directory:" has been seen: - go False acc (line:rest) - | "Directory:" `isPrefixOf` line = go True acc rest -- Skip first occurrence. - | otherwise = go False acc rest - -- After the first "Directory:" has been skipped, but before starting any group: - go True [] (line:rest) - | "Directory:" `isPrefixOf` line = - let dir = trim (drop 11 line) - in go True [(dir, [])] rest - | otherwise = go True [] rest -- Ignore non-directory lines until the second occurrence. - -- When a group has been started: - go True ((currentDir, files):xs) (line:rest) - | "Directory:" `isPrefixOf` line = - let dir = trim (drop 11 line) - in go True ((dir, []):(currentDir, files):xs) rest - | otherwise = - go True ((currentDir, files ++ [trim line]) : xs) rest - - -{- -this should be used that way: - - result <- getData "output.txt" - let finalresult = processLines result -- that way we maintain purity --} - -getData :: FilePath -> IO [String] -getData f = do - content <- readFile f - return (lines content) - - - - - - --- Main function -main :: IO () -main = do - - -- Start timing the operation - start <- getTime Monotonic - - -- Notify the start of processing with color - setSGR [SetColor Foreground Vivid Blue] - putStrLn "Processing started..." - setSGR [Reset] -- Reset colors - -- Create a thread for the box animation - animationThread <- forkIO boxAnimation - - - allFiles <- scanDirectoryRecursivelyStr "/mnt/Data/Japanese_Resources/" - - -- Filter files with '.mdx' extension - let mdxFiles = filterMdx allFiles ".mdx" - - -- Group the files by their directories concurrently - groupedFiles <- groupFilesByDirectory mdxFiles allFiles - - -- just to show that we finished processing, might be faster than doing I/O - putStrLn "Processing complete. Data is grouped." - -- Kill the animation thread - killThread animationThread - -- Stop timing the operation - end <- getTime Monotonic - let elapsed = toNanoSecs (diffTimeSpec end start) `div` 1000000 -- Convert to milliseconds - - -- Show a colorful message after processing with elapsed time - setSGR [SetColor Foreground Vivid Green] - putStrLn $ "Processing complete. Time taken: " ++ show elapsed ++ " ms." - setSGR [Reset] -- Reset colors - - putStrLn "Starting to write results..." - animationThread <- forkIO boxAnimation - -- Open the output file and set its encoding to UTF-8 - withFile "output.txt" WriteMode $ \handle -> do - hSetEncoding handle utf8 - - -- Write the grouped files to the file - mapM_ (hPutStrLn handle . fileGroupToString) groupedFiles - - killThread animationThread - diff --git a/src/IconToolbar.hs b/src/IconToolbar.hs deleted file mode 100644 index d0a2a67..0000000 --- a/src/IconToolbar.hs +++ /dev/null @@ -1,290 +0,0 @@ -{-# LANGUAGE OverloadedStrings, OverloadedLabels, ImplicitParams #-} --- Copyright © 2025 Hashirama Senju - -import System.Clock -- To measure time -import System.Console.ANSI -- For colored output --- -import Z.Data.CBytes (pack, unpack) -import Z.IO.FileSystem (scandirRecursively) -import System.FilePath (takeDirectory, dropExtension, takeExtension) -import Data.List (groupBy, isSuffixOf, isPrefixOf, nub, find) -import System.IO -import qualified Data.Map as Map -import Control.Concurrent.Async (mapConcurrently) -import Control.Concurrent -import Control.Monad -import Data.Char (isSpace) -import Data.Maybe (mapMaybe, maybeToList) - - -import qualified GI.Gtk as Gtk -import GI.Gtk (Grid(..), Image(..), Orientable(..)) -import GI.Gio -import Control.Monad (void) -import qualified Data.Text as T - - -{-# LANGUAGE OverloadedStrings #-} - -import qualified GI.Gtk as Gtk -import GI.Gtk (AttrOp((:=))) -import Data.Text (Text) -import qualified Data.Text as T - -createIconToolbar' :: [FilePath] -> IO Gtk.Box -createIconToolbar' iconPaths = do - toolbar <- Gtk.boxNew Gtk.OrientationHorizontal 0 - Gtk.widgetSetHalign toolbar Gtk.AlignCenter - Gtk.widgetSetValign toolbar Gtk.AlignCenter - - cssProvider <- Gtk.cssProviderNew - Gtk.cssProviderLoadFromString cssProvider $ T.pack $ - ".classic-button {" - ++ " -gtk-appearance: none;" - ++ " background-image: linear-gradient(to bottom, #f3f3f3, #d8d8d8);" - ++ " border: 1px solid #bbb;" - ++ " border-radius: 4px;" - ++ " color: #333;" - ++ " box-shadow: inset 0 1px 0 rgba(255,255,255,0.7);" - ++ " padding: 4px 8px;" - ++ "}" - ++ ".classic-button:hover {" - ++ " background-image: linear-gradient(to bottom, #e6e6e6, #ccc);" - ++ "}" - ++ ".classic-button:active {" - ++ " background-image: linear-gradient(to bottom, #ccc, #e6e6e6);" - ++ "}" - - - mapM_ (\path -> do - icon <- Gtk.imageNewFromFile path - Gtk.widgetSetSizeRequest icon 64 64 -- Force minimum size - - btn <- Gtk.buttonNew - Gtk.widgetAddCssClass btn "glass-button" - Gtk.widgetSetSizeRequest btn 80 80 -- Button size (icon + padding) - Gtk.widgetSetHalign btn Gtk.AlignCenter - Gtk.widgetSetValign btn Gtk.AlignCenter - Gtk.buttonSetChild btn (Just icon) - - -- Add click handler - void $ Gtk.on btn #clicked $ do - putStrLn $ "Selected: " ++ path - -- Add your click handler logic here - - Gtk.boxAppend toolbar btn - ) iconPaths - - return toolbar - --- Wrap the toolbar in a ScrolledWindow that scrolls horizontally -createIconToolbar :: [FilePath] -> IO Gtk.Widget -createIconToolbar iconPaths = do - -- Get your original toolbar (horizontal box) - toolbar <- createIconToolbar' iconPaths - - -- Create a new scrolled window - scrolled <- Gtk.scrolledWindowNew - - -- Show the horizontal scrollbar automatically, never show the vertical one - Gtk.scrolledWindowSetPolicy scrolled Gtk.PolicyTypeAutomatic Gtk.PolicyTypeNever - - -- Put the horizontal box (your toolbar) inside the scrolled window - Gtk.scrolledWindowSetChild scrolled (Just toolbar) - - -- Return as a general Widget - Gtk.toWidget scrolled - ---- - -type FileList = [(String, [String])] -- (Directory, Files) - -extractIcons :: FileList -> [String] -- List of icon paths -extractIcons = concatMap processGroup - where - processGroup (_, files) = maybeToList (findIcon files) - -findIcon :: [String] -> Maybe String -findIcon files = do - mdxFile <- find isMdxFile files - let baseName = dropExtension mdxFile - find (isIconFile baseName) files - where - isMdxFile file = takeExtension file == ".mdx" - isIconFile base file = - dropExtension file == base && - takeExtension file `elem` imageExtensions - -imageExtensions :: [String] -imageExtensions = [".png", ".jpg", ".jpeg", ".gif", ".bmp", ".svg"] - - - --- Derived version with automatic string handling -scanDirectoryRecursivelyStr :: String -> IO [String] -scanDirectoryRecursivelyStr path = do - result <- scandirRecursively (pack path) (\p _ -> return True) - return (map unpack result) -- Ensures all results are decoded to Strings (UTF-8) - --- Function to filter files with a specific extension -filterMdx :: [String] -> String -> [String] -filterMdx files ext = filter (isSuffixOf ext) files - --- Custom implementation of takeDirectory for UTF-8 strings -takeDirectory' :: String -> String -takeDirectory' path = reverse . dropWhile (/= '/') . reverse $ path - -data FileGroup = FileGroup - { directory :: String -- The directory part of the file path (UTF-8 String) - , files :: [String] -- List of file paths in that directory (UTF-8 Strings) - } deriving (Show, Eq) - --- Create a map from directory to list of .mdx files -groupMdxByDirectory :: [String] -> Map.Map String [String] -groupMdxByDirectory mdxFiles = - Map.fromListWith (++) [(takeDirectory' file, [file]) | file <- mdxFiles] - --- Group files by their directory, including additional files that belong to the same directory -groupFilesByDirectory :: [String] -> [String] -> IO [FileGroup] -groupFilesByDirectory mdxFiles additionalFiles = do - -- Create a map of directories to .mdx files - let mdxMap = groupMdxByDirectory mdxFiles - - -- Function to process each directory group in parallel - let processGroup dir mdxFilesInDir = do - let -- Filter additional files that belong to the same directory - additionalFilesInDir = filter (\f -> takeDirectory' f == dir) additionalFiles - -- Remove matching files from additional files (those that are already in the .mdx list) - remainingAdditionalFiles = filter (\f -> not (f `elem` mdxFilesInDir)) additionalFilesInDir - -- Combine and remove duplicates - allFiles = nub (mdxFilesInDir ++ remainingAdditionalFiles) - return $ FileGroup dir allFiles - - -- Process each directory group concurrently - groupedFiles <- mapConcurrently (\(dir, mdxFilesInDir) -> processGroup dir mdxFilesInDir) (Map.toList mdxMap) - return groupedFiles - --- Function to convert FileGroup to a string representation for file output -fileGroupToString :: FileGroup -> String -fileGroupToString (FileGroup dir files) = - "Directory: " ++ dir ++ "\n" ++ - unlines (map (" " ++) files) - - --- Box-like animation function with green color -boxAnimation :: IO () -boxAnimation = do - let frames = ["[ ]", "[. ]", "[ . ]", "[ .]"] -- Frame progression for box - let loop frames' = do - mapM_ (\frame -> do - setSGR [SetColor Foreground Vivid Green] -- Set the box color to green - putStr "\r" -- Move cursor to the start of the line - putStr frame -- Print the current frame - hFlush stdout -- Flush output buffer - threadDelay 200000) frames' -- Wait 0.2 seconds between frames - loop frames' -- Recursively call to keep the loop running - loop frames -- Start the looping animation - - - --- A simple trim function to remove leading/trailing whitespace -trim :: String -> String -trim = f . f - where f = reverse . dropWhile isSpace - --- Process lines to produce a list of (directory, [file paths]) tuples. --- It ignores lines until the first "Directory:" is found (and discards it), --- then uses subsequent "Directory:" lines to start new groups. -processLines :: [String] -> [(String, [String])] -processLines = reverse . go False [] - where - -- The Bool flag indicates whether we've encountered the first "Directory:" line. - go :: Bool -> [(String, [String])] -> [String] -> [(String, [String])] - go _ acc [] = acc - -- Before the first "Directory:" has been seen: - go False acc (line:rest) - | "Directory:" `isPrefixOf` line = go True acc rest -- Skip first occurrence. - | otherwise = go False acc rest - -- After the first "Directory:" has been skipped, but before starting any group: - go True [] (line:rest) - | "Directory:" `isPrefixOf` line = - let dir = trim (drop 11 line) - in go True [(dir, [])] rest - | otherwise = go True [] rest -- Ignore non-directory lines until the second occurrence. - -- When a group has been started: - go True ((currentDir, files):xs) (line:rest) - | "Directory:" `isPrefixOf` line = - let dir = trim (drop 11 line) - in go True ((dir, []):(currentDir, files):xs) rest - | otherwise = - go True ((currentDir, files ++ [trim line]) : xs) rest - - -{- -this should be used that way: - - result <- getData "output.txt" - let finalresult = processLines result -- that way we maintain purity --} - -getData :: FilePath -> IO [String] -getData f = do - content <- readFile f - return (lines content) - - - -main :: IO () -main = do - - --- Function that builds the cache -{- allFiles <- scanDirectoryRecursivelyStr "/mnt/Data/Japanese_Resources/" - - -- Filter files with '.mdx' extension - let mdxFiles = filterMdx allFiles ".mdx" - - -- Group the files by their directories concurrently - groupedFiles <- groupFilesByDirectory mdxFiles allFiles - - - putStrLn "Starting to write results..." - - -- Open the output file and set its encoding to UTF-8 - withFile "output.txt" WriteMode $ \handle -> do - hSetEncoding handle utf8 - -- Write the grouped files to the file - mapM_ (hPutStrLn handle . fileGroupToString) groupedFiles - - - putStrLn "Finished." --} - -- Get raw data through IO - rawData <- getData "output.txt" - - -- Pure transformations - let processed = processLines rawData - let icons = extractIcons processed - - -- Output results - mapM_ putStrLn icons - - app <- Gtk.applicationNew (Just "com.example.DictionaryIcons") [] - - void $ Gtk.on app #activate $ do - window <- Gtk.applicationWindowNew app - Gtk.windowSetTitle window (Just "Dictionary Toolbar") -- Fixed line - Gtk.windowSetDefaultSize window 800 100 - - -- Rest of the code remains the same - - mainBox <- Gtk.boxNew Gtk.OrientationVertical 0 - toolbar <- createIconToolbar icons - - Gtk.boxAppend mainBox toolbar - Gtk.windowSetChild window (Just mainBox) - Gtk.widgetShow window - - _ <- applicationRun app Nothing - return () - diff --git a/src/KanaConv.hs b/src/KanaConv.hs deleted file mode 100644 index 4cd1962..0000000 --- a/src/KanaConv.hs +++ /dev/null @@ -1,36 +0,0 @@ --- Copyright © 2024 Hashirama Senju - -{-# LANGUAGE OverloadedStrings #-} - -module KanaConv (convertHalfToFull) where -- Export convertHalfToFull function - -import qualified Data.Map as Map -import Data.Maybe (fromMaybe) - --- The Kana mapping for half-width to full-width katakana -halfToFullMapping :: Map.Map String String -halfToFullMapping = Map.fromList - [ ("ｱ", "ア"), ("ｲ", "イ"), ("ｳ", "ウ"), ("ｴ", "エ"), ("ｵ", "オ") - , ("ｶ", "カ"), ("ｷ", "キ"), ("ｸ", "ク"), ("ｹ", "ケ"), ("ｺ", "コ") - , ("ｻ", "サ"), ("ｼ", "シ"), ("ｽ", "ス"), ("ｾ", "セ"), ("ｿ", "ソ") - , ("ﾀ", "タ"), ("ﾁ", "チ"), ("ﾂ", "ツ"), ("ﾃ", "テ"), ("ﾄ", "ト") - , ("ﾅ", "ナ"), ("ﾆ", "ニ"), ("ﾇ", "ヌ"), ("ﾈ", "ネ"), ("ﾉ", "ノ") - , ("ﾊ", "ハ"), ("ﾋ", "ヒ"), ("ﾌ", "フ"), ("ﾍ", "ヘ"), ("ﾎ", "ホ") - , ("ﾏ", "マ"), ("ﾐ", "ミ"), ("ﾑ", "ム"), ("ﾒ", "メ"), ("ﾓ", "モ") - , ("ﾤ", "ヤ"), ("ﾦ", "ユ"), ("ﾧ", "ヨ"), ("ﾨ", "ラ"), ("ﾩ", "リ") - , ("ﾪ", "ル"), ("ﾬ", "レ"), ("ﾮ", "ロ"), ("ﾜ", "ワ"), ("ｦ", "ヲ") - , ("ﾝ", "ン"), ("ｧ", "ァ"), ("ｨ", "ィ"), ("ｩ", "ゥ"), ("ｪ", "ェ") - , ("ｫ", "ォ"), ("ｯ", "ッ"), ("ｬ", "ャ"), ("ｭ", "ュ"), ("ｮ", "ョ") - , ("｡", "。"), ("､", "、"), ("･", "・"), ("゛", "ﾞ"), ("゜", "ﾟ") - , ("｢", "「"), ("｣", "」"), ("ｰ", "ー") - ] - --- Function to replace half-width characters with full-width characters -replaceChar :: Char -> String -replaceChar char - | Just full <- Map.lookup [char] halfToFullMapping = full - | otherwise = [char] - --- Function to convert the entire string -convertHalfToFull :: String -> String -convertHalfToFull = concatMap replaceChar diff --git a/src/Wazahs.hi b/src/Wazahs.hi new file mode 100644 index 0000000000000000000000000000000000000000..a45f4b8282801c02f09b4a4bea4e8f5d579a39f5 GIT binary patch literal 3375 zcmaJ@c~lhl9sjN)R|Gl4D40mn5>4CeWLXZOH@mQaT#L&g>5&e*KXwOaXO@{+Vfo7# z4W8AeYNJm|j6O9_6JykBs}el=s5S9?G322{Q;#;LDx_*r(SCn3>;jtCw{Lgn_xaxE zZw&WNxW?v~%-H}C!vZin@Y@bx0Jytg*TRo?Y+iQJux;nA!M)q|f9g7Mrhik^% zHY`5$r(0j_*>L{%hQ5w-4;Q?-{Qf6~V~4x;yf=U4()SFlogXh+x^2rk3;FJ` z10+R<}`4DDFr(Dba%^<|C~G9v3?ANJp;Gze01r9_DiX2+P4fYS$TZ# zM^t$@zkTtI`NekZ;Rb~^Z4qHw$m&2QT8}-pljghrGIo^?=$S% zyW*>r_j)dO8E7xVf3Ke1zu>iHyRRC$)-GASZ|lYb&4>a+!($>~O!xVJcAnb#VEskI z`ZKF;-2VL7s<$;k#u)Z+-n_3PwTT#5`{BcN9Vb`0PTlxy@cQo0PX3#!21a2Z?92Jc zg(6|7(Gb=@Z{Agufw0}d2MTK+DgjIjbPe47*McuLxAX5G=<8kB`TB=bH3~4RDSaLN zX~#K08HxV*u*OVdKaBNqyck}?wQwFKhLdG3U^KCrYzAu@TgNG6d>t=xGR3ml9M&|U zE}#-cm3h&PP+A)0OLa=3%g?LEG&Y^hG-g|PUzxY8&TVxRWtEc(M^$6MQ<8v8Dq144 zf`VCSA&qr$DreM9Qngeei(jKHt*O|OWllF+Gcq%4i+D@ptQKodtcwtzLK@Lb1}aF4 zckwcDsuDU!4QH|Dc+%`7K9!e5Y9r0WX2jL=0`YOGM-wu$=IJ8v*^5_r`0FlB60@O%7{jvm+_ulX>rS52tvzI)MzSHyLfk z7Qr#Q!C{+`Uf5uD*ljJOKCk6vuOv!FRp#bm_(S~YU?!Vx^ja+?v%Qk3vcghcImc30 zW-hVjM|oAjh~Bd17pWOu<>%7u%)l^B#@wa?MX(3zE6PZowXkMJjZ|u?u9_wjMe@r| zLd#%gvy3xyNX<+WsV!+J%CR*#i!wbV&sLDC_ynw!30Y{Z@(R+#Ibvy6VQz6oZbnOW zR&7S9l^dt1UNoPH#W2UI#Oo6{tPaLHhX_KnN}6>WNRLr@FAW|W0Y8Ztp{UeLvRAKi zCM`;|U*wxn+YB1cOMX${>#;&crzF#m%(Uc2bCWQO$o5iC6-m#nE#OO)+VU1L!!Js* zi^#-<+#{L?Wpc1f3SCZFRZaf6?uz0HsiL^1#pyNi)8=YDLF-RLOfwcW)>}&Elsa;4 zjX6@OT4~8`%;w5WLu{PjmSkS_cxlIEW55~4^vwE3l3(vJS*r5wvkS%iK%Li}^L!pQ zD_e=-vNjBmQ-gm+qM~x5lPFI=!C~iQg*^A|FdLGaHq1~WIXOYIQ6#EF7CC`^MG}dN zLjRvFB>Bv+HY+C((Z$JZflO$WoS32!3x}GPEg(3KymQ!<@wzY;m@VO20u!`jwU$t} zO01Kbi7RO&X7ejJY^=pEx&#sx64vD`+TsWrnWRxIIOYy*d!P_6U~xy7ba*~ zmISs`5;+&^s4Ptyja1SWWAkNMlA{U=t*lLuI5mEyY6qKNq-%twprnw5$3U#_#8FU@i-;<(21ZNUWy$4ts&S)O9e(dP4Zv_D z-lYfYAYR@rOMai8lh6_Cpcg$x6R8aN2wN_@bdRfXq%hZdlB-dd7IS{HszlS^hf1l$ z(L+%=n;+bSF%+0p>A*yBZsl1`^N1=0O|sP56I9v+A+M%BE{pY&)eu=1#$3~@AcSI4 zH6U3Neu8S}eMCTpiy2J zZCIbESwq)HD2K_x*jbE|E`GMMkaYxb4>#-MK*Jwdi(zzR;`R2|cZkk0v`<2w>G2Ms z4je>!LF)02UOn1`hwBX}|LOXI{fCoI zUu)2ok~*p}M-Xt~HTpTct$5;!9kOD>w+TDGO-y|3%-SV|ZyrZo(|Um@+HRsVr9=t5 UqEbO6Dpi$BaY+ayGN=gt2VFFrLI3~& literal 0 HcmV?d00001 diff --git a/src/Wazahs.hs b/src/Wazahs.hs new file mode 100644 index 0000000..6029665 --- /dev/null +++ b/src/Wazahs.hs @@ -0,0 +1,19 @@ +module Wazahs ( + listFiles +) where + +-- imports + +import qualified Data.Conduit.Combinators as CC +import Data.Conduit +import System.Environment (getArgs) +import System.FilePath (takeExtension) +import Conduit + + +-- | Recursively list all files in the given directory with .mdx extension. +listFiles :: FilePath -> IO [FilePath] +listFiles dir = runConduitRes $ + CC.sourceDirectoryDeep False dir + .| filterC (\fp -> takeExtension fp == ".mdx") + .| sinkList diff --git a/src/Wazahs.hs~ b/src/Wazahs.hs~ new file mode 100644 index 0000000..58f4b23 --- /dev/null +++ b/src/Wazahs.hs~ @@ -0,0 +1,19 @@ +module Wazahs ( + +) where + +-- imports + +import qualified Data.Conduit.Combinators as CC +import Data.Conduit +import System.Environment (getArgs) +import System.FilePath (takeExtension) +import Conduit + + +-- | Recursively list all files in the given directory with .mdx extension. +listFiles :: FilePath -> IO [FilePath] +listFiles dir = runConduitRes $ + CC.sourceDirectoryDeep False dir + .| filterC (\fp -> takeExtension fp == ".mdx") + .| sinkList diff --git a/src/Wazahs.o b/src/Wazahs.o new file mode 100644 index 0000000000000000000000000000000000000000..746ce4afab2fef625cf069598fbbb8b5ba856bb7 GIT binary patch literal 8152 zcmeHMYit}>6&@!697>3r@F)B@EfO*LM9-9yFSa*JJM_JF}aa zS;ZcKNM%)Ifk^qmqe4ZpfT|DmM=27j%0m`P<4S-O@e)X=m|wUOLJL&Fph)4InRCX+ zH#<=kDkP*HX?*Yf?m6E%_ndq0?5@8sP#E0Q)~2zvX`j*7M~rIP6T8;?y-~MU+oruI z0pCx({N;gW;mDfzaDL%0?S;l_zVTYVvE041iu3t}tL^#6mx4@wd7v2qje)hJKf&G) zqv66U&DXJW^S+}ut>*UKy*P;E|DAt3t%LI;QgFIu3gQHim8RXPJ=d~B@xN!i1gF>X zU(R*tjcXfgfC0>0c?Z}r2e$8C=UK%%AJ-SI?kzs})QQcScHv=txxaG-HT28S!BJG^ zV&g!ke)-YPW?XA<9dC!m>1G~wKz`ws)u`$6X~!ukMZbWmE6BGdNW7lAXWmC83I>vT*d$LLqk9ILcmH@&e1>IOy3H~x70L{iC` zSC9ln&EuQh@4Vk&8$|M6YGwG{Nw~#E(AiA(8dW{Y|24hwTC|_ljTM2oyNLMh=Iso$ z$N=xZtTR2Q9XCU>>}!r`yP7tX&t;Bed$NZkt1a+10}t-oq2Wnwlh(F`7@zAlWeiiP zvN^HZsIpn(XjJ^28vz)_es9I`-sU?&8ht1Qe=r4qE(QNy3cj3z|0V_B3JYiz=fxEK z*%bVjDR|GO*8ESV;5Sn6yPzbk;(Qo2V84cT(^lq~KRm@L#3iZ=~Rx zVS~4dXJ-n22=E=S8_U3lG8Q*lF-3nC@VjB3zXWxY@>q)g)1(gvZiDt4wULZ>^l zdqVqA=o~v@9Y5A(oh+Qyj|`qI=?BYJ|KO03tGa<#t%P>O5!w@;>H48PMhu~?yMg7o zW+m~%Qxl0h*Se59Iv9mHRW|CiX=BDS9V?C&gEwnN&6qL$AdX%2sgHzqu44Lr;zJ+# zU$5rYRn3-5p;Pm0C(d;gpcREUa6VTyy=3{fQ#@5XHJm7xs_t~%j*GHCv=4^P;Xb=I z>hYA3vnm>b+=;A1a>uaN>$Gaovx_% zumie6r{_Xt%<@Kyy#0!O%Vs zW#E9RkK{(r9vhkO?sJ{}C%U{aeB|uBF+T4HmJ`~8U^R+X_Gs0&=ZwHSXAR5+mh0P9 zH{pH@R*nfiUpJvvwgpGUuD}7yy_F6O-*(RxY(My~N%`=v@4V0srxIE$Q|sgI#>brx zf30;L@yz3qvO?vupxYubr?IjRCgy8kJ!n?o7UZiBKKS4#AEN@x$BOzXcjj#jn5w0> z32zv#ws8aYLCnk!!|A{)R;TNg^;lXGunyZNzewO~0iPQ;WBCNVCGd6BF7O8kzYE%} z)W@cu`uMp?ewxw+{x0fcQ=vZleTc>lYE{4ABwY3TUBb~X&apg89mLmvb8#J*K z2OyXSRH>2P9tD4a@GinJ57=FV2j#HP|8NXNe=CGzgHI>%d`alb{C`8>sJce_PZ7?3 zGcbqpoWS|FH^hHUI5zljo&HX^TKAg*N0(jXcN-Nc$q(t>OSl@(eFFa=@URpJM{|7s zKoh40zs!Rpc=kZ0-QSlv=Zxx?R!M`SO{Lah#zZJOjt5bcD|06>G`vTu3 z@O_jI)c>f!A4|b+q~HTc0HUtz+X9zY_63ty#aE@<9;2#q_ zs{+TXg4fU#xYS=0IO->74}$=~>CUJZ|7jOEcK=599SZ&@!nLeF?*!%)w1F45W$t-a z#molQT%cv6?lgSi*0NK+592Bh&_>I;)xgTaZ>0D80esQavZboySS}bv6SHnTTl1^+}#Xle~(|sC`;_n39#}@B=ROy9B%5}OFnnaB64D{1ZO8i;l zlZ4YXPqWZaAv2U`o?v?(e;hik{4dd=;NR8IKl)&M_TNpI>OUhdeb8ayGV}NlbP(%d zfLgYfcO6c#J-2-VBh#qqev|&k$i7P&L!a&CI|o(RFSnls3|%Q{)_Tdm%FFpfE)?WZ zZ4s}LJ%295IIyH_&-vd9n3{Wlv{ft^$e;N@$HOFk8p3a(t?l>X%O3>(5wSsd-3), takeDirectory) -import qualified System.FilePath as FP -import Filesystem.Path.CurrentOS (FilePath, encodeString, decodeString) -import qualified Filesystem.Path.CurrentOS as FP -import qualified Filesystem as FS -import qualified Data.Text as T - -import Pipes -import Pipes.Safe (runSafeT, MonadSafe) -import Data.DirStream -import Control.Monad.State.Strict -import qualified Data.HashMap.Strict as HM -import qualified Data.Text.IO as TIO -import Data.Maybe (fromMaybe) - -import Control.Monad (when, filterM) -import Data.List (sort) - -type MdxIndex = HM.HashMap String (FilePath, [FilePath]) - - -main :: IO () -main = do - hSetEncoding stdout utf8 - mdxMap <- execStateT (runSafeT $ runEffect pipeline) (HM.empty :: MdxIndex) - - -- print everything - forM_ (HM.toList mdxMap) $ \(mdx, (folder, files)) -> do - TIO.putStrLn $ "MDX: " <> T.pack mdx - TIO.putStrLn $ "Folder: " <> T.pack (encodeString folder) - mapM_ (TIO.putStrLn . (" " <>) . T.pack . encodeString) (sort files) - - TIO.putStrLn "" - -pipeline :: forall m. (MonadSafe m, MonadState MdxIndex m, MonadFail m) => Effect m () -pipeline = - for (every (descendentOf "/mnt/Data/Japanese_Resources/Dictionaries/")) $ \fp -> - when (FP.extension fp == Just "mdx") $ do - let folder = FP.directory fp - allFiles <- liftIO $ FS.listDirectory folder - modify' (HM.insert (encodeString fp) (folder, allFiles)) - - - - diff --git a/src/getIcons.hs b/src/getIcons.hs deleted file mode 100644 index 79fd795..0000000 --- a/src/getIcons.hs +++ /dev/null @@ -1,161 +0,0 @@ --- Copyright © 2024 Hashirama Senju - -import System.Clock -- To measure time -import System.Console.ANSI -- For colored output --- -import Z.Data.CBytes (pack, unpack) -import Z.IO.FileSystem (scandirRecursively) -import System.FilePath (takeDirectory, dropExtension, takeExtension) -import Data.List (groupBy, isSuffixOf, isPrefixOf, nub, find) -import System.IO -import qualified Data.Map as Map -import Control.Concurrent.Async (mapConcurrently) -import Control.Concurrent -import Control.Monad -import Data.Char (isSpace) -import Data.Maybe (mapMaybe, maybeToList) - - -type FileList = [(String, [String])] -- (Directory, Files) - -extractIcons :: FileList -> [String] -- List of icon paths -extractIcons = concatMap processGroup - where - processGroup (_, files) = maybeToList (findIcon files) - -findIcon :: [String] -> Maybe String -findIcon files = do - mdxFile <- find isMdxFile files - let baseName = dropExtension mdxFile - find (isIconFile baseName) files - where - isMdxFile file = takeExtension file == ".mdx" - isIconFile base file = - dropExtension file == base && - takeExtension file `elem` imageExtensions - -imageExtensions :: [String] -imageExtensions = [".png", ".jpg", ".jpeg", ".gif", ".bmp", ".svg"] - - - --- Derived version with automatic string handling -scanDirectoryRecursivelyStr :: String -> IO [String] -scanDirectoryRecursivelyStr path = do - result <- scandirRecursively (pack path) (\p _ -> return True) - return (map unpack result) -- Ensures all results are decoded to Strings (UTF-8) - --- Function to filter files with a specific extension -filterMdx :: [String] -> String -> [String] -filterMdx files ext = filter (isSuffixOf ext) files - --- Custom implementation of takeDirectory for UTF-8 strings -takeDirectory' :: String -> String -takeDirectory' path = reverse . dropWhile (/= '/') . reverse $ path - -data FileGroup = FileGroup - { directory :: String -- The directory part of the file path (UTF-8 String) - , files :: [String] -- List of file paths in that directory (UTF-8 Strings) - } deriving (Show, Eq) - --- Create a map from directory to list of .mdx files -groupMdxByDirectory :: [String] -> Map.Map String [String] -groupMdxByDirectory mdxFiles = - Map.fromListWith (++) [(takeDirectory' file, [file]) | file <- mdxFiles] - --- Group files by their directory, including additional files that belong to the same directory -groupFilesByDirectory :: [String] -> [String] -> IO [FileGroup] -groupFilesByDirectory mdxFiles additionalFiles = do - -- Create a map of directories to .mdx files - let mdxMap = groupMdxByDirectory mdxFiles - - -- Function to process each directory group in parallel - let processGroup dir mdxFilesInDir = do - let -- Filter additional files that belong to the same directory - additionalFilesInDir = filter (\f -> takeDirectory' f == dir) additionalFiles - -- Remove matching files from additional files (those that are already in the .mdx list) - remainingAdditionalFiles = filter (\f -> not (f `elem` mdxFilesInDir)) additionalFilesInDir - -- Combine and remove duplicates - allFiles = nub (mdxFilesInDir ++ remainingAdditionalFiles) - return $ FileGroup dir allFiles - - -- Process each directory group concurrently - groupedFiles <- mapConcurrently (\(dir, mdxFilesInDir) -> processGroup dir mdxFilesInDir) (Map.toList mdxMap) - return groupedFiles - --- Function to convert FileGroup to a string representation for file output -fileGroupToString :: FileGroup -> String -fileGroupToString (FileGroup dir files) = - "Directory: " ++ dir ++ "\n" ++ - unlines (map (" " ++) files) - - --- Box-like animation function with green color -boxAnimation :: IO () -boxAnimation = do - let frames = ["[ ]", "[. ]", "[ . ]", "[ .]"] -- Frame progression for box - let loop frames' = do - mapM_ (\frame -> do - setSGR [SetColor Foreground Vivid Green] -- Set the box color to green - putStr "\r" -- Move cursor to the start of the line - putStr frame -- Print the current frame - hFlush stdout -- Flush output buffer - threadDelay 200000) frames' -- Wait 0.2 seconds between frames - loop frames' -- Recursively call to keep the loop running - loop frames -- Start the looping animation - - - --- A simple trim function to remove leading/trailing whitespace -trim :: String -> String -trim = f . f - where f = reverse . dropWhile isSpace - --- Process lines to produce a list of (directory, [file paths]) tuples. --- It ignores lines until the first "Directory:" is found (and discards it), --- then uses subsequent "Directory:" lines to start new groups. -processLines :: [String] -> [(String, [String])] -processLines = reverse . go False [] - where - -- The Bool flag indicates whether we've encountered the first "Directory:" line. - go :: Bool -> [(String, [String])] -> [String] -> [(String, [String])] - go _ acc [] = acc - -- Before the first "Directory:" has been seen: - go False acc (line:rest) - | "Directory:" `isPrefixOf` line = go True acc rest -- Skip first occurrence. - | otherwise = go False acc rest - -- After the first "Directory:" has been skipped, but before starting any group: - go True [] (line:rest) - | "Directory:" `isPrefixOf` line = - let dir = trim (drop 11 line) - in go True [(dir, [])] rest - | otherwise = go True [] rest -- Ignore non-directory lines until the second occurrence. - -- When a group has been started: - go True ((currentDir, files):xs) (line:rest) - | "Directory:" `isPrefixOf` line = - let dir = trim (drop 11 line) - in go True ((dir, []):(currentDir, files):xs) rest - | otherwise = - go True ((currentDir, files ++ [trim line]) : xs) rest - - - -getData :: FilePath -> IO [String] -getData f = do - content <- readFile f - return (lines content) - - - -main :: IO () -main = do - -- Get raw data through IO - rawData <- getData "output.txt" - - -- Pure transformations - let processed = processLines rawData - let icons = extractIcons processed - - -- Output results - mapM_ putStrLn icons - diff --git a/src/make_package.hs b/src/make_package.hs deleted file mode 100644 index 7d063b3..0000000 --- a/src/make_package.hs +++ /dev/null @@ -1,208 +0,0 @@ --- currently not working, needs refactoring. - -import Control.Exception (bracket_) -import qualified Control.Lens as Lens -import Control.Lens.Operators -import Control.Monad (when, unless, filterM) -import Data.Foldable (traverse_) -import qualified System.Directory as Dir -import qualified System.Environment as Env -import System.FilePath ((), takeFileName, takeDirectory) -import qualified System.Info as SysInfo -import System.Process (readProcess, callProcess) - -import Prelude - -interestingLibs :: [String] -interestingLibs = - [ "libGLEW" - , "libGLU" - , "libXcursor" - , "libXi" - , "libXinerama" - , "libXrandr" - , "libXrender" - , "libbsd" - , "libbz2" - , "libcares" - , "libcrypto" - , "libdw" - , "libelf" - , "libgflags" - , "libgmp" - , "libicudata" - , "libicui18n" - , "libicuuc" - , "liblzma" - , "libnghttp2" - , "libnode" - , "librocksdb" - , "libsnappy" - , "libssl" - , "libuv" - ] - -isInteresting :: FilePath -> Bool -isInteresting path = - baseName `elem` interestingLibs - where - -- takeBaseName removes one extension, we remove all: - baseName = takeFileName path & takeWhile (/= '.') - -parseLddOut :: String -> [FilePath] -parseLddOut lddOut = - lines lddOut - >>= parseLine - & filter isInteresting - where - parseLine line = - case words line & dropWhile (/= "=>") of - [] -> [] - "=>":libPath:_ -> [libPath] - _ -> error "unexpected break output" - -otoolMinMacosVersion :: FilePath -> IO Float -otoolMinMacosVersion path = - readProcess "otool" ["-l", path] "" <&> - (^?! Lens.to lines . traverse . - Lens.to words . - Lens.filteredBy (Lens.ix 0 . (Lens.only "minos" <> Lens.only "version")) . - Lens.ix 1 . Lens._Show) - --- Use `otool` to recursively find macOS deps -findDylibs :: FilePath -> IO [FilePath] -findDylibs path = - do - deps <- - readProcess "otool" ["-L", path] "" - <&> lines <&> tail <&> map words <&> (>>= take 1) - <&> filter (/= path) - >>= filterM Dir.doesPathExist - traverse findDylibs deps <&> concat <&> (deps <>) - --- Slightly nicer syntax than using a sum type with case everywhere -isMacOS :: Bool -isMacOS = SysInfo.os == "darwin" - -isWindows :: Bool -isWindows = SysInfo.os == "mingw32" - -isLinux :: Bool -isLinux = SysInfo.os == "linux" - -pkgDir :: FilePath -pkgDir - | isMacOS = "Lamdu.app" - | otherwise = "lamdu" - -toPackageWith :: FilePath -> FilePath -> IO () -toPackageWith srcPath relPath = - do - putStrLn $ "Packaging " ++ srcPath ++ " to " ++ destPath - Dir.createDirectoryIfMissing True (takeDirectory destPath) - callProcess "cp" ["-aLR", srcPath, destPath] - where - destPath = contentsDir relPath - contentsDir - | isMacOS = pkgDir "Contents" - | otherwise = pkgDir - -toPackage :: FilePath -> IO () -toPackage srcPath = toPackageWith srcPath (takeFileName srcPath) - -libToPackage :: FilePath -> IO () -libToPackage srcPath = - toPackageWith srcPath (dir filename) - where - filename = takeFileName srcPath - dir - | isWindows = "." - | isMacOS = "MacOS" - | otherwise = "lib" - -findDeps :: String -> IO [FilePath] -findDeps exec - | isWindows = - [ "libwinpthread-1.dll" - , "libstdc++-6.dll" - , "libgcc_s_seh-1.dll" - , "librocksdb.dll" - , "libbz2-1.dll" - , "liblz4.dll" - , "zlib1.dll" - , "libzstd.dll" - ] <&> ("/mingw64/bin" ) - & pure - | isMacOS = - findDylibs exec - | otherwise = - readProcess "ldd" [exec] "" <&> parseLddOut - -fixDylibPaths :: FilePath -> IO () -fixDylibPaths targetName = - findDylibs target >>= - traverse_ fixDep - where - target = pkgDir "Contents" "MacOS" targetName - fixDep dep = - do - callProcess "chmod" ["+w", target] - callProcess "install_name_tool" - ["-change", dep, "@executable_path/" ++ takeFileName dep, target] - -parseLamduVersion :: String -> String -parseLamduVersion info = - case lines info <&> words of - (["Lamdu", result]:_) -> result - _ -> error "failed parsing version number" - -whichCmd :: String -whichCmd - | isWindows = "where" - | otherwise = "which" - -main :: IO () -main = - do - [lamduExec] <- Env.getArgs - nodePath <- readProcess whichCmd ["node"] "" <&> takeWhile (`notElem` "\r\n") - nodeDeps <- findDeps nodePath - when isMacOS $ - do - unless (null nodeDeps) $ fail "nodejs not statically linked!" - minos <- otoolMinMacosVersion lamduExec - when (minos > 10.9) (fail "Lamdu executable only runs on new macOS versions") - version <- readProcess lamduExec ["--version"] "" <&> parseLamduVersion - lamduDeps <- findDeps lamduExec - let allDeps = nodeDeps <> lamduDeps - bracket_ (Dir.createDirectory pkgDir) (unless isMacOS (Dir.removeDirectoryRecursive pkgDir)) $ - do - toPackageWith lamduExec destPath - toPackageWith "data" dataDir - toPackageWith nodePath (dataDir "bin/node.exe") - traverse_ libToPackage allDeps - when isWindows $ - callProcess "iscc.exe" ["/Flamdu-" ++ version ++ "-win-setup", "tools\\data\\lamdu.iss"] - when isLinux $ - do - toPackage "tools/data/run-lamdu.sh" - callProcess "tar" ["-c", "-z", "-f", "lamdu-" ++ version ++ "-linux.tgz", pkgDir] - when isMacOS $ - do - toPackage "tools/data/Info.plist" - traverse_ fixDylibPaths ("lamdu" : (allDeps <&> takeFileName)) - callProcess "sh" - [ "tools/data/macos_icon.sh" - , "data/Lamdu.png" - , pkgDir "Contents" "Resources" "lamdu.icns" - ] - -- The next steps of signing, notarization, and stapling happen in a seperate script - putStrLn "Done" - where - destPath - | isWindows = "lamdu.exe" - | isMacOS = "MacOS/lamdu" - | otherwise = "bin/lamdu" - dataDir - | isMacOS = "Resources" - | otherwise = "data"