From 07fa7ad1000f6ac6fd76fc9233c150bdbde2e67b Mon Sep 17 00:00:00 2001 From: defanor Date: Thu, 23 Nov 2017 06:20:50 +0300 Subject: Allow user-defined digits and radices for reference numbering --- Pancake/Command.hs | 21 +++++++++++++++------ Pancake/Configuration.hs | 4 ++++ Pancake/Rendering.hs | 29 ++++++++++++++++++++--------- 3 files changed, 39 insertions(+), 15 deletions(-) (limited to 'Pancake') diff --git a/Pancake/Command.hs b/Pancake/Command.hs index 97cb25c..44ac768 100644 --- a/Pancake/Command.hs +++ b/Pancake/Command.hs @@ -15,6 +15,9 @@ import Network.URI import Text.Parsec import Text.Parsec.String import qualified Data.Map as M +import Numeric +import Data.List +import Data.Maybe import Pancake.Configuration @@ -52,13 +55,19 @@ basicCommand = choice . map (\(s, c) -> try (string s <* eof) *> pure c) $ , ("?", ShowCurrent) , ("", More)] +pReference :: String -> Parser Int +pReference digits = do + ds <- many1 (choice $ map char digits) + pure . fst . head $ readInt (length digits) + (`elem` digits) (fromJust . flip elemIndex digits) ds + -- | 'Follow' command parser. -followRef :: Parser Command -followRef = Follow . read <$> many1 digit <* eof +followRef :: String -> Parser Command +followRef digits = Follow <$> (optional (char '.') *> pReference digits <* eof) -- | 'Show' command parser. -showRef :: Parser Command -showRef = char '?' *> (Show . read <$> many1 digit) <* eof +showRef :: String -> Parser Command +showRef digits = Show <$> (char '?' *> pReference digits <* eof) -- | 'GoTo' command parser. goTo :: Parser Command @@ -82,8 +91,8 @@ command :: Config -> Parser Command command c = choice (map try [ basicCommand "basic command" - , followRef "follow ref" - , showRef "show ref" + , followRef (referenceDigits c) "follow ref" + , showRef (referenceDigits c) "show ref" , shortcut (shortcuts c) "shortcut" , goTo "go to" ]) diff --git a/Pancake/Configuration.hs b/Pancake/Configuration.hs index 5c52dda..2d20985 100644 --- a/Pancake/Configuration.hs +++ b/Pancake/Configuration.hs @@ -44,6 +44,9 @@ data Config = Config { commands :: M.Map String String , historyDepth :: Int -- ^ The amount of history entries (into either -- direction) to keep. + , referenceDigits :: String + -- ^ Digits to use for reference numbering, must + -- be unique. } deriving (Generic, Show) -- | For configuration parsing. @@ -78,6 +81,7 @@ instance Default Config where , ("vs", "gopher://gopher.floodgap.com/7/v2/vs?")] , paginate = True , historyDepth = 100 + , referenceDigits = "0123456789" } -- | Loads configuration from an XDG config directory. diff --git a/Pancake/Rendering.hs b/Pancake/Rendering.hs index 6bc8268..d7742ab 100644 --- a/Pancake/Rendering.hs +++ b/Pancake/Rendering.hs @@ -29,6 +29,7 @@ import Control.Monad.Writer import Control.Monad.State import System.FilePath import Data.Char +import Numeric -- | The type of a list item that should be rendered next. @@ -67,6 +68,7 @@ data RS = RS { indentationLevel :: Int , lineNumber :: Int , listing :: Maybe Listing , columns :: Int + , refDigits :: String } deriving (Show, Eq) -- | This is what gets rendered. @@ -76,6 +78,9 @@ data RendererOutput = RLink URI | RIdentifier String Int deriving (Show, Eq) +showRef :: String -> Int -> String +showRef digits n = showIntAtBase (length digits) (digits !!) n "" + -- | Extracts links. rLinks :: [RendererOutput] -> [URI] rLinks [] = [] @@ -113,13 +118,15 @@ runRenderer :: Int -- ^ Note number to start with. -> Int -- ^ Line number to start with. + -> String + -- ^ Digits to use for reference numbering. -> Renderer a -- ^ A renderer. -> [RendererOutput] -- ^ Collected links and text lines. -runRenderer cols ls ns ln r = +runRenderer cols ls ns ln ds r = let o = snd $ evalState (runWriterT r) - (RS 0 ls ns ln Nothing cols) + (RS 0 ls ns ln Nothing cols ds) in o ++ concatMap (map RLine . rLines) (rNotes o) -- | Stores a link, increasing the counter. @@ -318,8 +325,9 @@ readInline (P.Link attr alt (url, title)) = do let color = case uri of (URI "" Nothing "" "" ('#':_)) -> Magenta _ -> Cyan + st <- get pure $ (map $ Denote (Link uri) . Fg color) t ++ - [Fg Blue $ fromString (concat ["[", show cnt, "]"])] + [Fg Blue $ fromString (concat ["[", showRef (refDigits st) cnt, "]"])] Nothing -> pure [fromString title] readInline (P.Image attr alt (url, title)) = do storeAttr attr @@ -333,15 +341,16 @@ readInline (P.Image attr alt (url, title)) = do (title', []) -> [fromString title'] (_, alt') -> alt' cnt <- storeLink uri + st <- get pure $ (map $ Denote (Link uri) . Fg Cyan) t ++ - [Fg Blue $ fromString (concat ["[", show cnt, "]"])] + [Fg Blue $ fromString (concat ["[", showRef (refDigits st) cnt, "]"])] readInline (P.Note bs) = do -- Minor issues are quite likely with this. st <- get -- 12 is somewhat arbitrary, but narrowing the rendered notes so -- that "^{note xxx}" could be added without overflow. let ro = runRenderer (columns st - 12) (linkCount st) (noteCount st) 0 - (renderBlocks bs) + (refDigits st) (renderBlocks bs) cnt <- storeNote ro pure [Superscript . Fg Red . fromString $ "[" ++ show cnt ++ "]"] readInline (P.Span attr i) = do @@ -404,8 +413,8 @@ renderBlock (P.Table caption aligns widths headers rows) = do renderCell :: Int -> [P.Block] -> Renderer [RendererOutput] renderCell w blocks = do st <- get - pure $ runRenderer w (linkCount st) (noteCount st) (lineNumber st) $ - mapM_ renderBlock blocks + pure $ runRenderer w (linkCount st) (noteCount st) (lineNumber st) + (refDigits st) $ mapM_ renderBlock blocks tableCell :: (P.Alignment, Int, [P.Block]) -> Renderer [StyledLine] tableCell (a, w, blocks) = do l <- renderCell w blocks @@ -451,9 +460,11 @@ renderBlocks b = withIndent $ mapM_ renderBlockLn b -- | Renders a document. renderDoc :: Int -- ^ Number of columns. + -> String + -- ^ Digits to use for reference numbering. -> P.Pandoc -- ^ Document to render. -> [RendererOutput] -- ^ Rendered document. -renderDoc cols (P.Pandoc _ blocks) = - runRenderer cols 0 0 1 $ mapM_ renderBlockLn blocks +renderDoc cols ds (P.Pandoc _ blocks) = + runRenderer cols 0 0 1 ds $ mapM_ renderBlockLn blocks -- cgit v1.2.3