{-# LANGUAGE OverloadedStrings #-}

-- | Functions which currently uses TurtlePath and will be replaced with Path eventually
module Hledger.Flow.Import.ImportHelpersTurtle (
    allYearIncludeFiles
  , extractImportDirs
  , extraIncludesForFile
  , groupIncludeFiles
  , groupAndWriteIncludeFiles
  , includePreamble
  , toIncludeFiles
  , toIncludeLine
  , writeIncludesUpTo
  , writeToplevelAllYearsInclude
  , yearsIncludeMap
  )
 where

import Hledger.Flow.PathHelpers (TurtlePath)
import Hledger.Flow.DocHelpers (docURL)
import Hledger.Flow.Common (allYearsFileName, filterPaths, groupValuesBy, writeFiles, writeFiles')
import Hledger.Flow.BaseDir (relativeToBase, relativeToBase', turtleBaseDir)
import Hledger.Flow.Logging (logVerbose)

import Hledger.Flow.Types
import Hledger.Flow.Import.Types

import qualified Data.List as List (nub, sort)
import qualified Data.Text as T
import qualified Data.Map.Strict as Map

import qualified Turtle
import Turtle ((%), (</>), (<.>))

import Control.Concurrent.STM (TChan)
import Data.Maybe (fromMaybe)

extractImportDirs :: TurtlePath -> Either T.Text ImportDirs
extractImportDirs :: TurtlePath -> Either Text ImportDirs
extractImportDirs TurtlePath
inputFile = do
  case TurtlePath -> [TurtlePath]
importDirBreakdown TurtlePath
inputFile of
    [TurtlePath
bd,TurtlePath
owner,TurtlePath
bank,TurtlePath
account,TurtlePath
filestate,TurtlePath
year] -> ImportDirs -> Either Text ImportDirs
forall a b. b -> Either a b
Right (ImportDirs -> Either Text ImportDirs)
-> ImportDirs -> Either Text ImportDirs
forall a b. (a -> b) -> a -> b
$ TurtlePath
-> TurtlePath
-> TurtlePath
-> TurtlePath
-> TurtlePath
-> TurtlePath
-> ImportDirs
ImportDirs TurtlePath
bd TurtlePath
owner TurtlePath
bank TurtlePath
account TurtlePath
filestate TurtlePath
year
    [TurtlePath]
_ -> do
      Text -> Either Text ImportDirs
forall a b. a -> Either a b
Left (Text -> Either Text ImportDirs) -> Text -> Either Text ImportDirs
forall a b. (a -> b) -> a -> b
$ Format Text (TurtlePath -> Text -> Text)
-> TurtlePath -> Text -> Text
forall r. Format Text r -> r
Turtle.format (Format (TurtlePath -> Text -> Text) (TurtlePath -> Text -> Text)
"I couldn't find the right number of directories between \"import\" and the input file:\n"Format (TurtlePath -> Text -> Text) (TurtlePath -> Text -> Text)
-> Format (Text -> Text) (TurtlePath -> Text -> Text)
-> Format (Text -> Text) (TurtlePath -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Text -> Text) (TurtlePath -> Text -> Text)
forall r. Format r (TurtlePath -> r)
Turtle.fp
                      Format (Text -> Text) (TurtlePath -> Text -> Text)
-> Format (Text -> Text) (Text -> Text)
-> Format (Text -> Text) (TurtlePath -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Text -> Text) (Text -> Text)
"\n\nhledger-flow expects to find input files in this structure:\n"Format (Text -> Text) (TurtlePath -> Text -> Text)
-> Format (Text -> Text) (Text -> Text)
-> Format (Text -> Text) (TurtlePath -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%
                      Format (Text -> Text) (Text -> Text)
"import/owner/bank/account/filestate/year/trxfile\n\n"Format (Text -> Text) (TurtlePath -> Text -> Text)
-> Format (Text -> Text) (Text -> Text)
-> Format (Text -> Text) (TurtlePath -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%
                      Format (Text -> Text) (Text -> Text)
"Have a look at the documentation for a detailed explanation:\n"Format (Text -> Text) (TurtlePath -> Text -> Text)
-> Format Text (Text -> Text)
-> Format Text (TurtlePath -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text (Text -> Text)
forall r. Format r (Text -> r)
Turtle.s) TurtlePath
inputFile (Line -> Text
docURL Line
"input-files")

importDirBreakdown ::  TurtlePath -> [TurtlePath]
importDirBreakdown :: TurtlePath -> [TurtlePath]
importDirBreakdown = [TurtlePath] -> TurtlePath -> [TurtlePath]
importDirBreakdown' []

importDirBreakdown' :: [TurtlePath] -> TurtlePath -> [TurtlePath]
importDirBreakdown' :: [TurtlePath] -> TurtlePath -> [TurtlePath]
importDirBreakdown' [TurtlePath]
acc TurtlePath
path = do
  let dir :: TurtlePath
dir = TurtlePath -> TurtlePath
Turtle.directory TurtlePath
path
  if TurtlePath -> TurtlePath
Turtle.dirname TurtlePath
dir TurtlePath -> TurtlePath -> Bool
forall a. Eq a => a -> a -> Bool
== TurtlePath
"import" Bool -> Bool -> Bool
|| (TurtlePath -> TurtlePath
Turtle.dirname TurtlePath
dir TurtlePath -> TurtlePath -> Bool
forall a. Eq a => a -> a -> Bool
== TurtlePath
"")
    then TurtlePath
dirTurtlePath -> [TurtlePath] -> [TurtlePath]
forall a. a -> [a] -> [a]
:[TurtlePath]
acc
    else [TurtlePath] -> TurtlePath -> [TurtlePath]
importDirBreakdown' (TurtlePath
dirTurtlePath -> [TurtlePath] -> [TurtlePath]
forall a. a -> [a] -> [a]
:[TurtlePath]
acc) (TurtlePath -> [TurtlePath]) -> TurtlePath -> [TurtlePath]
forall a b. (a -> b) -> a -> b
$ TurtlePath -> TurtlePath
Turtle.parent TurtlePath
dir

groupIncludeFiles :: [TurtlePath] -> (TurtleFileBundle, TurtleFileBundle)
groupIncludeFiles :: [TurtlePath] -> (TurtleFileBundle, TurtleFileBundle)
groupIncludeFiles = TurtleFileBundle -> (TurtleFileBundle, TurtleFileBundle)
allYearIncludeFiles (TurtleFileBundle -> (TurtleFileBundle, TurtleFileBundle))
-> ([TurtlePath] -> TurtleFileBundle)
-> [TurtlePath]
-> (TurtleFileBundle, TurtleFileBundle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TurtlePath] -> TurtleFileBundle
groupIncludeFilesPerYear ([TurtlePath] -> TurtleFileBundle)
-> ([TurtlePath] -> [TurtlePath])
-> [TurtlePath]
-> TurtleFileBundle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TurtlePath -> Bool) -> [TurtlePath] -> [TurtlePath]
forall a. (a -> Bool) -> [a] -> [a]
filter TurtlePath -> Bool
isJournalFile

isJournalFile :: TurtlePath -> Bool
isJournalFile :: TurtlePath -> Bool
isJournalFile TurtlePath
f = TurtlePath -> Maybe Text
Turtle.extension TurtlePath
f Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"journal"

allYearIncludeFiles :: TurtleFileBundle -> (TurtleFileBundle, TurtleFileBundle)
allYearIncludeFiles :: TurtleFileBundle -> (TurtleFileBundle, TurtleFileBundle)
allYearIncludeFiles TurtleFileBundle
m = (TurtleFileBundle
m, [TurtlePath] -> TurtleFileBundle
yearsIncludeMap ([TurtlePath] -> TurtleFileBundle)
-> [TurtlePath] -> TurtleFileBundle
forall a b. (a -> b) -> a -> b
$ TurtleFileBundle -> [TurtlePath]
forall k a. Map k a -> [k]
Map.keys TurtleFileBundle
m)

yearsIncludeMap :: [TurtlePath] -> TurtleFileBundle
yearsIncludeMap :: [TurtlePath] -> TurtleFileBundle
yearsIncludeMap = (TurtlePath -> TurtlePath) -> [TurtlePath] -> TurtleFileBundle
forall k v. (Ord k, Ord v) => (v -> k) -> [v] -> Map k [v]
groupValuesBy TurtlePath -> TurtlePath
allYearsPath

allYearsPath :: TurtlePath -> TurtlePath
allYearsPath :: TurtlePath -> TurtlePath
allYearsPath = (TurtlePath -> TurtlePath) -> TurtlePath -> TurtlePath
allYearsPath' TurtlePath -> TurtlePath
Turtle.directory

allYearsPath' :: (TurtlePath -> TurtlePath) -> TurtlePath -> TurtlePath
allYearsPath' :: (TurtlePath -> TurtlePath) -> TurtlePath -> TurtlePath
allYearsPath' TurtlePath -> TurtlePath
dir TurtlePath
p = TurtlePath -> TurtlePath
dir TurtlePath
p TurtlePath -> TurtlePath -> TurtlePath
</> TurtlePath
allYearsFileName

includeFileName :: TurtlePath -> TurtlePath
includeFileName :: TurtlePath -> TurtlePath
includeFileName = (TurtlePath -> Text -> TurtlePath
<.> Text
"journal") (TurtlePath -> TurtlePath)
-> (TurtlePath -> TurtlePath) -> TurtlePath -> TurtlePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TurtlePath
Turtle.fromText (Text -> TurtlePath)
-> (TurtlePath -> Text) -> TurtlePath -> TurtlePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Format Text (TurtlePath -> Text) -> TurtlePath -> Text
forall r. Format Text r -> r
Turtle.format (Format Text (TurtlePath -> Text)
forall r. Format r (TurtlePath -> r)
Turtle.fpFormat Text (TurtlePath -> Text)
-> Format Text Text -> Format Text (TurtlePath -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text Text
"-include")) (TurtlePath -> Text)
-> (TurtlePath -> TurtlePath) -> TurtlePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TurtlePath -> TurtlePath
Turtle.dirname

groupIncludeFilesPerYear :: [TurtlePath] -> TurtleFileBundle
groupIncludeFilesPerYear :: [TurtlePath] -> TurtleFileBundle
groupIncludeFilesPerYear [] = TurtleFileBundle
forall k a. Map k a
Map.empty
groupIncludeFilesPerYear ps :: [TurtlePath]
ps@(TurtlePath
p:[TurtlePath]
_) = case TurtlePath -> Either Text ImportDirs
extractImportDirs TurtlePath
p of
    Right ImportDirs
_ -> (TurtlePath -> TurtlePath) -> [TurtlePath] -> TurtleFileBundle
forall k v. (Ord k, Ord v) => (v -> k) -> [v] -> Map k [v]
groupValuesBy TurtlePath -> TurtlePath
initialIncludeFilePath [TurtlePath]
ps
    Left  Text
_ -> (TurtlePath -> TurtlePath) -> [TurtlePath] -> TurtleFileBundle
forall k v. (Ord k, Ord v) => (v -> k) -> [v] -> Map k [v]
groupValuesBy TurtlePath -> TurtlePath
parentIncludeFilePath [TurtlePath]
ps

initialIncludeFilePath :: TurtlePath -> TurtlePath
initialIncludeFilePath :: TurtlePath -> TurtlePath
initialIncludeFilePath TurtlePath
p = (TurtlePath -> TurtlePath
Turtle.parent (TurtlePath -> TurtlePath)
-> (TurtlePath -> TurtlePath) -> TurtlePath -> TurtlePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TurtlePath -> TurtlePath
Turtle.parent (TurtlePath -> TurtlePath)
-> (TurtlePath -> TurtlePath) -> TurtlePath -> TurtlePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TurtlePath -> TurtlePath
Turtle.parent) TurtlePath
p TurtlePath -> TurtlePath -> TurtlePath
</> TurtlePath -> TurtlePath
includeFileName TurtlePath
p

parentIncludeFilePath :: TurtlePath -> TurtlePath
parentIncludeFilePath :: TurtlePath -> TurtlePath
parentIncludeFilePath TurtlePath
p = (TurtlePath -> TurtlePath
Turtle.parent (TurtlePath -> TurtlePath)
-> (TurtlePath -> TurtlePath) -> TurtlePath -> TurtlePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TurtlePath -> TurtlePath
Turtle.parent) TurtlePath
p TurtlePath -> TurtlePath -> TurtlePath
</> TurtlePath -> TurtlePath
Turtle.filename TurtlePath
p

toIncludeFiles :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> TurtleFileBundle -> IO (Map.Map TurtlePath T.Text)
toIncludeFiles :: o
-> TChan LogMessage -> TurtleFileBundle -> IO (Map TurtlePath Text)
toIncludeFiles o
opts TChan LogMessage
ch TurtleFileBundle
m = do
  TurtleFileBundle
preMap  <- o
-> TChan LogMessage
-> [TurtlePath]
-> [Text]
-> [TurtlePath]
-> [TurtlePath]
-> IO TurtleFileBundle
forall o.
(HasBaseDir o, HasVerbosity o) =>
o
-> TChan LogMessage
-> [TurtlePath]
-> [Text]
-> [TurtlePath]
-> [TurtlePath]
-> IO TurtleFileBundle
extraIncludes o
opts TChan LogMessage
ch (TurtleFileBundle -> [TurtlePath]
forall k a. Map k a -> [k]
Map.keys TurtleFileBundle
m) [Text
"opening.journal"] [TurtlePath
"pre-import.journal"] []
  TurtleFileBundle
postMap <- o
-> TChan LogMessage
-> [TurtlePath]
-> [Text]
-> [TurtlePath]
-> [TurtlePath]
-> IO TurtleFileBundle
forall o.
(HasBaseDir o, HasVerbosity o) =>
o
-> TChan LogMessage
-> [TurtlePath]
-> [Text]
-> [TurtlePath]
-> [TurtlePath]
-> IO TurtleFileBundle
extraIncludes o
opts TChan LogMessage
ch (TurtleFileBundle -> [TurtlePath]
forall k a. Map k a -> [k]
Map.keys TurtleFileBundle
m) [Text
"closing.journal"] [TurtlePath
"post-import.journal"] [TurtlePath
"prices.journal"]
  Map TurtlePath Text -> IO (Map TurtlePath Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map TurtlePath Text -> IO (Map TurtlePath Text))
-> Map TurtlePath Text -> IO (Map TurtlePath Text)
forall a b. (a -> b) -> a -> b
$ (Map TurtlePath Text -> Map TurtlePath Text
addPreamble (Map TurtlePath Text -> Map TurtlePath Text)
-> (TurtleFileBundle -> Map TurtlePath Text)
-> TurtleFileBundle
-> Map TurtlePath Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TurtleFileBundle
-> TurtleFileBundle -> TurtleFileBundle -> Map TurtlePath Text
toIncludeFiles' TurtleFileBundle
preMap TurtleFileBundle
postMap) TurtleFileBundle
m

toIncludeFiles' :: TurtleFileBundle -> TurtleFileBundle -> TurtleFileBundle -> Map.Map TurtlePath T.Text
toIncludeFiles' :: TurtleFileBundle
-> TurtleFileBundle -> TurtleFileBundle -> Map TurtlePath Text
toIncludeFiles' TurtleFileBundle
preMap TurtleFileBundle
postMap = (TurtlePath -> [TurtlePath] -> Text)
-> TurtleFileBundle -> Map TurtlePath Text
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey ((TurtlePath -> [TurtlePath] -> Text)
 -> TurtleFileBundle -> Map TurtlePath Text)
-> (TurtlePath -> [TurtlePath] -> Text)
-> TurtleFileBundle
-> Map TurtlePath Text
forall a b. (a -> b) -> a -> b
$ TurtleFileBundle
-> TurtleFileBundle -> TurtlePath -> [TurtlePath] -> Text
generatedIncludeText TurtleFileBundle
preMap TurtleFileBundle
postMap

addPreamble :: Map.Map TurtlePath T.Text -> Map.Map TurtlePath T.Text
addPreamble :: Map TurtlePath Text -> Map TurtlePath Text
addPreamble = (Text -> Text) -> Map TurtlePath Text -> Map TurtlePath Text
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\Text
txt -> Text
includePreamble Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt)

toIncludeLine :: TurtlePath -> TurtlePath -> T.Text
toIncludeLine :: TurtlePath -> TurtlePath -> Text
toIncludeLine TurtlePath
base TurtlePath
file = Format Text (TurtlePath -> Text) -> TurtlePath -> Text
forall r. Format Text r -> r
Turtle.format (Format (TurtlePath -> Text) (TurtlePath -> Text)
"!include "Format (TurtlePath -> Text) (TurtlePath -> Text)
-> Format Text (TurtlePath -> Text)
-> Format Text (TurtlePath -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text (TurtlePath -> Text)
forall r. Format r (TurtlePath -> r)
Turtle.fp) (TurtlePath -> Text) -> TurtlePath -> Text
forall a b. (a -> b) -> a -> b
$ TurtlePath -> TurtlePath -> TurtlePath
relativeToBase' TurtlePath
base TurtlePath
file

generatedIncludeText :: TurtleFileBundle -> TurtleFileBundle -> TurtlePath -> [TurtlePath] -> T.Text
generatedIncludeText :: TurtleFileBundle
-> TurtleFileBundle -> TurtlePath -> [TurtlePath] -> Text
generatedIncludeText TurtleFileBundle
preMap TurtleFileBundle
postMap TurtlePath
outputFile [TurtlePath]
fs = do
  let preFiles :: [TurtlePath]
preFiles = [TurtlePath] -> Maybe [TurtlePath] -> [TurtlePath]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [TurtlePath] -> [TurtlePath])
-> Maybe [TurtlePath] -> [TurtlePath]
forall a b. (a -> b) -> a -> b
$ TurtlePath -> TurtleFileBundle -> Maybe [TurtlePath]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TurtlePath
outputFile TurtleFileBundle
preMap
  let files :: [TurtlePath]
files = [TurtlePath] -> [TurtlePath]
forall a. Eq a => [a] -> [a]
List.nub ([TurtlePath] -> [TurtlePath])
-> ([TurtlePath] -> [TurtlePath]) -> [TurtlePath] -> [TurtlePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TurtlePath] -> [TurtlePath]
forall a. Ord a => [a] -> [a]
List.sort ([TurtlePath] -> [TurtlePath]) -> [TurtlePath] -> [TurtlePath]
forall a b. (a -> b) -> a -> b
$ [TurtlePath]
fs
  let postFiles :: [TurtlePath]
postFiles = [TurtlePath] -> Maybe [TurtlePath] -> [TurtlePath]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [TurtlePath] -> [TurtlePath])
-> Maybe [TurtlePath] -> [TurtlePath]
forall a b. (a -> b) -> a -> b
$ TurtlePath -> TurtleFileBundle -> Maybe [TurtlePath]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TurtlePath
outputFile TurtleFileBundle
postMap
  let lns :: [Text]
lns = (TurtlePath -> Text) -> [TurtlePath] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (TurtlePath -> TurtlePath -> Text
toIncludeLine (TurtlePath -> TurtlePath -> Text)
-> TurtlePath -> TurtlePath -> Text
forall a b. (a -> b) -> a -> b
$ TurtlePath -> TurtlePath
Turtle.directory TurtlePath
outputFile) ([TurtlePath] -> [Text]) -> [TurtlePath] -> [Text]
forall a b. (a -> b) -> a -> b
$ [TurtlePath]
preFiles [TurtlePath] -> [TurtlePath] -> [TurtlePath]
forall a. [a] -> [a] -> [a]
++ [TurtlePath]
files [TurtlePath] -> [TurtlePath] -> [TurtlePath]
forall a. [a] -> [a] -> [a]
++ [TurtlePath]
postFiles
  Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text]
lns [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
""]

includePreamble :: T.Text
includePreamble :: Text
includePreamble = Text
"### Generated by hledger-flow - DO NOT EDIT ###\n"

groupAndWriteIncludeFiles :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> [TurtlePath] -> IO [TurtlePath]
groupAndWriteIncludeFiles :: o -> TChan LogMessage -> [TurtlePath] -> IO [TurtlePath]
groupAndWriteIncludeFiles o
opts TChan LogMessage
ch = o
-> TChan LogMessage
-> (TurtleFileBundle, TurtleFileBundle)
-> IO [TurtlePath]
forall o.
(HasBaseDir o, HasVerbosity o) =>
o
-> TChan LogMessage
-> (TurtleFileBundle, TurtleFileBundle)
-> IO [TurtlePath]
writeFileMap o
opts TChan LogMessage
ch ((TurtleFileBundle, TurtleFileBundle) -> IO [TurtlePath])
-> ([TurtlePath] -> (TurtleFileBundle, TurtleFileBundle))
-> [TurtlePath]
-> IO [TurtlePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TurtlePath] -> (TurtleFileBundle, TurtleFileBundle)
groupIncludeFiles

writeFileMap :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> (TurtleFileBundle, TurtleFileBundle) -> IO [TurtlePath]
writeFileMap :: o
-> TChan LogMessage
-> (TurtleFileBundle, TurtleFileBundle)
-> IO [TurtlePath]
writeFileMap o
opts TChan LogMessage
ch (TurtleFileBundle
m, TurtleFileBundle
allYears) = do
  [TurtlePath]
_ <- Map TurtlePath Text -> IO [TurtlePath]
writeFiles' (Map TurtlePath Text -> IO [TurtlePath])
-> Map TurtlePath Text -> IO [TurtlePath]
forall a b. (a -> b) -> a -> b
$ (Map TurtlePath Text -> Map TurtlePath Text
addPreamble (Map TurtlePath Text -> Map TurtlePath Text)
-> (TurtleFileBundle -> Map TurtlePath Text)
-> TurtleFileBundle
-> Map TurtlePath Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TurtleFileBundle
-> TurtleFileBundle -> TurtleFileBundle -> Map TurtlePath Text
toIncludeFiles' TurtleFileBundle
forall k a. Map k a
Map.empty TurtleFileBundle
forall k a. Map k a
Map.empty) TurtleFileBundle
allYears
  IO (Map TurtlePath Text) -> IO [TurtlePath]
writeFiles (IO (Map TurtlePath Text) -> IO [TurtlePath])
-> (TurtleFileBundle -> IO (Map TurtlePath Text))
-> TurtleFileBundle
-> IO [TurtlePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (o
-> TChan LogMessage -> TurtleFileBundle -> IO (Map TurtlePath Text)
forall o.
(HasBaseDir o, HasVerbosity o) =>
o
-> TChan LogMessage -> TurtleFileBundle -> IO (Map TurtlePath Text)
toIncludeFiles o
opts TChan LogMessage
ch) (TurtleFileBundle -> IO [TurtlePath])
-> TurtleFileBundle -> IO [TurtlePath]
forall a b. (a -> b) -> a -> b
$ TurtleFileBundle
m

writeIncludesUpTo :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> TurtlePath -> [TurtlePath] -> IO [TurtlePath]
writeIncludesUpTo :: o
-> TChan LogMessage
-> TurtlePath
-> [TurtlePath]
-> IO [TurtlePath]
writeIncludesUpTo o
_ TChan LogMessage
_ TurtlePath
_ [] = [TurtlePath] -> IO [TurtlePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
writeIncludesUpTo o
opts TChan LogMessage
ch TurtlePath
stopAt [TurtlePath]
journalFiles = do
  let shouldStop :: Bool
shouldStop = (TurtlePath -> Bool) -> [TurtlePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\TurtlePath
dir -> TurtlePath
dir TurtlePath -> TurtlePath -> Bool
forall a. Eq a => a -> a -> Bool
== TurtlePath
stopAt) ([TurtlePath] -> Bool) -> [TurtlePath] -> Bool
forall a b. (a -> b) -> a -> b
$ (TurtlePath -> TurtlePath) -> [TurtlePath] -> [TurtlePath]
forall a b. (a -> b) -> [a] -> [b]
map TurtlePath -> TurtlePath
Turtle.parent [TurtlePath]
journalFiles
  if Bool
shouldStop
    then [TurtlePath] -> IO [TurtlePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [TurtlePath]
journalFiles
    else do
      [TurtlePath]
newJournalFiles <- o -> TChan LogMessage -> [TurtlePath] -> IO [TurtlePath]
forall o.
(HasBaseDir o, HasVerbosity o) =>
o -> TChan LogMessage -> [TurtlePath] -> IO [TurtlePath]
groupAndWriteIncludeFiles o
opts TChan LogMessage
ch [TurtlePath]
journalFiles
      o
-> TChan LogMessage
-> TurtlePath
-> [TurtlePath]
-> IO [TurtlePath]
forall o.
(HasBaseDir o, HasVerbosity o) =>
o
-> TChan LogMessage
-> TurtlePath
-> [TurtlePath]
-> IO [TurtlePath]
writeIncludesUpTo o
opts TChan LogMessage
ch TurtlePath
stopAt [TurtlePath]
newJournalFiles

writeToplevelAllYearsInclude :: (HasBaseDir o, HasVerbosity o) => o -> IO [TurtlePath]
writeToplevelAllYearsInclude :: o -> IO [TurtlePath]
writeToplevelAllYearsInclude o
opts = do
  let directivesFile :: TurtlePath
directivesFile = o -> TurtlePath
forall o. HasBaseDir o => o -> TurtlePath
turtleBaseDir o
opts TurtlePath -> TurtlePath -> TurtlePath
</> TurtlePath
"directives" TurtlePath -> Text -> TurtlePath
<.> Text
"journal"
  Bool
directivesExists <- TurtlePath -> IO Bool
forall (io :: * -> *). MonadIO io => TurtlePath -> io Bool
Turtle.testfile TurtlePath
directivesFile
  let preMap :: TurtleFileBundle
preMap = if Bool
directivesExists then TurtlePath -> [TurtlePath] -> TurtleFileBundle
forall k a. k -> a -> Map k a
Map.singleton (o -> TurtlePath
forall o. HasBaseDir o => o -> TurtlePath
turtleBaseDir o
opts TurtlePath -> TurtlePath -> TurtlePath
</> TurtlePath
allYearsFileName) [TurtlePath
directivesFile] else TurtleFileBundle
forall k a. Map k a
Map.empty
  let allTop :: TurtleFileBundle
allTop = TurtlePath -> [TurtlePath] -> TurtleFileBundle
forall k a. k -> a -> Map k a
Map.singleton (o -> TurtlePath
forall o. HasBaseDir o => o -> TurtlePath
turtleBaseDir o
opts TurtlePath -> TurtlePath -> TurtlePath
</> TurtlePath
allYearsFileName) [TurtlePath
"import" TurtlePath -> TurtlePath -> TurtlePath
</> TurtlePath
allYearsFileName]
  Map TurtlePath Text -> IO [TurtlePath]
writeFiles' (Map TurtlePath Text -> IO [TurtlePath])
-> Map TurtlePath Text -> IO [TurtlePath]
forall a b. (a -> b) -> a -> b
$ (Map TurtlePath Text -> Map TurtlePath Text
addPreamble (Map TurtlePath Text -> Map TurtlePath Text)
-> (TurtleFileBundle -> Map TurtlePath Text)
-> TurtleFileBundle
-> Map TurtlePath Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TurtleFileBundle
-> TurtleFileBundle -> TurtleFileBundle -> Map TurtlePath Text
toIncludeFiles' TurtleFileBundle
preMap TurtleFileBundle
forall k a. Map k a
Map.empty) TurtleFileBundle
allTop

extraIncludes :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> [TurtlePath] -> [T.Text] -> [TurtlePath] -> [TurtlePath] -> IO TurtleFileBundle
extraIncludes :: o
-> TChan LogMessage
-> [TurtlePath]
-> [Text]
-> [TurtlePath]
-> [TurtlePath]
-> IO TurtleFileBundle
extraIncludes o
opts TChan LogMessage
ch = o
-> TChan LogMessage
-> TurtleFileBundle
-> [TurtlePath]
-> [Text]
-> [TurtlePath]
-> [TurtlePath]
-> IO TurtleFileBundle
forall o.
(HasBaseDir o, HasVerbosity o) =>
o
-> TChan LogMessage
-> TurtleFileBundle
-> [TurtlePath]
-> [Text]
-> [TurtlePath]
-> [TurtlePath]
-> IO TurtleFileBundle
extraIncludes' o
opts TChan LogMessage
ch TurtleFileBundle
forall k a. Map k a
Map.empty

extraIncludes' :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> TurtleFileBundle -> [TurtlePath] -> [T.Text] -> [TurtlePath] -> [TurtlePath] -> IO TurtleFileBundle
extraIncludes' :: o
-> TChan LogMessage
-> TurtleFileBundle
-> [TurtlePath]
-> [Text]
-> [TurtlePath]
-> [TurtlePath]
-> IO TurtleFileBundle
extraIncludes' o
_ TChan LogMessage
_ TurtleFileBundle
acc [] [Text]
_ [TurtlePath]
_ [TurtlePath]
_ = TurtleFileBundle -> IO TurtleFileBundle
forall (m :: * -> *) a. Monad m => a -> m a
return TurtleFileBundle
acc
extraIncludes' o
opts TChan LogMessage
ch TurtleFileBundle
acc (TurtlePath
file:[TurtlePath]
files) [Text]
extraSuffixes [TurtlePath]
manualFiles [TurtlePath]
prices = do
  TurtleFileBundle
extra <- o
-> TChan LogMessage
-> TurtlePath
-> [Text]
-> [TurtlePath]
-> [TurtlePath]
-> IO TurtleFileBundle
forall o.
(HasVerbosity o, HasBaseDir o) =>
o
-> TChan LogMessage
-> TurtlePath
-> [Text]
-> [TurtlePath]
-> [TurtlePath]
-> IO TurtleFileBundle
extraIncludesForFile o
opts TChan LogMessage
ch TurtlePath
file [Text]
extraSuffixes [TurtlePath]
manualFiles [TurtlePath]
prices
  o
-> TChan LogMessage
-> TurtleFileBundle
-> [TurtlePath]
-> [Text]
-> [TurtlePath]
-> [TurtlePath]
-> IO TurtleFileBundle
forall o.
(HasBaseDir o, HasVerbosity o) =>
o
-> TChan LogMessage
-> TurtleFileBundle
-> [TurtlePath]
-> [Text]
-> [TurtlePath]
-> [TurtlePath]
-> IO TurtleFileBundle
extraIncludes' o
opts TChan LogMessage
ch (([TurtlePath] -> [TurtlePath] -> [TurtlePath])
-> TurtleFileBundle -> TurtleFileBundle -> TurtleFileBundle
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith [TurtlePath] -> [TurtlePath] -> [TurtlePath]
forall a. [a] -> [a] -> [a]
(++) TurtleFileBundle
acc TurtleFileBundle
extra) [TurtlePath]
files [Text]
extraSuffixes [TurtlePath]
manualFiles [TurtlePath]
prices

extraIncludesForFile :: (HasVerbosity o, HasBaseDir o) => o -> TChan LogMessage -> TurtlePath -> [T.Text] -> [TurtlePath] -> [TurtlePath] -> IO TurtleFileBundle
extraIncludesForFile :: o
-> TChan LogMessage
-> TurtlePath
-> [Text]
-> [TurtlePath]
-> [TurtlePath]
-> IO TurtleFileBundle
extraIncludesForFile o
opts TChan LogMessage
ch TurtlePath
file [Text]
extraSuffixes [TurtlePath]
manualFiles [TurtlePath]
prices = do
  let dirprefix :: TurtlePath
dirprefix = Text -> TurtlePath
Turtle.fromText (Text -> TurtlePath) -> Text -> TurtlePath
forall a b. (a -> b) -> a -> b
$ (Text, Text) -> Text
forall a b. (a, b) -> a
fst ((Text, Text) -> Text) -> (Text, Text) -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> (Text, Text)
T.breakOn Text
"-" (Text -> (Text, Text)) -> Text -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ Format Text (TurtlePath -> Text) -> TurtlePath -> Text
forall r. Format Text r -> r
Turtle.format Format Text (TurtlePath -> Text)
forall r. Format r (TurtlePath -> r)
Turtle.fp (TurtlePath -> Text) -> TurtlePath -> Text
forall a b. (a -> b) -> a -> b
$ TurtlePath -> TurtlePath
Turtle.basename TurtlePath
file
  let fileNames :: [TurtlePath]
fileNames = (Text -> TurtlePath) -> [Text] -> [TurtlePath]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> TurtlePath
Turtle.fromText (Text -> TurtlePath) -> (Text -> Text) -> Text -> TurtlePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format Text (TurtlePath -> Text -> Text)
-> TurtlePath -> Text -> Text
forall r. Format Text r -> r
Turtle.format (Format (Text -> Text) (TurtlePath -> Text -> Text)
forall r. Format r (TurtlePath -> r)
Turtle.fp Format (Text -> Text) (TurtlePath -> Text -> Text)
-> Format (Text -> Text) (Text -> Text)
-> Format (Text -> Text) (TurtlePath -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
% Format (Text -> Text) (Text -> Text)
"-" Format (Text -> Text) (TurtlePath -> Text -> Text)
-> Format Text (Text -> Text)
-> Format Text (TurtlePath -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
% Format Text (Text -> Text)
forall r. Format r (Text -> r)
Turtle.s) TurtlePath
dirprefix) [Text]
extraSuffixes
  let suffixFiles :: [TurtlePath]
suffixFiles = (TurtlePath -> TurtlePath) -> [TurtlePath] -> [TurtlePath]
forall a b. (a -> b) -> [a] -> [b]
map (TurtlePath -> TurtlePath
Turtle.directory TurtlePath
file TurtlePath -> TurtlePath -> TurtlePath
</>) [TurtlePath]
fileNames
  let suffixDirFiles :: [TurtlePath]
suffixDirFiles = (TurtlePath -> TurtlePath) -> [TurtlePath] -> [TurtlePath]
forall a b. (a -> b) -> [a] -> [b]
map (TurtlePath -> TurtlePath
Turtle.directory TurtlePath
file TurtlePath -> TurtlePath -> TurtlePath
</> TurtlePath
"_manual_" TurtlePath -> TurtlePath -> TurtlePath
</> TurtlePath
dirprefix TurtlePath -> TurtlePath -> TurtlePath
</>) [TurtlePath]
manualFiles
  let priceFiles :: [TurtlePath]
priceFiles = (TurtlePath -> TurtlePath) -> [TurtlePath] -> [TurtlePath]
forall a b. (a -> b) -> [a] -> [b]
map (TurtlePath -> TurtlePath
Turtle.directory TurtlePath
file TurtlePath -> TurtlePath -> TurtlePath
</> TurtlePath
".." TurtlePath -> TurtlePath -> TurtlePath
</> TurtlePath
"prices" TurtlePath -> TurtlePath -> TurtlePath
</> TurtlePath
dirprefix TurtlePath -> TurtlePath -> TurtlePath
</>) [TurtlePath]
prices
  let extraFiles :: [TurtlePath]
extraFiles = [TurtlePath]
suffixFiles [TurtlePath] -> [TurtlePath] -> [TurtlePath]
forall a. [a] -> [a] -> [a]
++ [TurtlePath]
suffixDirFiles [TurtlePath] -> [TurtlePath] -> [TurtlePath]
forall a. [a] -> [a] -> [a]
++ [TurtlePath]
priceFiles
  [TurtlePath]
filtered <- Shell [TurtlePath] -> IO [TurtlePath]
forall (io :: * -> *) a. MonadIO io => Shell a -> io a
Turtle.single (Shell [TurtlePath] -> IO [TurtlePath])
-> Shell [TurtlePath] -> IO [TurtlePath]
forall a b. (a -> b) -> a -> b
$ (TurtlePath -> IO Bool) -> [TurtlePath] -> Shell [TurtlePath]
filterPaths TurtlePath -> IO Bool
forall (io :: * -> *). MonadIO io => TurtlePath -> io Bool
Turtle.testfile [TurtlePath]
extraFiles
  let logMsg :: Text
logMsg = Format Text (TurtlePath -> Int -> Text -> Int -> Text -> Text)
-> TurtlePath -> Int -> Text -> Int -> Text -> Text
forall r. Format Text r -> r
Turtle.format (Format
  (TurtlePath -> Int -> Text -> Int -> Text -> Text)
  (TurtlePath -> Int -> Text -> Int -> Text -> Text)
"Looking for possible extra include files for '"Format
  (TurtlePath -> Int -> Text -> Int -> Text -> Text)
  (TurtlePath -> Int -> Text -> Int -> Text -> Text)
-> Format
     (Int -> Text -> Int -> Text -> Text)
     (TurtlePath -> Int -> Text -> Int -> Text -> Text)
-> Format
     (Int -> Text -> Int -> Text -> Text)
     (TurtlePath -> Int -> Text -> Int -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format
  (Int -> Text -> Int -> Text -> Text)
  (TurtlePath -> Int -> Text -> Int -> Text -> Text)
forall r. Format r (TurtlePath -> r)
Turtle.fpFormat
  (Int -> Text -> Int -> Text -> Text)
  (TurtlePath -> Int -> Text -> Int -> Text -> Text)
-> Format
     (Int -> Text -> Int -> Text -> Text)
     (Int -> Text -> Int -> Text -> Text)
-> Format
     (Int -> Text -> Int -> Text -> Text)
     (TurtlePath -> Int -> Text -> Int -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format
  (Int -> Text -> Int -> Text -> Text)
  (Int -> Text -> Int -> Text -> Text)
"' among these "Format
  (Int -> Text -> Int -> Text -> Text)
  (TurtlePath -> Int -> Text -> Int -> Text -> Text)
-> Format
     (Text -> Int -> Text -> Text) (Int -> Text -> Int -> Text -> Text)
-> Format
     (Text -> Int -> Text -> Text)
     (TurtlePath -> Int -> Text -> Int -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format
  (Text -> Int -> Text -> Text) (Int -> Text -> Int -> Text -> Text)
forall n r. Integral n => Format r (n -> r)
Turtle.dFormat
  (Text -> Int -> Text -> Text)
  (TurtlePath -> Int -> Text -> Int -> Text -> Text)
-> Format
     (Text -> Int -> Text -> Text) (Text -> Int -> Text -> Text)
-> Format
     (Text -> Int -> Text -> Text)
     (TurtlePath -> Int -> Text -> Int -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Text -> Int -> Text -> Text) (Text -> Int -> Text -> Text)
" options: "Format
  (Text -> Int -> Text -> Text)
  (TurtlePath -> Int -> Text -> Int -> Text -> Text)
-> Format (Int -> Text -> Text) (Text -> Int -> Text -> Text)
-> Format
     (Int -> Text -> Text)
     (TurtlePath -> Int -> Text -> Int -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Int -> Text -> Text) (Text -> Int -> Text -> Text)
forall r. Format r (Text -> r)
Turtle.sFormat
  (Int -> Text -> Text)
  (TurtlePath -> Int -> Text -> Int -> Text -> Text)
-> Format (Int -> Text -> Text) (Int -> Text -> Text)
-> Format
     (Int -> Text -> Text)
     (TurtlePath -> Int -> Text -> Int -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Int -> Text -> Text) (Int -> Text -> Text)
". Found "Format
  (Int -> Text -> Text)
  (TurtlePath -> Int -> Text -> Int -> Text -> Text)
-> Format (Text -> Text) (Int -> Text -> Text)
-> Format
     (Text -> Text) (TurtlePath -> Int -> Text -> Int -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Text -> Text) (Int -> Text -> Text)
forall n r. Integral n => Format r (n -> r)
Turtle.dFormat
  (Text -> Text) (TurtlePath -> Int -> Text -> Int -> Text -> Text)
-> Format (Text -> Text) (Text -> Text)
-> Format
     (Text -> Text) (TurtlePath -> Int -> Text -> Int -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Text -> Text) (Text -> Text)
": "Format
  (Text -> Text) (TurtlePath -> Int -> Text -> Int -> Text -> Text)
-> Format Text (Text -> Text)
-> Format Text (TurtlePath -> Int -> Text -> Int -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text (Text -> Text)
forall r. Format r (Text -> r)
Turtle.s)
               (o -> TurtlePath -> TurtlePath
forall o. HasBaseDir o => o -> TurtlePath -> TurtlePath
relativeToBase o
opts TurtlePath
file) ([TurtlePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TurtlePath]
extraFiles) ([Text] -> Text
forall a text. (Show a, IsString text) => a -> text
Turtle.repr ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ o -> [TurtlePath] -> [Text]
forall o. HasBaseDir o => o -> [TurtlePath] -> [Text]
relativeFilesAsText o
opts [TurtlePath]
extraFiles)
               ([TurtlePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TurtlePath]
filtered) ([Text] -> Text
forall a text. (Show a, IsString text) => a -> text
Turtle.repr ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ o -> [TurtlePath] -> [Text]
forall o. HasBaseDir o => o -> [TurtlePath] -> [Text]
relativeFilesAsText o
opts [TurtlePath]
filtered)
  o -> TChan LogMessage -> Text -> IO ()
forall o. HasVerbosity o => o -> TChan LogMessage -> Text -> IO ()
logVerbose o
opts TChan LogMessage
ch Text
logMsg
  TurtleFileBundle -> IO TurtleFileBundle
forall (m :: * -> *) a. Monad m => a -> m a
return (TurtleFileBundle -> IO TurtleFileBundle)
-> TurtleFileBundle -> IO TurtleFileBundle
forall a b. (a -> b) -> a -> b
$ [(TurtlePath, [TurtlePath])] -> TurtleFileBundle
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(TurtlePath
file, [TurtlePath]
filtered)]

relativeFilesAsText :: HasBaseDir o => o -> [TurtlePath] -> [T.Text]
relativeFilesAsText :: o -> [TurtlePath] -> [Text]
relativeFilesAsText o
opts = (TurtlePath -> Text) -> [TurtlePath] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Format Text (TurtlePath -> Text) -> TurtlePath -> Text
forall r. Format Text r -> r
Turtle.format Format Text (TurtlePath -> Text)
forall r. Format r (TurtlePath -> r)
Turtle.fp (TurtlePath -> Text)
-> (TurtlePath -> TurtlePath) -> TurtlePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. o -> TurtlePath -> TurtlePath
forall o. HasBaseDir o => o -> TurtlePath -> TurtlePath
relativeToBase o
opts)