Last active
February 21, 2022 23:21
-
-
Save Porges/3235859dff454ae8c20ac06097c9554c to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE ApplicativeDo, BlockArguments, RankNTypes, FlexibleInstances, ScopedTypeVariables #-} | |
module Main where | |
import Data.List (isPrefixOf, isInfixOf) | |
import Data.Foldable (toList, forM_) | |
import System.Directory (listDirectory) | |
import qualified System.IO as IO | |
-- Entity provides name and createdAt for a particular entity (read: file). | |
data Entity t = Entity | |
{ name :: String | |
, createdAt :: Date | |
, value :: t } | |
type Line = String | |
type Note = [Line] | |
-- types can’t appear under the where clause, so stick them here | |
type Index = [Line] | |
type Reference = Line | |
index :: (Functor f, Foldable f) => f (Entity Note) -> f Note | |
index notes = do | |
n <- notes | |
pure (backlinks n ++ body n ++ references n) | |
where | |
backlinks :: Entity Note -> [Reference] | |
backlinks n = [ refNote m | m <- toList notes, bracketed (name n) `inAny` body m ] | |
references :: Entity Note -> [Reference] | |
references n = [] -- TODO | |
ref :: String -> Reference | |
ref s = "%ref: " ++ escape s | |
refNote :: Entity Note -> Reference | |
refNote n = ref (name n) | |
body :: Entity Note -> [Line] | |
body n = [ line | line <- value n, not (isReference line) ] -- or: not `in` (references n) | |
where isReference l = "%ref:" `isPrefixOf` l | |
bracketed :: String -> String | |
bracketed s = "[" ++ s ++ "]" | |
inAny :: String -> [String] -> Bool | |
x `inAny` y = any (x `isInfixOf`) y | |
escape :: String -> String | |
escape x = x -- TODO | |
data Date = Date -- TODO | |
{- Scaffolding to make it actually Do Stuff -} | |
-- how to update some particular entity | |
type Updater t = forall f. (Foldable f, Functor f) => f (Entity t) -> f t | |
class EntityContent c where -- is this good design? who knows! | |
fromFile :: String -> c | |
toFile :: c -> String | |
instance EntityContent [String] where | |
fromFile = lines | |
toFile = unlines | |
-- general refresh function: reads all files, updates, then writes all files | |
refresh :: forall t. EntityContent t => FilePath -> Updater t -> IO () | |
refresh dir process = do | |
files <- listDirectory dir | |
entities <- sequence (toEntity <$> files) | |
forM_ (zip entities (process entities)) \(old, newContent) -> | |
writeFile (fileName (name old)) (toFile newContent) | |
where | |
toEntity :: String -> IO (Entity t) | |
toEntity file = do | |
content <- readFile' (fileName file) | |
pure (Entity file (Date) (fromFile content)) | |
fileName x = dir ++ "/" ++ x | |
main :: IO () | |
main = do | |
refresh "notes" index | |
-- helpers from `strict` package | |
hGetContents :: IO.Handle -> IO.IO String | |
hGetContents h = IO.hGetContents h >>= \s -> length s `seq` return s | |
readFile' :: FilePath -> IO String | |
readFile' name = IO.openFile name IO.ReadMode >>= hGetContents |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment