{-# LANGUAGE QuasiQuotes #-}

module Hledger.Flow.Import.ImportHelpers (findInputFiles, findJournalFiles, groupIncludesUpTo, includeFileName) where

import Path
import Data.Char (isDigit)
import Data.Maybe (fromMaybe)
import System.FilePath (dropTrailingPathSeparator)

import Hledger.Flow.Common (groupValuesBy)
import Hledger.Flow.PathHelpers (AbsDir, AbsFile, RelDir, RelFile, findFilesIn, pathSize)
import Hledger.Flow.Import.Types (InputFileBundle)

import qualified Data.Map.Strict as Map

findInputFiles :: Integer -> AbsDir -> IO [AbsFile]
findInputFiles :: Integer -> AbsDir -> IO [AbsFile]
findInputFiles Integer
startYear = do
  let excludeDirs :: [Path Rel Dir]
excludeDirs = [[reldir|2-preprocessed|], [reldir|3-journal|]] [Path Rel Dir] -> [Path Rel Dir] -> [Path Rel Dir]
forall a. [a] -> [a] -> [a]
++ [Path Rel Dir]
commonExcludeDirs
  (AbsDir -> Bool) -> [Path Rel Dir] -> AbsDir -> IO [AbsFile]
forall (m :: * -> *).
MonadIO m =>
(AbsDir -> Bool) -> [Path Rel Dir] -> AbsDir -> m [AbsFile]
findFilesIn (Path Rel Dir -> Integer -> AbsDir -> Bool
includeYearFilesForParent [reldir|1-in|] Integer
startYear) [Path Rel Dir]
excludeDirs

findJournalFiles :: AbsDir -> IO [AbsFile]
findJournalFiles :: AbsDir -> IO [AbsFile]
findJournalFiles = do
  let excludeDirs :: [Path Rel Dir]
excludeDirs = [[reldir|1-in|], [reldir|2-preprocessed|]] [Path Rel Dir] -> [Path Rel Dir] -> [Path Rel Dir]
forall a. [a] -> [a] -> [a]
++ [Path Rel Dir]
commonExcludeDirs
  (AbsDir -> Bool) -> [Path Rel Dir] -> AbsDir -> IO [AbsFile]
forall (m :: * -> *).
MonadIO m =>
(AbsDir -> Bool) -> [Path Rel Dir] -> AbsDir -> m [AbsFile]
findFilesIn (Path Rel Dir -> Integer -> AbsDir -> Bool
includeYearFilesForParent [reldir|3-journal|] Integer
0) [Path Rel Dir]
excludeDirs

-- | Include only files directly underneath parentDir/yearDir, e.g. 1-in/2020/* or 3-journal/2020/*
includeYearFilesForParent :: RelDir -> Integer -> AbsDir -> Bool
includeYearFilesForParent :: Path Rel Dir -> Integer -> AbsDir -> Bool
includeYearFilesForParent Path Rel Dir
parentDir Integer
startYear AbsDir
d = (AbsDir -> Path Rel Dir
forall b. Path b Dir -> Path Rel Dir
dirname (AbsDir -> Path Rel Dir)
-> (AbsDir -> AbsDir) -> AbsDir -> Path Rel Dir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbsDir -> AbsDir
forall b t. Path b t -> Path b Dir
parent) AbsDir
d Path Rel Dir -> Path Rel Dir -> Bool
forall a. Eq a => a -> a -> Bool
== Path Rel Dir
parentDir
  Bool -> Bool -> Bool
&& [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
shortDirName Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4
  Bool -> Bool -> Bool
&& (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit [Char]
shortDirName
  Bool -> Bool -> Bool
&& [Char] -> Integer
forall a. Read a => [Char] -> a
read [Char]
shortDirName Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
startYear
    where shortDirName :: [Char]
shortDirName = AbsDir -> [Char]
dirToStringNoSlash AbsDir
d

dirToStringNoSlash :: AbsDir -> String
dirToStringNoSlash :: AbsDir -> [Char]
dirToStringNoSlash = [Char] -> [Char]
forall a. [a] -> [a]
init ([Char] -> [Char]) -> (AbsDir -> [Char]) -> AbsDir -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel Dir -> [Char]
forall b t. Path b t -> [Char]
Path.toFilePath (Path Rel Dir -> [Char])
-> (AbsDir -> Path Rel Dir) -> AbsDir -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbsDir -> Path Rel Dir
forall b. Path b Dir -> Path Rel Dir
Path.dirname

commonExcludeDirs :: [RelDir]
commonExcludeDirs :: [Path Rel Dir]
commonExcludeDirs = [[reldir|_manual_|], [reldir|__pycache__|]]

groupIncludesUpTo :: RelDir -> [RelFile] -> InputFileBundle
groupIncludesUpTo :: Path Rel Dir -> [RelFile] -> InputFileBundle
groupIncludesUpTo = InputFileBundle -> Path Rel Dir -> [RelFile] -> InputFileBundle
groupIncludesUpTo' InputFileBundle
forall k a. Map k a
Map.empty

groupIncludesUpTo' :: InputFileBundle -> RelDir -> [RelFile] -> InputFileBundle
groupIncludesUpTo' :: InputFileBundle -> Path Rel Dir -> [RelFile] -> InputFileBundle
groupIncludesUpTo' InputFileBundle
acc Path Rel Dir
_ [] = InputFileBundle
acc
groupIncludesUpTo' InputFileBundle
acc Path Rel Dir
stopAt [RelFile]
journals = do
  let dirs :: [Path Rel Dir]
dirs = (RelFile -> Path Rel Dir) -> [RelFile] -> [Path Rel Dir]
forall a b. (a -> b) -> [a] -> [b]
map RelFile -> Path Rel Dir
forall b t. Path b t -> Path b Dir
parent [RelFile]
journals :: [RelDir]
  let shouldStop :: Bool
shouldStop = Path Rel Dir
stopAt Path Rel Dir -> [Path Rel Dir] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Path Rel Dir]
dirs
  if Bool
shouldStop then InputFileBundle
acc else do
    let grouped :: InputFileBundle
grouped = [RelFile] -> InputFileBundle
groupIncludeFilesPerYear [RelFile]
journals
    InputFileBundle -> Path Rel Dir -> [RelFile] -> InputFileBundle
groupIncludesUpTo' (InputFileBundle
acc InputFileBundle -> InputFileBundle -> InputFileBundle
forall a. Semigroup a => a -> a -> a
<> InputFileBundle
grouped) Path Rel Dir
stopAt (InputFileBundle -> [RelFile]
forall k a. Map k a -> [k]
Map.keys InputFileBundle
grouped)

groupIncludeFilesPerYear :: [RelFile] -> InputFileBundle
groupIncludeFilesPerYear :: [RelFile] -> InputFileBundle
groupIncludeFilesPerYear [] = InputFileBundle
forall k a. Map k a
Map.empty
groupIncludeFilesPerYear ps :: [RelFile]
ps@(RelFile
p:[RelFile]
_) = if Path Rel Dir -> Int
forall b. Path b Dir -> Int
pathSize (RelFile -> Path Rel Dir
forall b t. Path b t -> Path b Dir
parent RelFile
p) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6
  then (RelFile -> RelFile) -> [RelFile] -> InputFileBundle
forall k v. (Ord k, Ord v) => (v -> k) -> [v] -> Map k [v]
groupValuesBy RelFile -> RelFile
initialIncludeFilePath [RelFile]
ps
  else (RelFile -> RelFile) -> [RelFile] -> InputFileBundle
forall k v. (Ord k, Ord v) => (v -> k) -> [v] -> Map k [v]
groupValuesBy RelFile -> RelFile
parentIncludeFilePath [RelFile]
ps

initialIncludeFilePath :: RelFile -> RelFile
initialIncludeFilePath :: RelFile -> RelFile
initialIncludeFilePath RelFile
p = (Path Rel Dir -> Path Rel Dir
forall b t. Path b t -> Path b Dir
parent (Path Rel Dir -> Path Rel Dir)
-> (RelFile -> Path Rel Dir) -> RelFile -> Path Rel Dir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel Dir -> Path Rel Dir
forall b t. Path b t -> Path b Dir
parent (Path Rel Dir -> Path Rel Dir)
-> (RelFile -> Path Rel Dir) -> RelFile -> Path Rel Dir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelFile -> Path Rel Dir
forall b t. Path b t -> Path b Dir
parent) RelFile
p Path Rel Dir -> RelFile -> RelFile
forall b t. Path b Dir -> Path Rel t -> Path b t
</> RelFile -> RelFile
includeFileName RelFile
p

parentIncludeFilePath :: RelFile -> RelFile
parentIncludeFilePath :: RelFile -> RelFile
parentIncludeFilePath RelFile
p = (Path Rel Dir -> Path Rel Dir
forall b t. Path b t -> Path b Dir
parent (Path Rel Dir -> Path Rel Dir)
-> (RelFile -> Path Rel Dir) -> RelFile -> Path Rel Dir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelFile -> Path Rel Dir
forall b t. Path b t -> Path b Dir
parent) RelFile
p Path Rel Dir -> RelFile -> RelFile
forall b t. Path b Dir -> Path Rel t -> Path b t
</> RelFile -> RelFile
forall b. Path b File -> RelFile
filename RelFile
p

includeFileName :: RelFile -> RelFile
includeFileName :: RelFile -> RelFile
includeFileName RelFile
f = do
  let includeFile :: [Char]
includeFile = ([Char] -> [Char]
dropTrailingPathSeparator ([Char] -> [Char]) -> (RelFile -> [Char]) -> RelFile -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel Dir -> [Char]
forall b t. Path b t -> [Char]
toFilePath (Path Rel Dir -> [Char])
-> (RelFile -> Path Rel Dir) -> RelFile -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel Dir -> Path Rel Dir
forall b. Path b Dir -> Path Rel Dir
dirname (Path Rel Dir -> Path Rel Dir)
-> (RelFile -> Path Rel Dir) -> RelFile -> Path Rel Dir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelFile -> Path Rel Dir
forall b t. Path b t -> Path b Dir
parent) RelFile
f [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"-include.journal"
  RelFile -> Maybe RelFile -> RelFile
forall a. a -> Maybe a -> a
fromMaybe [relfile|unknown-include.journal|] (Maybe RelFile -> RelFile) -> Maybe RelFile -> RelFile
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe RelFile
forall (m :: * -> *). MonadThrow m => [Char] -> m RelFile
parseRelFile [Char]
includeFile