summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorYann Herklotz <git@yannherklotz.com>2023-05-09 09:49:12 +0100
committerYann Herklotz <git@yannherklotz.com>2023-05-09 09:49:12 +0100
commit8e944915c42b908fd61b34ee2d68aadb534af174 (patch)
treea8baafe739a000a79d8d1f152314a9baaaa64ef9
parent084022b1da8e0f0e8c9efb814f32c11903f56969 (diff)
downloadzk-visual-8e944915c42b908fd61b34ee2d68aadb534af174.tar.gz
zk-visual-8e944915c42b908fd61b34ee2d68aadb534af174.zip
Format code using ormolu
-rw-r--r--src/Main.hs41
-rw-r--r--src/Zettel.hs9
2 files changed, 29 insertions, 21 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
diff --git a/src/Zettel.hs b/src/Zettel.hs
index d754741..99c2dd3 100644
--- a/src/Zettel.hs
+++ b/src/Zettel.hs
@@ -1,6 +1,6 @@
-{-# Language GeneralizedNewtypeDeriving #-}
-{-# Language DerivingVia #-}
-{-# Language StandaloneDeriving #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE StandaloneDeriving #-}
module Zettel where
@@ -12,11 +12,12 @@ class Combine a where
newtype UseCombine a = UC a
-instance Monoid a => Combine (UseCombine a) where
+instance (Monoid a) => Combine (UseCombine a) where
cappend (UC a) (UC b) = UC $ a <> b
cempty = UC mempty
deriving via (UseCombine Text) instance Combine Text
+
deriving via (UseCombine Pandoc) instance Combine Pandoc
newtype ZettelId = ZettelId