summaryrefslogtreecommitdiffstats
path: root/src/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Main.hs')
-rw-r--r--src/Main.hs338
1 files changed, 200 insertions, 138 deletions
diff --git a/src/Main.hs b/src/Main.hs
index d0bb0e1..7db7885 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,127 +1,203 @@
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 (..))
-import Text.Pandoc.Readers (readOrg)
-import Text.Pandoc.Shared (stringify)
-import Text.Pandoc.Walk (walkM)
+-- 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 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
+-- 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
+--
main :: IO ()
main = do
@@ -132,21 +208,7 @@ main = do
"/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"
-
--- forM_ allZettel (\(_, ((a, _), _)) -> do
--- t <- runIOorExplode $ writeMarkdown def p
--- writeFileText ("neuron/" <> toString a <> ".md") t
--- )
+ graph <- parseZettelKasten fl
+ let linkedGraph = linkAll graph
+ renderZettelGraphFile "test/content/tree" linkedGraph
+ return ()
generated by cgit (git 2.34.1) at 2024-05-18 10:50:18 +0000