Allow user-defined digits and radices for reference numbering

3 files changed, 39 insertions, 15 deletions

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