implement consistent formatting

2026-02-04 05:07:48 +00:00 · 2026-02-04 05:07:48 +00:00 · 4c6c181e65
commit 4c6c181e65
parent 1cab6a9bab
5 changed files with 164 additions and 162 deletions
--- a/app/EpubParser.hs
+++ b/app/EpubParser.hs
@ -1,41 +1,41 @@
 {-# LANGUAGE OverloadedStrings #-}

 module EpubParser
-    ( EpubAction
-    , EpubEnv(..)
-    , openEpub
-    , getOpfPath
-    , resolveSpine
-    , getChapter
-    , getChapterTitle
-    , Tag(..)
-    ) where
+  ( EpubAction,
+    EpubEnv (..),
+    openEpub,
+    getOpfPath,
+    resolveSpine,
+    getChapter,
+    getChapterTitle,
+    Tag (..),
+  )
+where

 import Codec.Archive.Zip (Archive, findEntryByPath, fromEntry, toArchive)
-
+import qualified Codec.Epub.Data.Manifest as DMan
+import qualified Codec.Epub.Data.Metadata as DMeta
+import qualified Codec.Epub.Data.Spine as DSpin
+import Codec.Epub.Parse (getManifest, getMetadata, getSpine)
+import Control.Monad.Except (runExceptT)
+import Control.Monad.Reader (MonadReader (ask), ReaderT, liftIO)
+import qualified Data.ByteString.Base64 as B64
 import qualified Data.ByteString.Lazy as B
+import Data.List (find)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
-import Control.Monad.Reader (ReaderT, MonadReader(ask), liftIO)
-import Control.Monad.Except (runExceptT)
-import System.FilePath (takeDirectory, (</>), normalise)
-import Data.List (find)
-import Text.HTML.TagSoup (parseTags, innerText, Tag(..))
-import Codec.Epub.Parse (getSpine, getMetadata, getManifest)
-import qualified Codec.Epub.Data.Metadata as DMeta
-import qualified Codec.Epub.Data.Manifest as DMan
-import qualified Codec.Epub.Data.Spine    as DSpin
-import qualified Data.ByteString.Base64 as B64
+import System.FilePath (normalise, takeDirectory, (</>))
+import Text.HTML.TagSoup (Tag (..), innerText, parseTags)

 type EpubAction a = ReaderT EpubEnv IO a

 data EpubEnv = EpubEnv
-  { archive   :: Archive
-  , opfXml    :: String
-  , baseDir   :: FilePath
-  , bookPath  :: FilePath
-  , eMetadata :: DMeta.Metadata
-  , eManifest :: DMan.Manifest
+  { archive :: Archive,
+    opfXml :: String,
+    baseDir :: FilePath,
+    bookPath :: FilePath,
+    eMetadata :: DMeta.Metadata,
+    eManifest :: DMan.Manifest
  }

 openEpub :: FilePath -> IO (Either String EpubEnv)
@ -52,20 +52,22 @@ openEpub path = do
          let xml = T.unpack $ TE.decodeUtf8 $ B.toStrict $ fromEntry entry

          metaResult <- runExceptT $ getMetadata xml
-          manResult  <- runExceptT $ getManifest xml
+          manResult <- runExceptT $ getManifest xml

          case (metaResult, manResult) of
            (Left err, _) -> pure $ Left $ "Metadata parse error: " ++ err
            (_, Left err) -> pure $ Left $ "Manifest parse error: " ++ err
-            (Right meta, Right man) -> 
-              pure $ Right $ EpubEnv 
-                { archive   = arch
-                , opfXml    = xml
-                , baseDir   = takeDirectory opfPath
-                , bookPath  = path
-                , eMetadata = meta
-                , eManifest = man
-                }
+            (Right meta, Right man) ->
+              pure $
+                Right $
+                  EpubEnv
+                    { archive = arch,
+                      opfXml = xml,
+                      baseDir = takeDirectory opfPath,
+                      bookPath = path,
+                      eMetadata = meta,
+                      eManifest = man
+                    }

 getOpfPath :: Archive -> Maybe FilePath
 getOpfPath arch =
@ -76,7 +78,7 @@ getOpfPath arch =
 getRootPath :: [Tag String] -> Maybe FilePath
 getRootPath [] = Nothing
 getRootPath (TagOpen "rootfile" attrs : _) = lookup "full-path" attrs
-getRootPath (_:xs) = getRootPath xs
+getRootPath (_ : xs) = getRootPath xs

 resolveSpine :: EpubAction [FilePath]
 resolveSpine = do
@ -88,7 +90,7 @@ resolveSpine = do
  case spineResult of
    Right (DSpin.Spine _ refs) -> do
      let lookupHref ident = DMan.mfiHref <$> find (\mi -> DMan.mfiId mi == ident) items
-      pure [ p | ref <- refs , let ident = DSpin.siIdRef ref , Just p <- [lookupHref ident] ]
+      pure [p | ref <- refs, let ident = DSpin.siIdRef ref, Just p <- [lookupHref ident]]
    _ -> pure []

 getChapter :: FilePath -> EpubAction [Tag T.Text]
@ -97,7 +99,7 @@ getChapter filename = do
  let full = normalise (baseDir env </> filename)
  case findEntryByPath full (archive env) of
    Nothing -> pure []
-    Just e  -> do
+    Just e -> do
      let rawTags = parseTags . TE.decodeUtf8 . B.toStrict $ fromEntry e
      pure (filterJunk (embedImages env rawTags))

@ -105,48 +107,47 @@ getMimeFromManifest :: DMan.Manifest -> FilePath -> T.Text
 getMimeFromManifest (DMan.Manifest items) relPath =
  case find (\item -> DMan.mfiHref item == relPath) items of
    Just item -> T.pack $ DMan.mfiMediaType item
-    Nothing   -> "image/jpeg"
+    Nothing -> "image/jpeg"

 -- Replace img tags with base64
 embedImages :: EpubEnv -> [Tag T.Text] -> [Tag T.Text]
-embedImages env = map processTag 
+embedImages env = map processTag
  where
    processTag (TagOpen "img" attrs) = TagOpen "img" (map replaceSrc attrs)
-    processTag other                 = other
+    processTag other = other

    replaceSrc (name, value)
      | name == "src" = ("src", findImage value) -- guards to check for src otherwise output the argument it was given without changes
-      | otherwise     = (name, value)
+      | otherwise = (name, value)

    findImage path =
      let fullPath = normalise (baseDir env </> T.unpack path)
-      in case findEntryByPath fullPath (archive env) of
-           Nothing -> path
-           Just entry ->
-             let rawData = B.toStrict $ fromEntry entry
-                 b64 = TE.decodeUtf8 $ B64.encode rawData
-                 mime = getMimeFromManifest (eManifest env) (T.unpack path)
-             in "data:" <> mime <> ";base64," <> b64
+       in case findEntryByPath fullPath (archive env) of
+            Nothing -> path
+            Just entry ->
+              let rawData = B.toStrict $ fromEntry entry
+                  b64 = TE.decodeUtf8 $ B64.encode rawData
+                  mime = getMimeFromManifest (eManifest env) (T.unpack path)
+               in "data:" <> mime <> ";base64," <> b64

 filterJunk :: [Tag T.Text] -> [Tag T.Text]
-filterJunk = go 
+filterJunk = go
  where
    go [] = []
-    go (TagOpen name _ : xs) | name `elem` ["script", "style", "head", "link", "meta"] = -- these are elems we want to filter out
-        go (dropUntilClose name xs)
-    go (x:xs) = x : go xs
+    go (TagOpen name _ : xs) | name `elem` ["script", "style", "head", "link", "meta"] = go (dropUntilClose name xs) -- these are elems we want to filter out
+    go (x : xs) = x : go xs

    dropUntilClose _ [] = []
    dropUntilClose name (TagClose n : xs) | n == name = xs
    dropUntilClose name (_ : xs) = dropUntilClose name xs

 getChapterTitle :: [Tag T.Text] -> T.Text
-getChapterTitle tags = 
-    case dropWhile (not . ishding) tags of
-      (TagOpen x _ : xs ) -> T.strip $ innerText (takeWhile (not . isclose x) xs) -- get the raw heading content, remove nested tags
-      _                   -> "Untitled Chapter"
+getChapterTitle tags =
+  case dropWhile (not . ishding) tags of
+    (TagOpen x _ : xs) -> T.strip $ innerText (takeWhile (not . isclose x) xs) -- get the raw heading content, remove nested tags
+    _ -> "Untitled Chapter"
  where
-    ishding (TagOpen n _ ) = n `elem` ["h1", "h2", "h3"]
-    ishding _                = False
-    isclose n  (TagClose n') = n == n'
-    isclose _ _              = False
+    ishding (TagOpen n _) = n `elem` ["h1", "h2", "h3"]
+    ishding _ = False
+    isclose n (TagClose n') = n == n'
+    isclose _ _ = False
--- a/app/Main.hs
+++ b/app/Main.hs
@ -1,7 +1,7 @@
 module Main where

-import System.Environment (getArgs)
 import EpubParser (openEpub)
+import System.Environment (getArgs)
 import UI (runApp)

 main :: IO ()
--- a/app/Persistence.hs
+++ b/app/Persistence.hs
@ -1,26 +1,27 @@
-module Persistence 
-    ( saveLastRead
-    , loadLastRead 
-    ) where
+module Persistence
+  ( saveLastRead,
+    loadLastRead,
+  )
+where

-import System.Directory (getXdgDirectory, XdgDirectory(XdgData), createDirectoryIfMissing)
-import System.FilePath ((</>))
+import Control.Exception (SomeException, try)
 import qualified Data.Text as T
 import qualified Data.Text.IO as TIO
-import Control.Exception (try, SomeException)
+import System.Directory (XdgDirectory (XdgData), createDirectoryIfMissing, getXdgDirectory)
+import System.FilePath ((</>))
 import Text.Read (readMaybe)

 saveLastRead :: FilePath -> Int -> IO ()
 saveLastRead bPath chapterIdx = do
-    dataDir <- getXdgDirectory XdgData "svitak"
-    createDirectoryIfMissing True dataDir
-    
-    let configFile = dataDir </> "last_read.txt"
-    -- Line 1 = Path, Line 2 = Index
-    let content = T.pack bPath <> T.pack "\n" <> T.pack (show chapterIdx)
-    
-    TIO.writeFile configFile content
-    putStrLn $ "Progress saved to: " ++ configFile
+  dataDir <- getXdgDirectory XdgData "svitak"
+  createDirectoryIfMissing True dataDir
+
+  let configFile = dataDir </> "last_read.txt"
+  -- Line 1 = Path, Line 2 = Index
+  let content = T.pack bPath <> T.pack "\n" <> T.pack (show chapterIdx)
+
+  TIO.writeFile configFile content
+  putStrLn $ "Progress saved to: " ++ configFile

 loadLastRead :: IO (Maybe (FilePath, Int))
 loadLastRead = do
@ -28,13 +29,13 @@ loadLastRead = do
  let configFile = dataDir </> "last_read.txt"

  result <- try (TIO.readFile configFile) :: IO (Either SomeException T.Text)
-  
+
  case result of
    Left _ -> pure Nothing
    Right content -> do
      let linesOfFile = T.lines content
      case linesOfFile of
-        [path, idxStr] 
-          | Just idx <- readMaybe (T.unpack idxStr) -> 
+        [path, idxStr]
+          | Just idx <- readMaybe (T.unpack idxStr) ->
              pure $ Just (T.unpack path, idx)
        _ -> pure Nothing
--- a/app/State.hs
+++ b/app/State.hs
@ -2,10 +2,10 @@

 module State where

-import qualified Data.Text as T
-import Text.HTML.TagSoup (Tag, renderTags)
 import Control.Concurrent.Async (Async)
+import qualified Data.Text as T
 import EpubParser (EpubEnv, getChapterTitle)
+import Text.HTML.TagSoup (Tag, renderTags)

 data ChapterView = ChapterView
  { viewTitle :: T.Text,
--- a/app/UI.hs
+++ b/app/UI.hs
@ -1,99 +1,99 @@
-{-# LANGUAGE OverloadedStrings, OverloadedLabels #-}
+{-# LANGUAGE OverloadedLabels #-}
+{-# LANGUAGE OverloadedStrings #-}

 module UI (runApp) where

-import qualified GI.Gtk as Gtk
-import qualified GI.Gdk as Gdk
-import qualified GI.Gio as Gio
+import Codec.Epub.Data.Metadata (metaTitles, titleText, titleType)
+import Control.Concurrent.Async (async)
+import Control.Concurrent.STM (atomically, modifyTVar, newTVarIO, readTVar)
+import Control.Monad.Reader (runReaderT)
+import Data.GI.Base (AttrOp (..))
+import Data.List (find)
+import qualified Data.Text as T
+import EpubParser (EpubEnv (..), getChapter, resolveSpine)
 import qualified GI.GLib as GLib
 import qualified GI.GLib.Constants as GLibConst
-import qualified GI.WebKit as WebKit
+import qualified GI.Gdk as Gdk
+import qualified GI.Gio as Gio
+import qualified GI.Gtk as Gtk
 import qualified GI.Gtk.Enums as GtkEnums
-import qualified Data.Text as T
-
-import Data.List (find)
-import Data.GI.Base (AttrOp(..))
-import Control.Monad.Reader (runReaderT)
-import Control.Concurrent.STM (newTVarIO, readTVar, atomically, modifyTVar)
-import Control.Concurrent.Async (async)
-import Codec.Epub.Data.Metadata (metaTitles, titleType, titleText)
-import EpubParser (EpubEnv(..), resolveSpine, getChapter)
-import Persistence (saveLastRead, loadLastRead)
-import State (AppState(..), ChapterView(..), initialState, prepareView)
+import qualified GI.WebKit as WebKit
+import Persistence (loadLastRead, saveLastRead)
+import State (AppState (..), ChapterView (..), initialState, prepareView)

 runApp :: EpubEnv -> IO ()
 runApp env' = do
-    app <- Gtk.applicationNew (Just "com.svitak.reader.v2") []
+  app <- Gtk.applicationNew (Just "com.svitak.reader.v2") []

-    _ <- Gtk.on app #activate $ do
+  _ <- Gtk.on app #activate $ do
+    stateTVar <- newTVarIO (initialState env')

-        stateTVar <- newTVarIO (initialState env')
+    window <- Gtk.applicationWindowNew app
+    webView <- WebKit.webViewNew
+    Gtk.set window [#defaultWidth := 800, #defaultHeight := 600, #child := webView]

-        window <- Gtk.applicationWindowNew app
-        webView <- WebKit.webViewNew
-        Gtk.set window [ #defaultWidth := 800, #defaultHeight := 600, #child := webView ]
+    -- load all chapters on another thread
+    let loadChapter index = do
+          st <- atomically $ readTVar stateTVar
+          case prepareView st index of
+            Nothing -> pure ()
+            Just view -> do
+              Gtk.set window [#title := viewTitle view]
+              WebKit.webViewLoadHtml webView (viewHtml view) Nothing

-        -- load all chapters on another thread
-        let loadChapter index = do
-              st <- atomically $ readTVar stateTVar
-              case prepareView st index of
-                Nothing -> pure ()
-                Just view -> do
-                  Gtk.set window [ #title := viewTitle view ]
-                  WebKit.webViewLoadHtml webView (viewHtml view) Nothing
+              atomically $ modifyTVar stateTVar $ \s -> s {cIdx = viewIdx view}
+              _ <- async $ saveLastRead (bookPath env') (viewIdx view)
+              pure ()

-                  atomically $ modifyTVar stateTVar $ \s -> s { cIdx = viewIdx view}
-                  _ <- async $ saveLastRead (bookPath env') (viewIdx view)
-                  pure ()
+    -- keyboard handling
+    keyCtrl <- Gtk.eventControllerKeyNew
+    Gtk.eventControllerSetPropagationPhase keyCtrl GtkEnums.PropagationPhaseCapture

-        -- keyboard handling
-        keyCtrl <- Gtk.eventControllerKeyNew
-        Gtk.eventControllerSetPropagationPhase keyCtrl GtkEnums.PropagationPhaseCapture
-        
-        _ <- Gtk.on keyCtrl #keyPressed $ \keyval _ _ -> do
-            stNow <- atomically $ readTVar stateTVar
-            case keyval of
-                Gdk.KEY_Right -> loadChapter (cIdx stNow + 1) >> pure True
-                Gdk.KEY_Left  -> loadChapter (cIdx stNow - 1) >> pure True
-                Gdk.KEY_equal -> do
-                    let newZ = zoomlvl stNow + 0.1
-                    atomically $ modifyTVar stateTVar $ \s -> s { zoomlvl = newZ }
-                    WebKit.webViewSetZoomLevel webView newZ
-                    pure True
-                Gdk.KEY_minus -> do
-                    let newZ = max 0.1 (zoomlvl stNow - 0.1)
-                    atomically $ modifyTVar stateTVar $ \s -> s { zoomlvl = newZ }
-                    WebKit.webViewSetZoomLevel webView newZ
-                    pure True
-                _ -> pure False
+    _ <- Gtk.on keyCtrl #keyPressed $ \keyval _ _ -> do
+      stNow <- atomically $ readTVar stateTVar
+      case keyval of
+        Gdk.KEY_Right -> loadChapter (cIdx stNow + 1) >> pure True
+        Gdk.KEY_Left -> loadChapter (cIdx stNow - 1) >> pure True
+        Gdk.KEY_equal -> do
+          let newZ = zoomlvl stNow + 0.1
+          atomically $ modifyTVar stateTVar $ \s -> s {zoomlvl = newZ}
+          WebKit.webViewSetZoomLevel webView newZ
+          pure True
+        Gdk.KEY_minus -> do
+          let newZ = max 0.1 (zoomlvl stNow - 0.1)
+          atomically $ modifyTVar stateTVar $ \s -> s {zoomlvl = newZ}
+          WebKit.webViewSetZoomLevel webView newZ
+          pure True
+        _ -> pure False

-        Gtk.widgetAddController window keyCtrl
-        #present window
+    Gtk.widgetAddController window keyCtrl
+    #present window

-        -- start eager parse
-        _ <- async $ do
-            ispine <- runReaderT resolveSpine env'
-            allChapters <- runReaderT (mapM getChapter ispine) env'
-            
-            let titles = metaTitles (eMetadata env')
-            let rawT = case find (\t -> titleType t == Just "main") titles of
-                         Just t  -> titleText t
-                         Nothing -> if null titles then "Unknown" else titleText (head titles)
+    -- start eager parse
+    _ <- async $ do
+      ispine <- runReaderT resolveSpine env'
+      allChapters <- runReaderT (mapM getChapter ispine) env'

-            atomically $ modifyTVar stateTVar $ \s -> s 
-                { cSpine = ispine
-                , cAllChapters = allChapters 
-                , bTitle = T.pack rawT
-                }
+      let titles = metaTitles (eMetadata env')
+      let rawT = case find (\t -> titleType t == Just "main") titles of
+            Just t -> titleText t
+            Nothing -> if null titles then "Unknown" else titleText (head titles)

-            _ <- GLib.idleAdd GLibConst.PRIORITY_DEFAULT $ do
-                maybeSaved <- loadLastRead
-                case maybeSaved of
-                  Just (path, idx) | path == bookPath env' -> loadChapter idx
-                  _ -> loadChapter 0
-                pure False
-            pure ()
-        pure ()
+      atomically $ modifyTVar stateTVar $ \s ->
+        s
+          { cSpine = ispine,
+            cAllChapters = allChapters,
+            bTitle = T.pack rawT
+          }

-    _ <- Gio.applicationRun app Nothing
+      _ <- GLib.idleAdd GLibConst.PRIORITY_DEFAULT $ do
+        maybeSaved <- loadLastRead
+        case maybeSaved of
+          Just (path, idx) | path == bookPath env' -> loadChapter idx
+          _ -> loadChapter 0
+        pure False
+      pure ()
    pure ()
+
+  _ <- Gio.applicationRun app Nothing
+  pure ()