{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}

module Hledger.Flow.Common where

import Path (absfile, relfile)
import qualified Path.IO as Path

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

import Prelude hiding (putStrLn)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Read as T
import qualified GHC.IO.Handle.FD as H

import Data.Char (isDigit)
import Data.Either

import qualified Control.Foldl as Fold
import qualified Data.Map.Strict as Map

import Data.Function (on)
import qualified Data.List as List (null, sortBy, groupBy)
import Data.Ord (comparing)

import Hledger.Flow.Types

import Hledger.Flow.Logging
import Hledger.Flow.PathHelpers (AbsFile, TurtlePath, fromTurtleAbsFile, pathToTurtle)
import Hledger.Flow.BaseDir (turtleBaseDir, relativeToBase)

import Control.Concurrent.STM

hledgerPathFromOption :: Maybe TurtlePath -> IO AbsFile
hledgerPathFromOption :: Maybe TurtlePath -> IO AbsFile
hledgerPathFromOption Maybe TurtlePath
pathOption = do
  case Maybe TurtlePath
pathOption of
    Just TurtlePath
h  -> do
      AbsFile
hlAbs <- TurtlePath -> IO AbsFile
forall (m :: * -> *). MonadThrow m => TurtlePath -> m AbsFile
fromTurtleAbsFile TurtlePath
h
      Bool
isOnDisk <- AbsFile -> IO Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
Path.doesFileExist AbsFile
hlAbs
      if Bool
isOnDisk then AbsFile -> IO AbsFile
forall (m :: * -> *) a. Monad m => a -> m a
return AbsFile
hlAbs else do
        let msg :: Text
msg = Format Text (TurtlePath -> Text) -> TurtlePath -> Text
forall r. Format Text r -> r
Turtle.format (Format (TurtlePath -> Text) (TurtlePath -> Text)
"Unable to find hledger at "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
h
        Int -> (Text -> IO ()) -> Text -> AbsFile -> IO AbsFile
forall a. Int -> (Text -> IO ()) -> Text -> a -> IO a
errExit' Int
1 (Handle -> Text -> IO ()
T.hPutStrLn Handle
H.stderr) Text
msg AbsFile
hlAbs
    Maybe TurtlePath
Nothing -> do
      Maybe AbsFile
maybeH <- Path Rel File -> IO (Maybe AbsFile)
forall (m :: * -> *).
MonadIO m =>
Path Rel File -> m (Maybe AbsFile)
Path.findExecutable [relfile|hledger|]
      case Maybe AbsFile
maybeH of
        Just AbsFile
h  -> AbsFile -> IO AbsFile
forall (m :: * -> *) a. Monad m => a -> m a
return AbsFile
h
        Maybe AbsFile
Nothing -> do
          let msg :: Text
msg = Text
"Unable to find hledger in your path.\n"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"You need to either install hledger, or add it to your PATH, or provide the path to an hledger executable.\n\n"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"There are a number of installation options on the hledger website: https://hledger.org/download.html"
          Int -> (Text -> IO ()) -> Text -> AbsFile -> IO AbsFile
forall a. Int -> (Text -> IO ()) -> Text -> a -> IO a
errExit' Int
1 (Handle -> Text -> IO ()
T.hPutStrLn Handle
H.stderr) Text
msg [absfile|/hledger|]

hledgerVersionFromPath :: TurtlePath -> IO T.Text
hledgerVersionFromPath :: TurtlePath -> IO Text
hledgerVersionFromPath TurtlePath
hlp = ([Line] -> Text) -> IO [Line] -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text
T.strip (Text -> Text) -> ([Line] -> Text) -> [Line] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Line] -> Text
Turtle.linesToText) (Shell [Line] -> IO [Line]
forall (io :: * -> *) a. MonadIO io => Shell a -> io a
Turtle.single (Shell [Line] -> IO [Line]) -> Shell [Line] -> IO [Line]
forall a b. (a -> b) -> a -> b
$ Shell Line -> Shell [Line]
forall a. Shell a -> Shell [a]
shellToList (Shell Line -> Shell [Line]) -> Shell Line -> Shell [Line]
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Shell Line -> Shell Line
Turtle.inproc (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
hlp) [Text
"--version"] Shell Line
forall (f :: * -> *) a. Alternative f => f a
Turtle.empty)

hledgerInfoFromPath :: Maybe TurtlePath -> IO HledgerInfo
hledgerInfoFromPath :: Maybe TurtlePath -> IO HledgerInfo
hledgerInfoFromPath Maybe TurtlePath
pathOption = do
  AbsFile
hlp <- Maybe TurtlePath -> IO AbsFile
hledgerPathFromOption Maybe TurtlePath
pathOption
  Text
hlv <- TurtlePath -> IO Text
hledgerVersionFromPath (TurtlePath -> IO Text) -> TurtlePath -> IO Text
forall a b. (a -> b) -> a -> b
$ AbsFile -> TurtlePath
forall b t. Path b t -> TurtlePath
pathToTurtle AbsFile
hlp
  HledgerInfo -> IO HledgerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (HledgerInfo -> IO HledgerInfo) -> HledgerInfo -> IO HledgerInfo
forall a b. (a -> b) -> a -> b
$ AbsFile -> Text -> HledgerInfo
HledgerInfo AbsFile
hlp Text
hlv

showCmdArgs :: [T.Text] -> T.Text
showCmdArgs :: [Text] -> Text
showCmdArgs [Text]
args = Text -> [Text] -> Text
T.intercalate Text
" " ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
escapeArg [Text]
args)

escapeArg :: T.Text -> T.Text
escapeArg :: Text -> Text
escapeArg Text
a = if Text -> Text -> Int
T.count Text
" " Text
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Text
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'" else Text
a

errExit :: Int -> TChan LogMessage -> T.Text -> a -> IO a
errExit :: Int -> TChan LogMessage -> Text -> a -> IO a
errExit Int
exitStatus TChan LogMessage
ch = Int -> (Text -> IO ()) -> Text -> a -> IO a
forall a. Int -> (Text -> IO ()) -> Text -> a -> IO a
errExit' Int
exitStatus (TChan LogMessage -> Text -> IO ()
channelErrLn TChan LogMessage
ch)

errExit' :: Int -> (T.Text -> IO ()) -> T.Text -> a -> IO a
errExit' :: Int -> (Text -> IO ()) -> Text -> a -> IO a
errExit' Int
exitStatus Text -> IO ()
logFun Text
errorMessage a
dummyReturnValue = do
  Text -> IO ()
logFun Text
errorMessage
  NominalDiffTime -> IO ()
forall (io :: * -> *). MonadIO io => NominalDiffTime -> io ()
Turtle.sleep NominalDiffTime
0.1
  Any
_ <- ExitCode -> IO Any
forall (io :: * -> *) a. MonadIO io => ExitCode -> io a
Turtle.exit (ExitCode -> IO Any) -> ExitCode -> IO Any
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
Turtle.ExitFailure Int
exitStatus
  a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
dummyReturnValue

descriptiveOutput :: T.Text -> T.Text -> T.Text
descriptiveOutput :: Text -> Text -> Text
descriptiveOutput Text
outputLabel Text
outTxt = do
  if Bool -> Bool
not (Text -> Bool
T.null Text
outTxt)
    then Format Text (Text -> Text -> Text) -> Text -> Text -> Text
forall r. Format Text r -> r
Turtle.format (Format (Text -> Text) (Text -> Text -> Text)
forall r. Format r (Text -> r)
Turtle.sFormat (Text -> Text) (Text -> Text -> Text)
-> Format (Text -> Text) (Text -> Text)
-> Format (Text -> Text) (Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Text -> Text) (Text -> Text)
":\n"Format (Text -> Text) (Text -> Text -> Text)
-> Format Text (Text -> Text) -> Format Text (Text -> 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.sFormat Text (Text -> Text -> Text)
-> Format Text Text -> Format Text (Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text Text
"\n") Text
outputLabel Text
outTxt
    else Text
""

logTimedAction :: HasVerbosity o => o -> TChan LogMessage -> T.Text -> [T.Text]
  -> (TChan LogMessage -> T.Text -> IO ()) -> (TChan LogMessage -> T.Text -> IO ())
  -> IO FullOutput
  -> IO FullTimedOutput
logTimedAction :: o
-> TChan LogMessage
-> Text
-> [Text]
-> (TChan LogMessage -> Text -> IO ())
-> (TChan LogMessage -> Text -> IO ())
-> IO FullOutput
-> IO FullTimedOutput
logTimedAction o
opts TChan LogMessage
ch Text
cmdLabel [Text]
extraCmdLabels TChan LogMessage -> Text -> IO ()
stdoutLogger TChan LogMessage -> Text -> IO ()
stderrLogger IO FullOutput
action = do
  o -> TChan LogMessage -> Text -> IO ()
forall o. HasVerbosity o => o -> TChan LogMessage -> Text -> IO ()
logVerbose o
opts TChan LogMessage
ch (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Format Text (Text -> Text) -> Text -> Text
forall r. Format Text r -> r
Turtle.format (Format (Text -> Text) (Text -> Text)
"Begin: "Format (Text -> Text) (Text -> Text)
-> Format Text (Text -> Text) -> Format Text (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) Text
cmdLabel
  if ([Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null [Text]
extraCmdLabels) then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else o -> TChan LogMessage -> Text -> IO ()
forall o. HasVerbosity o => o -> TChan LogMessage -> Text -> IO ()
logVerbose o
opts TChan LogMessage
ch (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n" [Text]
extraCmdLabels
  timed :: FullTimedOutput
timed@((ExitCode
ec, Text
stdOut, Text
stdErr), NominalDiffTime
diff) <- IO FullOutput -> IO FullTimedOutput
forall (io :: * -> *) a.
MonadIO io =>
io a -> io (a, NominalDiffTime)
Turtle.time IO FullOutput
action
  TChan LogMessage -> Text -> IO ()
stdoutLogger TChan LogMessage
ch Text
stdOut
  TChan LogMessage -> Text -> IO ()
stderrLogger TChan LogMessage
ch Text
stdErr
  o -> TChan LogMessage -> Text -> IO ()
forall o. HasVerbosity o => o -> TChan LogMessage -> Text -> IO ()
logVerbose o
opts TChan LogMessage
ch (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Format Text (Text -> Text -> Text -> Text)
-> Text -> Text -> Text -> Text
forall r. Format Text r -> r
Turtle.format (Format
  (Text -> Text -> Text -> Text) (Text -> Text -> Text -> Text)
"End:   "Format
  (Text -> Text -> Text -> Text) (Text -> Text -> Text -> Text)
-> Format (Text -> Text -> Text) (Text -> Text -> Text -> Text)
-> Format (Text -> Text -> Text) (Text -> Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Text -> Text -> Text) (Text -> Text -> Text -> Text)
forall r. Format r (Text -> r)
Turtle.sFormat (Text -> Text -> Text) (Text -> Text -> Text -> Text)
-> Format (Text -> Text -> Text) (Text -> Text -> Text)
-> Format (Text -> Text -> Text) (Text -> Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Text -> Text -> Text) (Text -> Text -> Text)
" "Format (Text -> Text -> Text) (Text -> Text -> Text -> Text)
-> Format (Text -> Text) (Text -> Text -> Text)
-> Format (Text -> Text) (Text -> Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Text -> Text) (Text -> Text -> Text)
forall r. Format r (Text -> r)
Turtle.sFormat (Text -> Text) (Text -> Text -> Text -> Text)
-> Format (Text -> Text) (Text -> Text)
-> Format (Text -> Text) (Text -> Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Text -> Text) (Text -> Text)
" ("Format (Text -> Text) (Text -> Text -> Text -> Text)
-> Format Text (Text -> Text)
-> Format Text (Text -> Text -> 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.sFormat Text (Text -> Text -> Text -> Text)
-> Format Text Text -> Format Text (Text -> Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text Text
")") Text
cmdLabel (ExitCode -> Text
forall a text. (Show a, IsString text) => a -> text
Turtle.repr ExitCode
ec) (NominalDiffTime -> Text
forall a text. (Show a, IsString text) => a -> text
Turtle.repr NominalDiffTime
diff)
  FullTimedOutput -> IO FullTimedOutput
forall (m :: * -> *) a. Monad m => a -> m a
return FullTimedOutput
timed

timeAndExitOnErr :: (HasSequential o, HasVerbosity o) => o -> TChan LogMessage -> T.Text
  -> (TChan LogMessage -> T.Text -> IO ()) -> (TChan LogMessage -> T.Text -> IO ())
  -> ProcFun -> ProcInput
  -> IO FullTimedOutput
timeAndExitOnErr :: o
-> TChan LogMessage
-> Text
-> (TChan LogMessage -> Text -> IO ())
-> (TChan LogMessage -> Text -> IO ())
-> ProcFun
-> ProcInput
-> IO FullTimedOutput
timeAndExitOnErr o
opts TChan LogMessage
ch Text
cmdLabel = o
-> TChan LogMessage
-> Text
-> [Text]
-> (TChan LogMessage -> Text -> IO ())
-> (TChan LogMessage -> Text -> IO ())
-> ProcFun
-> ProcInput
-> IO FullTimedOutput
forall o.
(HasSequential o, HasVerbosity o) =>
o
-> TChan LogMessage
-> Text
-> [Text]
-> (TChan LogMessage -> Text -> IO ())
-> (TChan LogMessage -> Text -> IO ())
-> ProcFun
-> ProcInput
-> IO FullTimedOutput
timeAndExitOnErr' o
opts TChan LogMessage
ch Text
cmdLabel []

timeAndExitOnErr' :: (HasSequential o, HasVerbosity o) => o -> TChan LogMessage -> T.Text -> [T.Text]
  -> (TChan LogMessage -> T.Text -> IO ()) -> (TChan LogMessage -> T.Text -> IO ())
  -> ProcFun -> ProcInput
  -> IO FullTimedOutput
timeAndExitOnErr' :: o
-> TChan LogMessage
-> Text
-> [Text]
-> (TChan LogMessage -> Text -> IO ())
-> (TChan LogMessage -> Text -> IO ())
-> ProcFun
-> ProcInput
-> IO FullTimedOutput
timeAndExitOnErr' o
opts TChan LogMessage
ch Text
cmdLabel [Text]
extraCmdLabels TChan LogMessage -> Text -> IO ()
stdoutLogger TChan LogMessage -> Text -> IO ()
stderrLogger ProcFun
procFun (Text
cmd, [Text]
args, Shell Line
stdInput) = do
  let action :: IO FullOutput
action = ProcFun
procFun Text
cmd [Text]
args Shell Line
stdInput
  timed :: FullTimedOutput
timed@((ExitCode
ec, Text
stdOut, Text
stdErr), NominalDiffTime
_) <- o
-> TChan LogMessage
-> Text
-> [Text]
-> (TChan LogMessage -> Text -> IO ())
-> (TChan LogMessage -> Text -> IO ())
-> IO FullOutput
-> IO FullTimedOutput
forall o.
HasVerbosity o =>
o
-> TChan LogMessage
-> Text
-> [Text]
-> (TChan LogMessage -> Text -> IO ())
-> (TChan LogMessage -> Text -> IO ())
-> IO FullOutput
-> IO FullTimedOutput
logTimedAction o
opts TChan LogMessage
ch Text
cmdLabel [Text]
extraCmdLabels TChan LogMessage -> Text -> IO ()
stdoutLogger TChan LogMessage -> Text -> IO ()
stderrLogger IO FullOutput
action
  case ExitCode
ec of
    Turtle.ExitFailure Int
i -> do
      let cmdText :: Text
cmdText = Format Text (Text -> Text -> Text) -> Text -> Text -> Text
forall r. Format Text r -> r
Turtle.format (Format (Text -> Text) (Text -> Text -> Text)
forall r. Format r (Text -> r)
Turtle.sFormat (Text -> Text) (Text -> Text -> Text)
-> Format (Text -> Text) (Text -> Text)
-> Format (Text -> Text) (Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Text -> Text) (Text -> Text)
" "Format (Text -> Text) (Text -> Text -> Text)
-> Format Text (Text -> Text) -> Format Text (Text -> 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) Text
cmd (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
showCmdArgs [Text]
args
      let msgOut :: Text
msgOut = Text -> Text -> Text
descriptiveOutput Text
"Standard output" Text
stdOut
      let msgErr :: Text
msgErr = Text -> Text -> Text
descriptiveOutput Text
"Error output" Text
stdErr

      let exitMsg :: Text
exitMsg = Format Text (Text -> Text -> Int -> Text -> Text -> Text -> Text)
-> Text -> Text -> Int -> Text -> Text -> Text -> Text
forall r. Format Text r -> r
Turtle.format (Format
  (Text -> Text -> Int -> Text -> Text -> Text -> Text)
  (Text -> Text -> Int -> Text -> Text -> Text -> Text)
"\n=== Begin Error: "Format
  (Text -> Text -> Int -> Text -> Text -> Text -> Text)
  (Text -> Text -> Int -> Text -> Text -> Text -> Text)
-> Format
     (Text -> Int -> Text -> Text -> Text -> Text)
     (Text -> Text -> Int -> Text -> Text -> Text -> Text)
-> Format
     (Text -> Int -> Text -> Text -> Text -> Text)
     (Text -> Text -> Int -> Text -> Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format
  (Text -> Int -> Text -> Text -> Text -> Text)
  (Text -> Text -> Int -> Text -> Text -> Text -> Text)
forall r. Format r (Text -> r)
Turtle.sFormat
  (Text -> Int -> Text -> Text -> Text -> Text)
  (Text -> Text -> Int -> Text -> Text -> Text -> Text)
-> Format
     (Text -> Int -> Text -> Text -> Text -> Text)
     (Text -> Int -> Text -> Text -> Text -> Text)
-> Format
     (Text -> Int -> Text -> Text -> Text -> Text)
     (Text -> Text -> Int -> Text -> Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format
  (Text -> Int -> Text -> Text -> Text -> Text)
  (Text -> Int -> Text -> Text -> Text -> Text)
" ===\nExternal command:\n"Format
  (Text -> Int -> Text -> Text -> Text -> Text)
  (Text -> Text -> Int -> Text -> Text -> Text -> Text)
-> Format
     (Int -> Text -> Text -> Text -> Text)
     (Text -> Int -> Text -> Text -> Text -> Text)
-> Format
     (Int -> Text -> Text -> Text -> Text)
     (Text -> Text -> Int -> Text -> Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format
  (Int -> Text -> Text -> Text -> Text)
  (Text -> Int -> Text -> Text -> Text -> Text)
forall r. Format r (Text -> r)
Turtle.sFormat
  (Int -> Text -> Text -> Text -> Text)
  (Text -> Text -> Int -> Text -> Text -> Text -> Text)
-> Format
     (Int -> Text -> Text -> Text -> Text)
     (Int -> Text -> Text -> Text -> Text)
-> Format
     (Int -> Text -> Text -> Text -> Text)
     (Text -> Text -> Int -> Text -> Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format
  (Int -> Text -> Text -> Text -> Text)
  (Int -> Text -> Text -> Text -> Text)
"\nExit code "Format
  (Int -> Text -> Text -> Text -> Text)
  (Text -> Text -> Int -> Text -> Text -> Text -> Text)
-> Format
     (Text -> Text -> Text -> Text)
     (Int -> Text -> Text -> Text -> Text)
-> Format
     (Text -> Text -> Text -> Text)
     (Text -> Text -> Int -> Text -> Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format
  (Text -> Text -> Text -> Text)
  (Int -> Text -> Text -> Text -> Text)
forall n r. Integral n => Format r (n -> r)
Turtle.dFormat
  (Text -> Text -> Text -> Text)
  (Text -> Text -> Int -> Text -> Text -> Text -> Text)
-> Format
     (Text -> Text -> Text -> Text) (Text -> Text -> Text -> Text)
-> Format
     (Text -> Text -> Text -> Text)
     (Text -> Text -> Int -> Text -> Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format
  (Text -> Text -> Text -> Text) (Text -> Text -> Text -> Text)
"\n"
                            Format
  (Text -> Text -> Text -> Text)
  (Text -> Text -> Int -> Text -> Text -> Text -> Text)
-> Format (Text -> Text -> Text) (Text -> Text -> Text -> Text)
-> Format
     (Text -> Text -> Text)
     (Text -> Text -> Int -> Text -> Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Text -> Text -> Text) (Text -> Text -> Text -> Text)
forall r. Format r (Text -> r)
Turtle.sFormat
  (Text -> Text -> Text)
  (Text -> Text -> Int -> Text -> Text -> Text -> Text)
-> Format (Text -> Text) (Text -> Text -> Text)
-> Format
     (Text -> Text)
     (Text -> Text -> Int -> Text -> Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Text -> Text) (Text -> Text -> Text)
forall r. Format r (Text -> r)
Turtle.sFormat
  (Text -> Text)
  (Text -> Text -> Int -> Text -> Text -> Text -> Text)
-> Format (Text -> Text) (Text -> Text)
-> Format
     (Text -> Text)
     (Text -> Text -> Int -> Text -> Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Text -> Text) (Text -> Text)
"=== End Error: "Format
  (Text -> Text)
  (Text -> Text -> Int -> Text -> Text -> Text -> Text)
-> Format Text (Text -> Text)
-> Format
     Text (Text -> Text -> Int -> Text -> Text -> 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.sFormat Text (Text -> Text -> Int -> Text -> Text -> Text -> Text)
-> Format Text Text
-> Format
     Text (Text -> Text -> Int -> Text -> Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text Text
" ===\n") Text
cmdLabel Text
cmdText Int
i Text
msgOut Text
msgErr Text
cmdLabel
      Int
-> TChan LogMessage
-> Text
-> FullTimedOutput
-> IO FullTimedOutput
forall a. Int -> TChan LogMessage -> Text -> a -> IO a
errExit Int
i TChan LogMessage
ch Text
exitMsg FullTimedOutput
timed
    ExitCode
Turtle.ExitSuccess -> FullTimedOutput -> IO FullTimedOutput
forall (m :: * -> *) a. Monad m => a -> m a
return FullTimedOutput
timed

procWithEmptyOutput :: ProcFun
procWithEmptyOutput :: ProcFun
procWithEmptyOutput Text
cmd [Text]
args Shell Line
stdinput = do
  ExitCode
ec <- Text -> [Text] -> Shell Line -> IO ExitCode
forall (io :: * -> *).
MonadIO io =>
Text -> [Text] -> Shell Line -> io ExitCode
Turtle.proc Text
cmd [Text]
args Shell Line
stdinput
  FullOutput -> IO FullOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode
ec, Text
T.empty, Text
T.empty)

parAwareProc :: HasSequential o => o -> ProcFun
parAwareProc :: o -> ProcFun
parAwareProc o
opts = if (o -> Bool
forall a. HasSequential a => a -> Bool
sequential o
opts) then ProcFun
procWithEmptyOutput else ProcFun
forall (io :: * -> *).
MonadIO io =>
Text -> [Text] -> Shell Line -> io FullOutput
Turtle.procStrictWithErr

parAwareActions :: (HasSequential o, HasBatchSize o) => o -> [IO a] -> IO [a]
parAwareActions :: o -> [IO a] -> IO [a]
parAwareActions o
opts = if (o -> Bool
forall a. HasSequential a => a -> Bool
sequential o
opts) then [IO a] -> IO [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence else Int -> [a] -> [IO a] -> IO [a]
forall a. Int -> [a] -> [IO a] -> IO [a]
parBatchedActions (o -> Int
forall a. HasBatchSize a => a -> Int
batchSize o
opts) []

parBatchedActions :: Int -> [a] -> [IO a] -> IO [a]
parBatchedActions :: Int -> [a] -> [IO a] -> IO [a]
parBatchedActions Int
_ [a]
done [] = [a] -> IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
done
parBatchedActions Int
batch [a]
done [IO a]
todo = do
  let doNow :: [IO a]
doNow = Int -> [IO a] -> [IO a]
forall a. Int -> [a] -> [a]
take Int
batch [IO a]
todo
  let remaining :: [IO a]
remaining = Int -> [IO a] -> [IO a]
forall a. Int -> [a] -> [a]
drop Int
batch [IO a]
todo
  [a]
doneNow <- (Shell [a] -> IO [a]
forall (io :: * -> *) a. MonadIO io => Shell a -> io a
Turtle.single (Shell [a] -> IO [a]) -> ([IO a] -> Shell [a]) -> [IO a] -> IO [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Shell a -> Shell [a]
forall a. Shell a -> Shell [a]
shellToList (Shell a -> Shell [a])
-> ([IO a] -> Shell a) -> [IO a] -> Shell [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IO a] -> Shell a
forall a. [IO a] -> Shell a
Turtle.parallel) [IO a]
doNow
  Int -> [a] -> [IO a] -> IO [a]
forall a. Int -> [a] -> [IO a] -> IO [a]
parBatchedActions Int
batch ([a]
done [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
doneNow) [IO a]
remaining


inprocWithErrFun :: (T.Text -> IO ()) -> ProcInput -> Turtle.Shell Turtle.Line
inprocWithErrFun :: (Text -> IO ()) -> ProcInput -> Shell Line
inprocWithErrFun Text -> IO ()
errFun (Text
cmd, [Text]
args, Shell Line
standardInput) = do
  Either Line Line
result <- Text -> [Text] -> Shell Line -> Shell (Either Line Line)
Turtle.inprocWithErr Text
cmd [Text]
args Shell Line
standardInput
  case Either Line Line
result of
    Right Line
ln -> Line -> Shell Line
forall (m :: * -> *) a. Monad m => a -> m a
return Line
ln
    Left  Line
ln -> do
      (IO () -> Shell ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Turtle.liftIO (IO () -> Shell ()) -> (Line -> IO ()) -> Line -> Shell ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
errFun (Text -> IO ()) -> (Line -> Text) -> Line -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line -> Text
Turtle.lineToText) Line
ln
      Shell Line
forall (f :: * -> *) a. Alternative f => f a
Turtle.empty

verboseTestFile :: (HasVerbosity o, HasBaseDir o) => o -> TChan LogMessage -> TurtlePath -> IO Bool
verboseTestFile :: o -> TChan LogMessage -> TurtlePath -> IO Bool
verboseTestFile o
opts TChan LogMessage
ch TurtlePath
p = do
  Bool
fileExists <- TurtlePath -> IO Bool
forall (io :: * -> *). MonadIO io => TurtlePath -> io Bool
Turtle.testfile TurtlePath
p
  let rel :: TurtlePath
rel = o -> TurtlePath -> TurtlePath
forall o. HasBaseDir o => o -> TurtlePath -> TurtlePath
relativeToBase o
opts TurtlePath
p
  if Bool
fileExists
    then o -> TChan LogMessage -> Text -> IO ()
forall o. HasVerbosity o => o -> TChan LogMessage -> Text -> IO ()
logVerbose o
opts TChan LogMessage
ch (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Format Text (TurtlePath -> Text) -> TurtlePath -> Text
forall r. Format Text r -> r
Turtle.format (Format (TurtlePath -> Text) (TurtlePath -> Text)
"Found '"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.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
"'") TurtlePath
rel
    else o -> TChan LogMessage -> Text -> IO ()
forall o. HasVerbosity o => o -> TChan LogMessage -> Text -> IO ()
logVerbose o
opts TChan LogMessage
ch (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Format Text (TurtlePath -> Text) -> TurtlePath -> Text
forall r. Format Text r -> r
Turtle.format (Format (TurtlePath -> Text) (TurtlePath -> Text)
"Looked for but did not find '"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.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
"'") TurtlePath
rel
  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
fileExists

groupPairs' :: (Eq a, Ord a) => [(a, b)] -> [(a, [b])]
groupPairs' :: [(a, b)] -> [(a, [b])]
groupPairs' = ([(a, b)] -> (a, [b])) -> [[(a, b)]] -> [(a, [b])]
forall a b. (a -> b) -> [a] -> [b]
map (\[(a, b)]
ll -> ((a, b) -> a
forall a b. (a, b) -> a
fst ((a, b) -> a) -> ([(a, b)] -> (a, b)) -> [(a, b)] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, b)] -> (a, b)
forall a. [a] -> a
head ([(a, b)] -> a) -> [(a, b)] -> a
forall a b. (a -> b) -> a -> b
$ [(a, b)]
ll, ((a, b) -> b) -> [(a, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> b
forall a b. (a, b) -> b
snd [(a, b)]
ll)) ([[(a, b)]] -> [(a, [b])])
-> ([(a, b)] -> [[(a, b)]]) -> [(a, b)] -> [(a, [b])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> (a, b) -> Bool) -> [(a, b)] -> [[(a, b)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
List.groupBy (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) (a -> a -> Bool) -> ((a, b) -> a) -> (a, b) -> (a, b) -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (a, b) -> a
forall a b. (a, b) -> a
fst)
              ([(a, b)] -> [[(a, b)]])
-> ([(a, b)] -> [(a, b)]) -> [(a, b)] -> [[(a, b)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> (a, b) -> Ordering) -> [(a, b)] -> [(a, b)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy (((a, b) -> a) -> (a, b) -> (a, b) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (a, b) -> a
forall a b. (a, b) -> a
fst)

groupPairs :: (Eq a, Ord a) => [(a, b)] -> Map.Map a [b]
groupPairs :: [(a, b)] -> Map a [b]
groupPairs = [(a, [b])] -> Map a [b]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(a, [b])] -> Map a [b])
-> ([(a, b)] -> [(a, [b])]) -> [(a, b)] -> Map a [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, b)] -> [(a, [b])]
forall a b. (Eq a, Ord a) => [(a, b)] -> [(a, [b])]
groupPairs'

pairBy :: (a -> b) -> [a] -> [(b, a)]
pairBy :: (a -> b) -> [a] -> [(b, a)]
pairBy a -> b
keyFun = (a -> (b, a)) -> [a] -> [(b, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\a
v -> (a -> b
keyFun a
v, a
v))

groupValuesBy :: (Ord k, Ord v) => (v -> k) -> [v] -> Map.Map k [v]
groupValuesBy :: (v -> k) -> [v] -> Map k [v]
groupValuesBy v -> k
keyFun = [(k, v)] -> Map k [v]
forall a b. (Eq a, Ord a) => [(a, b)] -> Map a [b]
groupPairs ([(k, v)] -> Map k [v]) -> ([v] -> [(k, v)]) -> [v] -> Map k [v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> k) -> [v] -> [(k, v)]
forall a b. (a -> b) -> [a] -> [(b, a)]
pairBy v -> k
keyFun

allYearsFileName :: TurtlePath
allYearsFileName :: TurtlePath
allYearsFileName = TurtlePath
"all-years" TurtlePath -> Text -> TurtlePath
<.> Text
"journal"

lsDirs :: TurtlePath -> Turtle.Shell TurtlePath
lsDirs :: TurtlePath -> Shell TurtlePath
lsDirs = Shell TurtlePath -> Shell TurtlePath
onlyDirs (Shell TurtlePath -> Shell TurtlePath)
-> (TurtlePath -> Shell TurtlePath)
-> TurtlePath
-> Shell TurtlePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TurtlePath -> Shell TurtlePath
Turtle.ls

onlyDirs :: Turtle.Shell TurtlePath -> Turtle.Shell TurtlePath
onlyDirs :: Shell TurtlePath -> Shell TurtlePath
onlyDirs = Shell TurtlePath -> Shell TurtlePath
excludeHiddenFiles (Shell TurtlePath -> Shell TurtlePath)
-> (Shell TurtlePath -> Shell TurtlePath)
-> Shell TurtlePath
-> Shell TurtlePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Shell TurtlePath -> Shell TurtlePath
excludeWeirdPaths (Shell TurtlePath -> Shell TurtlePath)
-> (Shell TurtlePath -> Shell TurtlePath)
-> Shell TurtlePath
-> Shell TurtlePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FileStatus -> Bool) -> Shell TurtlePath -> Shell TurtlePath
filterPathsByFileStatus FileStatus -> Bool
Turtle.isDirectory

onlyFiles :: Turtle.Shell TurtlePath -> Turtle.Shell TurtlePath
onlyFiles :: Shell TurtlePath -> Shell TurtlePath
onlyFiles = Shell TurtlePath -> Shell TurtlePath
excludeHiddenFiles (Shell TurtlePath -> Shell TurtlePath)
-> (Shell TurtlePath -> Shell TurtlePath)
-> Shell TurtlePath
-> Shell TurtlePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FileStatus -> Bool) -> Shell TurtlePath -> Shell TurtlePath
filterPathsByFileStatus FileStatus -> Bool
Turtle.isRegularFile

filterPathsByFileStatus :: (Turtle.FileStatus -> Bool) -> Turtle.Shell TurtlePath -> Turtle.Shell TurtlePath
filterPathsByFileStatus :: (FileStatus -> Bool) -> Shell TurtlePath -> Shell TurtlePath
filterPathsByFileStatus FileStatus -> Bool
filepred Shell TurtlePath
files = do
  [TurtlePath]
files' <- Shell TurtlePath -> Shell [TurtlePath]
forall a. Shell a -> Shell [a]
shellToList Shell TurtlePath
files
  [TurtlePath]
filtered <- (FileStatus -> Bool)
-> [TurtlePath] -> [TurtlePath] -> Shell [TurtlePath]
filterPathsByFileStatus' FileStatus -> Bool
filepred [] [TurtlePath]
files'
  [TurtlePath] -> Shell TurtlePath
forall (f :: * -> *) a. Foldable f => f a -> Shell a
Turtle.select [TurtlePath]
filtered

filterPathsByFileStatus' :: (Turtle.FileStatus -> Bool) -> [TurtlePath] -> [TurtlePath] -> Turtle.Shell [TurtlePath]
filterPathsByFileStatus' :: (FileStatus -> Bool)
-> [TurtlePath] -> [TurtlePath] -> Shell [TurtlePath]
filterPathsByFileStatus' FileStatus -> Bool
_ [TurtlePath]
acc [] = [TurtlePath] -> Shell [TurtlePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [TurtlePath]
acc
filterPathsByFileStatus' FileStatus -> Bool
filepred [TurtlePath]
acc (TurtlePath
file:[TurtlePath]
files) = do
  FileStatus
filestat <- TurtlePath -> Shell FileStatus
forall (io :: * -> *). MonadIO io => TurtlePath -> io FileStatus
Turtle.stat TurtlePath
file
  let filtered :: [TurtlePath]
filtered = if (FileStatus -> Bool
filepred FileStatus
filestat) then TurtlePath
fileTurtlePath -> [TurtlePath] -> [TurtlePath]
forall a. a -> [a] -> [a]
:[TurtlePath]
acc else [TurtlePath]
acc
  (FileStatus -> Bool)
-> [TurtlePath] -> [TurtlePath] -> Shell [TurtlePath]
filterPathsByFileStatus' FileStatus -> Bool
filepred [TurtlePath]
filtered [TurtlePath]
files

filterPaths :: (TurtlePath -> IO Bool) -> [TurtlePath] -> Turtle.Shell [TurtlePath]
filterPaths :: (TurtlePath -> IO Bool) -> [TurtlePath] -> Shell [TurtlePath]
filterPaths = [TurtlePath]
-> (TurtlePath -> IO Bool) -> [TurtlePath] -> Shell [TurtlePath]
filterPaths' []

filterPaths' :: [TurtlePath] -> (TurtlePath -> IO Bool) -> [TurtlePath] -> Turtle.Shell [TurtlePath]
filterPaths' :: [TurtlePath]
-> (TurtlePath -> IO Bool) -> [TurtlePath] -> Shell [TurtlePath]
filterPaths' [TurtlePath]
acc TurtlePath -> IO Bool
_ [] = [TurtlePath] -> Shell [TurtlePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [TurtlePath]
acc
filterPaths' [TurtlePath]
acc TurtlePath -> IO Bool
filepred (TurtlePath
file:[TurtlePath]
files) = do
  Bool
shouldInclude <- IO Bool -> Shell Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Turtle.liftIO (IO Bool -> Shell Bool) -> IO Bool -> Shell Bool
forall a b. (a -> b) -> a -> b
$ TurtlePath -> IO Bool
filepred TurtlePath
file
  let filtered :: [TurtlePath]
filtered = if Bool
shouldInclude then TurtlePath
fileTurtlePath -> [TurtlePath] -> [TurtlePath]
forall a. a -> [a] -> [a]
:[TurtlePath]
acc else [TurtlePath]
acc
  [TurtlePath]
-> (TurtlePath -> IO Bool) -> [TurtlePath] -> Shell [TurtlePath]
filterPaths' [TurtlePath]
filtered TurtlePath -> IO Bool
filepred [TurtlePath]
files

excludeHiddenFiles :: Turtle.Shell TurtlePath -> Turtle.Shell TurtlePath
excludeHiddenFiles :: Shell TurtlePath -> Shell TurtlePath
excludeHiddenFiles Shell TurtlePath
paths = do
  TurtlePath
p <- Shell TurtlePath
paths
  case (Pattern Text -> Text -> [Text]
forall a. Pattern a -> Text -> [a]
Turtle.match (Pattern Text -> Pattern Text
forall a. Pattern a -> Pattern a
Turtle.prefix Pattern 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.filename TurtlePath
p) of
    [] -> [TurtlePath] -> Shell TurtlePath
forall (f :: * -> *) a. Foldable f => f a -> Shell a
Turtle.select [TurtlePath
p]
    [Text]
_  -> [TurtlePath] -> Shell TurtlePath
forall (f :: * -> *) a. Foldable f => f a -> Shell a
Turtle.select []

excludeWeirdPaths :: Turtle.Shell TurtlePath -> Turtle.Shell TurtlePath
excludeWeirdPaths :: Shell TurtlePath -> Shell TurtlePath
excludeWeirdPaths = Pattern Char -> Shell TurtlePath -> Shell TurtlePath
forall a. Pattern a -> Shell TurtlePath -> Shell TurtlePath
Turtle.findtree (Pattern Char -> Pattern Char
forall a. Pattern a -> Pattern a
Turtle.suffix (Pattern Char -> Pattern Char) -> Pattern Char -> Pattern Char
forall a b. (a -> b) -> a -> b
$ FilePath -> Pattern Char
Turtle.noneOf FilePath
"_")

firstExistingFile :: [TurtlePath] -> IO (Maybe TurtlePath)
firstExistingFile :: [TurtlePath] -> IO (Maybe TurtlePath)
firstExistingFile [TurtlePath]
files = do
  case [TurtlePath]
files of
    []   -> Maybe TurtlePath -> IO (Maybe TurtlePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TurtlePath
forall a. Maybe a
Nothing
    TurtlePath
file:[TurtlePath]
fs -> do
      Bool
exists <- TurtlePath -> IO Bool
forall (io :: * -> *). MonadIO io => TurtlePath -> io Bool
Turtle.testfile TurtlePath
file
      if Bool
exists then Maybe TurtlePath -> IO (Maybe TurtlePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (TurtlePath -> Maybe TurtlePath
forall a. a -> Maybe a
Just TurtlePath
file) else [TurtlePath] -> IO (Maybe TurtlePath)
firstExistingFile [TurtlePath]
fs

basenameLine :: TurtlePath -> Turtle.Shell Turtle.Line
basenameLine :: TurtlePath -> Shell Line
basenameLine TurtlePath
path = case (Text -> Maybe Line
Turtle.textToLine (Text -> Maybe Line) -> Text -> Maybe Line
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
path) of
  Maybe Line
Nothing -> Text -> Shell Line
forall (io :: * -> *) a. MonadIO io => Text -> io a
Turtle.die (Text -> Shell Line) -> Text -> Shell Line
forall a b. (a -> b) -> a -> b
$ Format Text (TurtlePath -> Text) -> TurtlePath -> Text
forall r. Format Text r -> r
Turtle.format (Format (TurtlePath -> Text) (TurtlePath -> Text)
"Unable to determine basename from path: "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.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
"\n") TurtlePath
path
  Just Line
bn -> Line -> Shell Line
forall (m :: * -> *) a. Monad m => a -> m a
return Line
bn

buildFilename :: [Turtle.Line] -> T.Text -> TurtlePath
buildFilename :: [Line] -> Text -> TurtlePath
buildFilename [Line]
identifiers Text
ext = Text -> TurtlePath
Turtle.fromText (Text -> [Text] -> Text
T.intercalate Text
"-" ((Line -> Text) -> [Line] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Line -> Text
Turtle.lineToText [Line]
identifiers)) TurtlePath -> Text -> TurtlePath
<.> Text
ext

shellToList :: Turtle.Shell a -> Turtle.Shell [a]
shellToList :: Shell a -> Shell [a]
shellToList Shell a
files = Shell a -> Fold a [a] -> Shell [a]
forall (io :: * -> *) a b.
MonadIO io =>
Shell a -> Fold a b -> io b
Turtle.fold Shell a
files Fold a [a]
forall a. Fold a [a]
Fold.list

writeFiles :: IO (Map.Map TurtlePath T.Text) -> IO [TurtlePath]
writeFiles :: IO (Map TurtlePath Text) -> IO [TurtlePath]
writeFiles IO (Map TurtlePath Text)
fileMap = do
  Map TurtlePath Text
m <- IO (Map TurtlePath Text)
fileMap
  Map TurtlePath Text -> IO [TurtlePath]
writeFiles' Map TurtlePath Text
m

writeFiles' :: Map.Map TurtlePath T.Text -> IO [TurtlePath]
writeFiles' :: Map TurtlePath Text -> IO [TurtlePath]
writeFiles' Map TurtlePath Text
fileMap = do
  Map TurtlePath Text -> IO ()
writeTextMap Map TurtlePath Text
fileMap
  [TurtlePath] -> IO [TurtlePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([TurtlePath] -> IO [TurtlePath])
-> [TurtlePath] -> IO [TurtlePath]
forall a b. (a -> b) -> a -> b
$ Map TurtlePath Text -> [TurtlePath]
forall k a. Map k a -> [k]
Map.keys Map TurtlePath Text
fileMap

writeTextMap :: Map.Map TurtlePath T.Text -> IO ()
writeTextMap :: Map TurtlePath Text -> IO ()
writeTextMap = (IO () -> TurtlePath -> Text -> IO ())
-> IO () -> Map TurtlePath Text -> IO ()
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey (\IO ()
a TurtlePath
k Text
v -> IO ()
a IO () -> IO () -> IO ()
forall a. Semigroup a => a -> a -> a
<> TurtlePath -> Text -> IO ()
Turtle.writeTextFile TurtlePath
k Text
v) (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

changeExtension :: T.Text -> TurtlePath -> TurtlePath
changeExtension :: Text -> TurtlePath -> TurtlePath
changeExtension Text
ext TurtlePath
path = (TurtlePath -> TurtlePath
Turtle.dropExtension TurtlePath
path) TurtlePath -> Text -> TurtlePath
<.> Text
ext

changePathAndExtension :: TurtlePath -> T.Text -> TurtlePath -> TurtlePath
changePathAndExtension :: TurtlePath -> Text -> TurtlePath -> TurtlePath
changePathAndExtension TurtlePath
newOutputLocation Text
newExt = (TurtlePath -> TurtlePath -> TurtlePath
changeOutputPath TurtlePath
newOutputLocation) (TurtlePath -> TurtlePath)
-> (TurtlePath -> TurtlePath) -> TurtlePath -> TurtlePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> TurtlePath -> TurtlePath
changeExtension Text
newExt)

changeOutputPath :: TurtlePath -> TurtlePath -> TurtlePath
changeOutputPath :: TurtlePath -> TurtlePath -> TurtlePath
changeOutputPath TurtlePath
newOutputLocation TurtlePath
srcFile = [TurtlePath] -> TurtlePath
forall a. Monoid a => [a] -> a
mconcat ([TurtlePath] -> TurtlePath) -> [TurtlePath] -> TurtlePath
forall a b. (a -> b) -> a -> b
$ (TurtlePath -> TurtlePath) -> [TurtlePath] -> [TurtlePath]
forall a b. (a -> b) -> [a] -> [b]
map TurtlePath -> TurtlePath
changeSrcDir ([TurtlePath] -> [TurtlePath]) -> [TurtlePath] -> [TurtlePath]
forall a b. (a -> b) -> a -> b
$ TurtlePath -> [TurtlePath]
Turtle.splitDirectories TurtlePath
srcFile
  where changeSrcDir :: TurtlePath -> TurtlePath
changeSrcDir TurtlePath
file = if TurtlePath
file TurtlePath -> TurtlePath -> Bool
forall a. Eq a => a -> a -> Bool
== TurtlePath
"1-in/" Bool -> Bool -> Bool
|| TurtlePath
file TurtlePath -> TurtlePath -> Bool
forall a. Eq a => a -> a -> Bool
== TurtlePath
"2-preprocessed/" then TurtlePath
newOutputLocation else TurtlePath
file

listOwners :: HasBaseDir o => o -> Turtle.Shell TurtlePath
listOwners :: o -> Shell TurtlePath
listOwners o
opts = (TurtlePath -> TurtlePath) -> Shell TurtlePath -> Shell TurtlePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TurtlePath -> TurtlePath
Turtle.basename (Shell TurtlePath -> Shell TurtlePath)
-> Shell TurtlePath -> Shell TurtlePath
forall a b. (a -> b) -> a -> b
$ TurtlePath -> Shell TurtlePath
lsDirs (TurtlePath -> Shell TurtlePath) -> TurtlePath -> Shell TurtlePath
forall a b. (a -> b) -> a -> b
$ (o -> TurtlePath
forall o. HasBaseDir o => o -> TurtlePath
turtleBaseDir o
opts) TurtlePath -> TurtlePath -> TurtlePath
</> TurtlePath
"import"

intPath :: Integer -> TurtlePath
intPath :: Integer -> TurtlePath
intPath = Text -> TurtlePath
Turtle.fromText (Text -> TurtlePath) -> (Integer -> Text) -> Integer -> TurtlePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Format Text (Integer -> Text) -> Integer -> Text
forall r. Format Text r -> r
Turtle.format Format Text (Integer -> Text)
forall n r. Integral n => Format r (n -> r)
Turtle.d)

includeYears :: TChan LogMessage -> TurtlePath -> IO [Integer]
includeYears :: TChan LogMessage -> TurtlePath -> IO [Integer]
includeYears TChan LogMessage
ch TurtlePath
includeFile = do
  Text
txt <- TurtlePath -> IO Text
Turtle.readTextFile TurtlePath
includeFile
  case Text -> Either Text [Integer]
includeYears' Text
txt of
    Left  Text
msg   -> do
      TChan LogMessage -> Text -> IO ()
channelErrLn TChan LogMessage
ch Text
msg
      [Integer] -> IO [Integer]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Right [Integer]
years -> [Integer] -> IO [Integer]
forall (m :: * -> *) a. Monad m => a -> m a
return [Integer]
years

includeYears' :: T.Text -> Either T.Text [Integer]
includeYears' :: Text -> Either Text [Integer]
includeYears' Text
txt = case [Either FilePath Integer] -> ([FilePath], [Integer])
forall a b. [Either a b] -> ([a], [b])
partitionEithers (Text -> [Either FilePath Integer]
includeYears'' Text
txt) of
  ([FilePath]
errors, []) -> do
    let msg :: Text
msg = Format Text (Text -> Text -> Text) -> Text -> Text -> Text
forall r. Format Text r -> r
Turtle.format (Format (Text -> Text -> Text) (Text -> Text -> Text)
"Unable to extract years from the following text:\n"Format (Text -> Text -> Text) (Text -> Text -> Text)
-> Format (Text -> Text) (Text -> Text -> Text)
-> Format (Text -> Text) (Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Text -> Text) (Text -> Text -> Text)
forall r. Format r (Text -> r)
Turtle.sFormat (Text -> Text) (Text -> Text -> Text)
-> Format (Text -> Text) (Text -> Text)
-> Format (Text -> Text) (Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Text -> Text) (Text -> Text)
"\nErrors:\n"Format (Text -> Text) (Text -> Text -> Text)
-> Format Text (Text -> Text) -> Format Text (Text -> 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) Text
txt (Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (FilePath -> Text) -> [FilePath] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Text
T.pack [FilePath]
errors)
    Text -> Either Text [Integer]
forall a b. a -> Either a b
Left Text
msg
  ([FilePath]
_, [Integer]
years) -> [Integer] -> Either Text [Integer]
forall a b. b -> Either a b
Right [Integer]
years

includeYears'' :: T.Text -> [Either String Integer]
includeYears'' :: Text -> [Either FilePath Integer]
includeYears'' Text
txt = (Text -> Either FilePath Integer)
-> [Text] -> [Either FilePath Integer]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Either FilePath Integer
extractDigits (Text -> [Text]
T.lines Text
txt)

extractDigits :: T.Text -> Either String Integer
extractDigits :: Text -> Either FilePath Integer
extractDigits Text
txt = ((Integer, Text) -> Integer)
-> Either FilePath (Integer, Text) -> Either FilePath Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer, Text) -> Integer
forall a b. (a, b) -> a
fst (Either FilePath (Integer, Text) -> Either FilePath Integer)
-> Either FilePath (Integer, Text) -> Either FilePath Integer
forall a b. (a -> b) -> a -> b
$ (Reader Integer
forall a. Integral a => Reader a
T.decimal Reader Integer -> (Text -> Text) -> Reader Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char -> Bool) -> Text -> Text
T.filter Char -> Bool
isDigit)) Text
txt