diff options
Diffstat (limited to 'src/Main.hs')
-rw-r--r-- | src/Main.hs | 41 |
1 files changed, 24 insertions, 17 deletions
diff --git a/src/Main.hs b/src/Main.hs index 4a6f2f2..d0bb0e1 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -5,13 +5,13 @@ 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 Numeric (showIntAtBase, readInt) import Zettel data HeaderState = HeaderState @@ -72,7 +72,7 @@ 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 +fromBase base = fmap fst . viaNonEmpty head . readInt base ((< base) . digitToInt26) digitToInt26 toBase :: Int -> Int -> String toBase base num = showIntAtBase base intToDigit26 num "" @@ -85,9 +85,9 @@ 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 + case decimal t of + Right (a, _) -> Just . show $ f a + _ -> Nothing | isLetter $ T.head t = opOnBase26 f t | otherwise = Nothing @@ -96,8 +96,8 @@ 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) + then Just (combineId (init ne)) + else combineId . (init ne <>) . (: []) <$> opOnIdPart (subtract 1) (last ne) Nothing -> Nothing quoted :: Text -> Text @@ -125,20 +125,27 @@ decode = decodeUtf8 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"] + 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" + 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 |