path: root/src/Main.hs

{-# LANGUAGE DeriveDataTypeable #-}

module Main where

-- import Data.Char (isAlphaNum, isLetter, isNumber)
-- import Data.Default (def)
-- import Data.List (nub)
-- import qualified Data.Text as T
-- import Data.Text.Read (decimal)
-- import Numeric (readInt, showIntAtBase)
-- import qualified Relude.Extra.Map as Map
-- import Text.Pandoc.Class (runIOorExplode)
-- import Text.Pandoc.Definition (Block (..), Inline (..), Pandoc(..), MetaValue(..), Meta(..))
-- import Text.Pandoc.Readers (readOrg)
-- import Text.Pandoc.Templates (compileTemplate, WithDefaultPartials(..), Template(..))
-- import Text.Pandoc.Writers (writeChunkedHTML, writeMarkdown)
-- import Text.Pandoc.Options (WriterOptions(..))
-- import Text.Pandoc.Chunks (splitIntoChunks, PathTemplate(..), ChunkedDoc(..), Chunk(..), toTOCTree, tocToList)
-- import Text.Pandoc.Shared (stringify)
-- import Text.Pandoc.Walk (walkM, walk)
-- import qualified Data.ByteString.Lazy as B
-- import System.Directory (createDirectoryIfMissing)

import System.Console.CmdArgs.Implicit
import Zettel

-- data HeaderState = HeaderState
--  { headerStateMap :: Map Text ((ZettelId, Text), [Text]),
--    headerStateCurrent :: Text
--  }

-- isLink :: Inline -> Bool
-- isLink Link {} = True
-- isLink _ = False
--
-- parseIds :: Text -> Text
-- parseIds t
--  | T.null t = ""
--  | T.head t == '#' && T.all isAlphaNum (T.tail t) = T.tail t
--  | otherwise = ""
--
-- addLinks :: [Inline] -> Block -> State HeaderState Block
-- addLinks il b = do
--  let f = filter isLink il
--  s <- get
--  let m' =
--        Map.insertWith
--          (\(_, y) (z, x) -> (z, x <> y))
--          (headerStateCurrent s)
--          ((mempty, mempty), filter (not . T.null) (parseIds . stringify <$> f))
--          (headerStateMap s)
--  put (HeaderState m' (headerStateCurrent s))
--  return b
--
-- getHeaders :: Block -> State HeaderState Block
-- getHeaders h@(Header _ (a, _, _) t) = do
--  s <- get
--  let m' = Map.insert a ((ZettelId a, stringify t), []) (headerStateMap s)
--  put (HeaderState m' a)
--  return h
-- getHeaders p@(Plain i) = addLinks i p
-- getHeaders p@(Para i) = addLinks i p
-- getHeaders p@(LineBlock i) = addLinks (concat i) p
-- getHeaders p = addLinks [] p
--
-- splitId :: ZettelId -> [Text]
-- splitId (ZettelId zid)
--  | T.null zid = []
--  | isNumber (T.head zid) = T.takeWhile isNumber zid : (splitId . ZettelId $ T.dropWhile isNumber zid)
--  | isLetter (T.head zid) = T.takeWhile isLetter zid : (splitId . ZettelId $ T.dropWhile isLetter zid)
--  | otherwise = []
--
-- combineId :: [Text] -> ZettelId
-- combineId = ZettelId . fold
--
-- intToDigit26 :: Int -> Char
-- intToDigit26 i
--  | i <= 25 && i >= 0 = toEnum $ fromEnum 'a' + i
--  | otherwise = error "Integer out of range."
--
-- digitToInt26 :: Char -> Int
-- digitToInt26 c = fromEnum c - fromEnum 'a'
--
-- fromBase :: Int -> String -> Maybe Int
-- fromBase base = fmap fst . viaNonEmpty head . readInt base ((< base) . digitToInt26) digitToInt26
--
-- toBase :: Int -> Int -> String
-- toBase base num = showIntAtBase base intToDigit26 num ""
--
-- opOnBase26 :: (Int -> Int) -> Text -> Maybe Text
-- opOnBase26 f t =
--  fromString . toBase 26 . f <$> fromBase 26 (toString t)
--
-- opOnIdPart :: (Int -> Int) -> Text -> Maybe Text
-- opOnIdPart f t
--  | T.null t = Nothing
--  | isNumber $ T.head t =
--      case decimal t of
--        Right (a, _) -> Just . show $ f a
--        _ -> Nothing
--  | isLetter $ T.head t = opOnBase26 f t
--  | otherwise = Nothing
--
-- defPredId :: ZettelId -> Maybe ZettelId
-- defPredId z =
--  case nonEmpty (splitId z) of
--    Just ne ->
--      if last ne == "a" || last ne == "1"
--        then Just (combineId (init ne))
--        else combineId . (init ne <>) . (: []) <$> opOnIdPart (subtract 1) (last ne)
--    Nothing -> Nothing
--
-- quoted :: Text -> Text
-- quoted t = "\"" <> t <> "\""
--
-- toDot :: [Text] -> (Text, [Text]) -> Text
-- toDot _ (t, l) = foldMap (\l' -> quoted l' <> " -> " <> quoted t <> ";\n") l
--
-- toDotNodes :: ZettelId -> Text
-- toDotNodes (ZettelId t)
--  | T.null t = ""
--  | isNumber $ T.head t = quoted t <> " [color=" <> T.singleton (T.head t) <> "];\n"
--  | otherwise = ""
--
-- addSelfLinks :: Map Text ((ZettelId, Text), [Text]) -> ZettelId -> Map Text ((ZettelId, Text), [Text])
-- addSelfLinks m z =
--  Map.insertWith (\((_, _), l') ((z', t), l) -> ((z', t), l ++ l')) (unZettelId z) ((mempty, mempty), [unZettelId z]) m
--
-- addSelfLinks2 :: ((ZettelId, b), [Text]) -> ((ZettelId, b), [Text])
-- addSelfLinks2 ((t, b), l) =
--  ((t, b), maybeToList (unZettelId <$> defPredId t) <> l)
--
-- decode :: ByteString -> Text
-- decode = decodeUtf8
--
-- normaliseHeadings :: Int -> Block -> Block
-- normaliseHeadings i (Header _ a b) = Header i a b
-- normaliseHeadings _ a = a
--
-- subtractHeadings :: Int -> Block -> Block
-- subtractHeadings i (Header current a b) = Header (current - i) a b
-- subtractHeadings _ a = a
--
-- removeHeadings :: Block -> Block
-- removeHeadings (Header _ _ _) = Plain []
-- removeHeadings a = a
--
-- mkLongPath :: ZettelId -> Text
-- mkLongPath i = fold . intersperse "/" $ splitId i
--
-- splitZettel :: Chunk -> Pandoc
-- splitZettel c =
--  walk removeHeadings
--    (Pandoc
--      (Meta
--        (fromList [("title", MetaInlines $ chunkHeading c)]))
--      (chunkContents c))
--
-- template :: Text
-- template = unlines ["+++",
--                    "title = \"$title$\"",
--                    "$if(date)$",
--                    "date = \"$date$\"",
--                    "$endif$",
--                    "+++",
--                    "",
--                    "$body$"]
--
-- main :: IO ()
-- main = do
--  let fl =
--        [ "/Users/ymherklotz/Dropbox/zk/verification.org",
--          "/Users/ymherklotz/Dropbox/zk/mathematics.org",
--          "/Users/ymherklotz/Dropbox/zk/hls.org",
--          "/Users/ymherklotz/Dropbox/zk/computing.org",
--          "/Users/ymherklotz/Dropbox/zk/hardware.org"
--        ]
--  fs <- mapM readFileBS fl
--  x <- mapM (runIOorExplode . readOrg def . decode) fs
--  let (_, s) = runState (forM x (walkM getHeaders)) (HeaderState mempty "toplevel")
--  let allZettel = second nub . addSelfLinks2 <$> headerStateMap s
--  writeFileText "out.dot" $
--    "digraph G {\noverlap=false;\nnode [colorscheme=pastel28,style=filled];\n"
--      <> foldMap (toDotNodes . fst . fst) allZettel
--      <> foldMap
--        ( toDot (foldMap snd allZettel)
--            . (\((ZettelId a, _), b) -> (a, b))
--        )
--        allZettel
--      <> "}\n"
--
--  let Just(firstDoc) = viaNonEmpty head x
----  print firstDoc
--  let res = splitIntoChunks "%i.md" False Nothing 15 firstDoc
--  Right templ <- runIOorExplode . runWithDefaultPartials $ compileTemplate "" template
--  forM_ (chunkedChunks res) $ \c -> do
--    print (chunkContents c)
--    let toc = case Map.lookup (chunkId c) allZettel of
--          Just toLinks ->
--            [BulletList (map (\x -> [Para [Link mempty [Str ("#" <> x)] ("/" <> x, mempty)]]) (snd toLinks))]
--          Nothing -> []
--    text <- runIOorExplode $ writeMarkdown (def { writerTemplate = Just templ }) (splitZettel c)
--    writeFileText ("test/content/" <> chunkPath c) text
--

data Options = Options
  { org :: [FilePath],
    bibliography :: Maybe FilePath,
    csl :: Maybe FilePath,
    index :: Maybe FilePath,
    output :: FilePath
  }
  deriving (Show, Data, Typeable)

options :: Options
options =
  Options
    { org = def &= args &= typ "FILES...",
      output = def &= name "o" &= help "Output directory" &= typDir,
      bibliography =
        def
          &= name "b"
          &= help "Bibliography file path (default: references.bib)"
          &= typFile
          &= opt (Just ("references.bib" :: FilePath)),
      csl =
        def
          &= name "c"
          &= help "Csl file path (default: ieee.csl)"
          &= typFile
          &= opt (Just ("ieee.csl" :: FilePath)),
      index =
        def
          &= name "i"
          &= help "Index file path"
          &= typFile
    }
    &= summary "org-zk v0.1.0, (C) 2023 Yann Herklotz"
    &= program "org-zk"
    &= verbosity

main :: IO ()
main = do
  zkOpts <- cmdArgs options
  let fl = org zkOpts
  graph' <- parseZettelKasten $ zip [1 ..] fl
  let graph = transcludeMdAll graph'
  let linkedGraph = linkAll graph
  let wrappedGraph = wrapZettelGraph linkedGraph
  renderZettelGraphFile (output zkOpts) wrappedGraph