Journal Mode Organizer

organize.hs

import System.Directory as D
import Data.List (sort, cycle)
import Data.Set (fromList, member, Set)
import Data.List.Split (chunksOf)
import Data.Time.Calendar as C
import Control.Monad (sequence_)

-- Date parsing related functions

slice :: Int -> Int -> [a] -> [a]
slice from to = (take (to - from)) . (drop from)

-- UNSAFE
parseDate :: Int -> Int -> FilePath -> Int
parseDate from to = read . (slice from to)

parseYear = parseDate 0 4
parseMonth = parseDate 4 6
parseDay = parseDate 6 8

date :: FilePath -> C.Day
date entryTitle = 
     let year = (toInteger . parseYear) entryTitle
         month = parseMonth entryTitle
         day = parseDay entryTitle
     in C.fromGregorian year month day
                        
padDigit digit = 
         if (length digit) == 1 
         then "0" ++ digit else digit

entry :: C.Day -> FilePath
entry date = 
      let (year, month, day) = C.toGregorian date
          monthStr = show month
          dayStr = show day
      in (show year) ++ (padDigit monthStr) ++ (padDigit dayStr)

firstSunday = C.fromGregorian 2014 7 6

-- File system reading

entryNames = filter ((8 ==) . length)

listEntries :: FilePath -> IO ([FilePath])
listEntries dir = fmap (sort . entryNames) (D.getDirectoryContents dir)

-- Moving stuff

moveWeek :: Set C.Day -> FilePath -> [C.Day] -> [IO ()]
moveWeek set dir week = do
         let folder = (show . head) week 
         let path = (dir ++ folder)

         let create = D.createDirectoryIfMissing True path 
         let populate =  fmap (moveDay set dir path) week

         (create : populate)

moveDay :: Set C.Day -> FilePath -> FilePath -> Day -> IO ()
moveDay set directory folderPath day = 
        if member day set then
           D.renameFile (directory ++ (entry day))
           (concat [folderPath, "/", (entry day)])
        else return ()

main = do
     home <- D.getHomeDirectory
     let dir = home ++ "/journal/"
     entryNames <- listEntries dir

     let dates = fmap date entryNames
     let fullRange = [firstSunday..(last dates)]
     let weeks = chunksOf 7 fullRange
     
     let organize = fmap (moveWeek (fromList dates) dir) weeks
     
     (sequence_ . concat) organize