{-# 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
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