zk.hs

{-# 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