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

module Hledger.Flow.Common where

import Control.Concurrent.STM
import Control.Exception (IOException, try)
import qualified Control.Foldl as Fold
import Data.Char (isDigit)
import Data.Either
import Data.Function (on)
import qualified Data.List as List (groupBy, null, sortBy)
import Data.Maybe (mapMaybe)
import qualified Data.Map.Strict as Map
import Data.Ord (comparing)
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 Hledger.Flow.BaseDir (relativeToBase, turtleBaseDir)
import Hledger.Flow.Logging
import Hledger.Flow.PathHelpers (AbsFile, TurtlePath, fromTurtleAbsFile, pathToTurtle)
import Hledger.Flow.Types
import Path (absfile, relfile)
import qualified Path.IO as Path
import Turtle ((%), (<.>), (</>))
import qualified Turtle
import Prelude hiding (putStrLn, readFile, writeFile)

hledgerPathFromOption :: Maybe TurtlePath -> IO AbsFile
hledgerPathFromOption :: Maybe String -> IO AbsFile
hledgerPathFromOption Maybe String
pathOption = do
  case Maybe String
pathOption of
    Just String
h -> do
      AbsFile
hlAbs <- String -> IO AbsFile
forall (m :: * -> *). MonadThrow m => String -> m AbsFile
fromTurtleAbsFile String
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AbsFile
hlAbs
        else do
          let msg :: Text
msg = Format Text (String -> Text) -> String -> Text
forall r. Format Text r -> r
Turtle.format (Format (String -> Text) (String -> Text)
"Unable to find hledger at " Format (String -> Text) (String -> Text)
-> Format Text (String -> Text) -> Format Text (String -> Text)
forall b c a. Format b c -> Format a b -> Format a c
% Format Text (String -> Text)
forall r. Format r (String -> r)
Turtle.fp) String
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 String
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 a. a -> IO a
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 :: String -> IO Text
hledgerVersionFromPath String
hlp = ([Line] -> Text) -> IO [Line] -> IO Text
forall a b. (a -> b) -> IO a -> IO b
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 (String -> Text) -> String -> Text
forall r. Format Text r -> r
Turtle.format Format Text (String -> Text)
forall r. Format r (String -> r)
Turtle.fp String
hlp) [Text
"--version"] Shell Line
forall a. Shell a
forall (f :: * -> *) a. Alternative f => f a
Turtle.empty)

hledgerInfoFromPath :: Maybe TurtlePath -> IO HledgerInfo
hledgerInfoFromPath :: Maybe String -> IO HledgerInfo
hledgerInfoFromPath Maybe String
pathOption = do
  AbsFile
hlp <- Maybe String -> IO AbsFile
hledgerPathFromOption Maybe String
pathOption
  Text
hlv <- String -> IO Text
hledgerVersionFromPath (String -> IO Text) -> String -> IO Text
forall a b. (a -> b) -> a -> b
$ AbsFile -> String
forall b t. Path b t -> String
pathToTurtle AbsFile
hlp
  HledgerInfo -> IO HledgerInfo
forall a. a -> IO a
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 HasCallStack => Text -> Text -> Int
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 :: forall a. 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' :: forall a. Int -> (Text -> IO ()) -> Text -> a -> IO a
errExit' Int
exitStatus Text -> IO ()
logFun Text
errorMessage a
dummyReturnValue = do
  Text -> IO ()
logFun Text
errorMessage
  POSIXTime -> IO ()
forall (io :: * -> *). MonadIO io => POSIXTime -> io ()
Turtle.sleep POSIXTime
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 a. 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.s Format (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.s Format 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] ->
  T.Text ->
  [T.Text] ->
  (TChan LogMessage -> T.Text -> IO ()) ->
  (TChan LogMessage -> T.Text -> IO ()) ->
  IO FullOutput ->
  IO FullTimedOutput
logTimedAction :: forall o.
HasVerbosity o =>
o
-> TChan LogMessage
-> Text
-> [Text]
-> Text
-> [Text]
-> (TChan LogMessage -> Text -> IO ())
-> (TChan LogMessage -> Text -> IO ())
-> IO FullOutput
-> IO FullTimedOutput
logTimedAction o
opts TChan LogMessage
ch Text
cmdLabel [Text]
extraCmdLabels Text
cmd [Text]
args 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
  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
forall r. Format Text r -> r
Turtle.format (Format (Text -> Text) (Text -> Text -> Text)
forall r. Format r (Text -> r)
Turtle.s Format (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
T.intercalate Text
" " [Text]
args)
  if ([Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null [Text]
extraCmdLabels) then () -> IO ()
forall a. a -> IO a
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), POSIXTime
diff) <- IO FullOutput -> IO FullTimedOutput
forall (io :: * -> *) a. MonadIO io => io a -> io (a, POSIXTime)
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.s Format (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.s Format (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.s Format 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) (POSIXTime -> Text
forall a text. (Show a, IsString text) => a -> text
Turtle.repr POSIXTime
diff)
  FullTimedOutput -> IO FullTimedOutput
forall a. a -> IO a
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 :: forall o.
(HasSequential o, HasVerbosity o) =>
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' :: 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 [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), POSIXTime
_) <- o
-> TChan LogMessage
-> Text
-> [Text]
-> Text
-> [Text]
-> (TChan LogMessage -> Text -> IO ())
-> (TChan LogMessage -> Text -> IO ())
-> IO FullOutput
-> IO FullTimedOutput
forall o.
HasVerbosity o =>
o
-> TChan LogMessage
-> Text
-> [Text]
-> Text
-> [Text]
-> (TChan LogMessage -> Text -> IO ())
-> (TChan LogMessage -> Text -> IO ())
-> IO FullOutput
-> IO FullTimedOutput
logTimedAction o
opts TChan LogMessage
ch Text
cmdLabel [Text]
extraCmdLabels Text
cmd [Text]
args 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.s Format (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.s
                  Format
  (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.s
                  Format
  (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.d
                  Format
  (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.s
                  Format
  (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.s
                  Format
  (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.s
                  Format 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 a. a -> IO a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode
ec, Text
T.empty, Text
T.empty)

parAwareProc :: (HasSequential o) => o -> ProcFun
parAwareProc :: forall o. HasSequential o => 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 :: forall o a.
(HasSequential o, HasBatchSize o) =>
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)
forall (m :: * -> *) a. Monad m => [m a] -> m [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 :: forall a. Int -> [a] -> [IO a] -> IO [a]
parBatchedActions Int
_ [a]
done [] = [a] -> IO [a]
forall a. 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 a. a -> Shell a
forall (m :: * -> *) a. Monad m => a -> m a
return Line
ln
    Left Line
ln -> do
      (IO () -> Shell ()
forall a. IO a -> Shell a
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 a. Shell a
forall (f :: * -> *) a. Alternative f => f a
Turtle.empty

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

needsRegeneration :: TurtlePath -> TurtlePath -> IO Bool
needsRegeneration :: String -> String -> IO Bool
needsRegeneration String
src String
target = do
  Bool
targetExists <- String -> IO Bool
forall (io :: * -> *). MonadIO io => String -> io Bool
Turtle.testfile String
target
  if Bool -> Bool
not Bool
targetExists
    then Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    else do
      -- Use try to handle race conditions where files may be modified/deleted
      -- between existence check and stat. Treat any IO error as "needs regeneration".
      Either IOException Bool
result <- IO Bool -> IO (Either IOException Bool)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO Bool -> IO (Either IOException Bool))
-> IO Bool -> IO (Either IOException Bool)
forall a b. (a -> b) -> a -> b
$ do
        FileStatus
srcStat <- String -> IO FileStatus
forall (io :: * -> *). MonadIO io => String -> io FileStatus
Turtle.stat String
src
        FileStatus
targetStat <- String -> IO FileStatus
forall (io :: * -> *). MonadIO io => String -> io FileStatus
Turtle.stat String
target
        let srcMtime :: POSIXTime
srcMtime = FileStatus -> POSIXTime
Turtle.modificationTime FileStatus
srcStat
        let targetMtime :: POSIXTime
targetMtime = FileStatus -> POSIXTime
Turtle.modificationTime FileStatus
targetStat
        Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (POSIXTime
srcMtime POSIXTime -> POSIXTime -> Bool
forall a. Ord a => a -> a -> Bool
> POSIXTime
targetMtime)
      case Either IOException Bool
result of
        Right Bool
needsRegen -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
needsRegen
        Left (IOException
_ :: IOException) -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

groupPairs' :: (Eq a, Ord a) => [(a, b)] -> [(a, [b])]
groupPairs' :: forall a b. (Eq a, Ord a) => [(a, b)] -> [(a, [b])]
groupPairs' =
  ([(a, b)] -> Maybe (a, [b])) -> [[(a, b)]] -> [(a, [b])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
    ( \[(a, b)]
ll -> case [(a, b)]
ll of
        [] -> Maybe (a, [b])
forall a. Maybe a
Nothing
        ((a
k, b
_) : [(a, b)]
_) -> (a, [b]) -> Maybe (a, [b])
forall a. a -> Maybe a
Just (a
k, ((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 :: forall a b. (Eq a, Ord a) => [(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 :: forall a b. (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 :: forall k v. (Ord k, Ord v) => (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 :: String
allYearsFileName = String
"all-years" String -> String -> String
<.> String
"journal"

directivesFile :: (HasBaseDir o) => o -> TurtlePath
directivesFile :: forall o. HasBaseDir o => o -> String
directivesFile o
opts = o -> String
forall o. HasBaseDir o => o -> String
turtleBaseDir o
opts String -> String -> String
</> String
"directives" String -> String -> String
<.> String
"journal"

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

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

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

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

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

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

filterPaths' :: [TurtlePath] -> (TurtlePath -> IO Bool) -> [TurtlePath] -> Turtle.Shell [TurtlePath]
filterPaths' :: [String] -> (String -> IO Bool) -> [String] -> Shell [String]
filterPaths' [String]
acc String -> IO Bool
_ [] = [String] -> Shell [String]
forall a. a -> Shell a
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
acc
filterPaths' [String]
acc String -> IO Bool
filepred (String
file : [String]
files) = do
  Bool
shouldInclude <- IO Bool -> Shell Bool
forall a. IO a -> Shell a
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
$ String -> IO Bool
filepred String
file
  let filtered :: [String]
filtered = if Bool
shouldInclude then String
file String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
acc else [String]
acc
  [String] -> (String -> IO Bool) -> [String] -> Shell [String]
filterPaths' [String]
filtered String -> IO Bool
filepred [String]
files

excludeHiddenFiles :: Turtle.Shell TurtlePath -> Turtle.Shell TurtlePath
excludeHiddenFiles :: Shell String -> Shell String
excludeHiddenFiles Shell String
paths = do
  String
p <- Shell String
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 (String -> Text) -> String -> Text
forall r. Format Text r -> r
Turtle.format Format Text (String -> Text)
forall r. Format r (String -> r)
Turtle.fp (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
Turtle.filename String
p) of
    [] -> [String] -> Shell String
forall (f :: * -> *) a. Foldable f => f a -> Shell a
Turtle.select [String
p]
    [Text]
_ -> [String] -> Shell String
forall (f :: * -> *) a. Foldable f => f a -> Shell a
Turtle.select []

excludeWeirdPaths :: Turtle.Shell TurtlePath -> Turtle.Shell TurtlePath
excludeWeirdPaths :: Shell String -> Shell String
excludeWeirdPaths = Pattern Char -> Shell String -> Shell String
forall a. Pattern a -> Shell String -> Shell String
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
$ String -> Pattern Char
Turtle.noneOf String
"_")

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

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

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

shellToList :: Turtle.Shell a -> Turtle.Shell [a]
shellToList :: forall a. 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 String Text) -> IO [String]
writeFiles IO (Map String Text)
fileMap = do
  Map String Text
m <- IO (Map String Text)
fileMap
  Map String Text -> IO [String]
writeFiles' Map String Text
m

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

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

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

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

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

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

intPath :: Integer -> TurtlePath
intPath :: Integer -> String
intPath = Text -> String
T.unpack (Text -> String) -> (Integer -> Text) -> Integer -> String
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 -> String -> IO [Integer]
includeYears TChan LogMessage
ch String
includeFile = do
  Text
txt <- String -> IO Text
T.readFile String
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Right [Integer]
years -> [Integer] -> IO [Integer]
forall a. a -> IO a
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 String Integer] -> ([String], [Integer])
forall a b. [Either a b] -> ([a], [b])
partitionEithers (Text -> [Either String Integer]
includeYears'' Text
txt) of
  ([String]
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.s Format (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
$ (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack [String]
errors)
    Text -> Either Text [Integer]
forall a b. a -> Either a b
Left Text
msg
  ([String]
_, [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 String Integer]
includeYears'' Text
txt = (Text -> Either String Integer)
-> [Text] -> [Either String Integer]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Either String Integer
extractDigits (Text -> [Text]
T.lines Text
txt)

extractDigits :: T.Text -> Either String Integer
extractDigits :: Text -> Either String Integer
extractDigits Text
txt = ((Integer, Text) -> Integer)
-> Either String (Integer, Text) -> Either String Integer
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer, Text) -> Integer
forall a b. (a, b) -> a
fst (Either String (Integer, Text) -> Either String Integer)
-> Either String (Integer, Text) -> Either String 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