jeanclaude
/
MIAnex_HS
1
0
Fork 0
Code Issues 13 Pull Requests Releases Wiki Activity

NEW: use own import formatter and importer 

Do not rely on exiftool anymore
This commit is contained in:
Jean-Claude 2022-04-14 10:22:05 +02:00
parent 04daffe440
commit a8d2b46415
Signed by: jeanclaude
GPG Key ID: 8A300F57CBB9F63E
6 changed files with 107 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
Command.hs
View File

@ -8,7 +8,7 @@ module Command (
mainParser
) where
import Options.Applicative (CommandFields, Mod, Parser, ParserInfo, helper, header, help, info, fullDesc, progDesc, hsubparser, command, long, switch, short, str, argument, value, strOption, metavar, many)
import Options.Applicative (CommandFields, Mod, Parser, ParserInfo, helper, header, help, info, fullDesc, progDesc, hsubparser, command, long, switch, short, str, argument, strOption, metavar, many, optional)
import qualified Git as Git
import Helper (Path)
@ -31,7 +31,7 @@ data Command
--- Import
data ImportImagesOptions = ImportImagesOptions
{ importImagesIdentifier :: String
{ importImagesIdentifier :: Maybe String
, importImagesCombine :: Bool
, importImagesCurrentBranch :: Bool
} deriving (Eq, Show)
@ -58,17 +58,20 @@ importParser :: Parser Command
importParser =
Import <$>
( ImportImages
<$> many ( argument str
( metavar "IMAGES"
<> help "Paths to images to import"
))
<$> many
( argument str
( metavar "IMAGES"
<> help "Paths to images to import"
)
)
<*> ( ImportImagesOptions
<$> strOption
( long "identifier"
<> short 'i'
<> metavar "IDENTIFIER"
<> help "Name to identify current import"
<> value ""
<$> optional
( strOption
( long "identifier"
<> short 'i'
<> metavar "IDENTIFIER"
<> help "Name to identify current import"
)
)
<*> switch
( long "combine"

86
Command/Import.hs
View File

@ -6,12 +6,17 @@ module Command.Import (
import Command (ImportOption(ImportImages), ImportImagesOptions(importImagesCurrentBranch, importImagesIdentifier))
import qualified Config as Conf
import Config (Schema)
import qualified Git as Git
import Helper (allFilesExist, runProcess, getImageDate, unifyName)
import Helper (allFilesExist, runProcess, getImageDateTime, getFormattedImageDateTime, unifyName, Path)
import Data.Text (pack, unpack, replace)
import System.Process (cwd, proc, createProcess) -- TODO move fully to helper
import Prelude hiding (tail)
import Control.Monad (forM_)
import Data.Text (Text, empty, toUpper, toLower, pack, unpack, replace, tail)
import Data.Time (UTCTime, defaultTimeLocale, formatTime)
import System.Directory (doesFileExist, createDirectoryIfMissing, copyFile)
import System.FilePath.Posix (takeExtension, takeDirectory, (</>))
import System.Process (cwd, proc, createProcess) -- TODO move fully to helper
runImport :: ImportOption -> IO ()
@ -21,8 +26,9 @@ runImport (ImportImages [] _) = do
-- TODO show help
runImport (ImportImages paths@(firstPath:_) opts) = do
-- TODO Check that repo is ready to be imported to
-- TODO Make paths absolute
-- Check if all files exists, else abort
-- Not race-condition safe
@ -42,11 +48,10 @@ runImport (ImportImages paths@(firstPath:_) opts) = do
initialCommit <- Conf.initialCommit
-- TODO: handle case when not date available
date <- getImageDate firstPath
let branchName = if null (importImagesIdentifier opts) then
date
else
date ++ "-" ++ (importImagesIdentifier opts)
date <- getFormattedImageDateTime firstPath "%Y%m%d"
let branchName = case (importImagesIdentifier opts) of
Just i -> date ++ "-" ++ i
Nothing -> date
branches <- Git.getBranches
let uniqueBranchName = unifyName branchName branches
@ -58,22 +63,17 @@ runImport (ImportImages paths@(firstPath:_) opts) = do
archivePath <- Conf.archivePath
-- Determine naming structure
structure <- if null (importImagesIdentifier opts) then do
structure <- Conf.structN
return structure
else do
s <- Conf.structNI
let structure = unpack $ replace (pack "IDENTIFIER") (pack (importImagesIdentifier opts)) (pack s)
return structure
schema <- Conf.structSchema
-- Copy images to right place
forM_ paths $ \path -> do
putStrLn $ "Importing " ++ path
out <- runProcess $ createProcess(proc "exiftool" ["-o", ".", "-FileName<CreateDate", "-d", structure, "-r", path]){ cwd = Just archivePath }
putStrLn out
return ()
relSchema <- formatSchema schema path (importImagesIdentifier opts)
let absSchema = archivePath </> relSchema
copyImg absSchema path
-- Add images to git annex
out <- runProcess $ createProcess(proc "git-annex" ["add", "."]){ cwd = Just archivePath }
@ -83,3 +83,49 @@ runImport (ImportImages paths@(firstPath:_) opts) = do
-- Verify and cleanup
return ()
formatSchema :: Schema -> Path -> Maybe String -> IO String
formatSchema rawSchema path identifier =
-- Replaces everything except the count
do
-- todo: deal with images w/o metadata
dateTime :: UTCTime <- getImageDateTime path
let ext :: String = takeExtension path
let replDateTime = (\a -> pack $ formatTime defaultTimeLocale (unpack a) dateTime)
let replIdent = case identifier of
Just i -> replace (pack "*i") (pack ("-" ++ i))
Nothing -> replace (pack "*i") empty
let replExtSmall | ext == "" = replace (pack "*e") empty
| otherwise = replace (pack "*e") (toLower (tail (pack ext)))
let replExtLarge | ext == "" = replace (pack "*E") empty
| otherwise = replace (pack "*E") (toUpper (tail (pack ext)))
let a :: Text = (replDateTime . replIdent . replExtSmall . replExtLarge) (pack rawSchema)
return $ unpack a
formatPathSchemaCount :: Path -> Int -> Path
formatPathSchemaCount p 0 = unpack $ replace (pack "*c") (empty) (pack p)
formatPathSchemaCount p c = unpack $ replace (pack "*c") (pack ("-" ++ (show c))) (pack p)
copyImg :: Schema -> Path -> IO ()
copyImg schema src = do
putStrLn $ "Copying " ++ src ++ " according to " ++ schema
aux 0
where
aux c = do
let finalPath = formatPathSchemaCount schema c
exists <- doesFileExist finalPath
case exists of
True -> aux (c + 1)
False -> do
putStrLn $ "Copy imgage to " ++ finalPath
createDirectoryIfMissing True $ takeDirectory finalPath
copyFile src finalPath
putStrLn "Copy successfuly"

13
Config.hs
View File

@ -4,14 +4,16 @@ module Config (
mainBranch,
importBranch,
initialCommit,
structN,
structNI
structSchema,
Schema
) where
import Data.Ini (readIniFile, lookupValue)
import Data.Text (pack, unpack)
import System.Directory (getXdgDirectory, XdgDirectory( XdgConfig ), doesFileExist)
type Schema = String
getOption :: String -> String -> IO String
getOption group option = do
confFile <- getXdgDirectory XdgConfig "mia/config.ini"
@ -43,8 +45,5 @@ importBranch = getOption "GENERAL" "importBranch"
initialCommit :: IO String
initialCommit = getOption "GENERAL" "initialCommit"
structN :: IO String
structN = getOption "STRUCTURE" "normal"
structNI :: IO String
structNI = getOption "STRUCTURE" "normalIdentifier"
structSchema :: IO Schema
structSchema = getOption "SCHEMA" "schema"

24
Helper.hs
View File

@ -5,7 +5,8 @@ module Helper (
trim,
allFilesExist,
runProcess,
getImageDate,
getImageDateTime,
getFormattedImageDateTime,
unifyName
) where
@ -21,10 +22,12 @@ import System.IO (hGetContents, Handle)
type Path = String
-- Remove leading and trailing spaces
trim :: String -> String
trim = dropWhileEnd isSpace . dropWhile isSpace
-- Check if all files in the given list exists
-- https://stackoverflow.com/questions/3982491/determine-if-a-list-of-files-exist-in-haskell
allFilesExist :: [Path] -> IO Bool
@ -32,6 +35,7 @@ allFilesExist files = do
bools <- mapM doesFileExist files
return $ foldr (&&) True bools
-- Execute given createProcess
runProcess :: IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO String
runProcess process = do
@ -43,16 +47,22 @@ runProcess process = do
ExitFailure _ -> return []
Nothing -> return []
getImageDate :: Path -> IO String
getImageDate path = do
getImageDateTime :: Path -> IO UTCTime
getImageDateTime path = do
archivePath <- Conf.archivePath
-- TODO Error Handling
out <- runProcess $ createProcess(proc "exiftool" ["-short3", "-dateFormat", "%Y:%m:%d", "-EXIF:CreateDate", path]){ cwd = Just archivePath, std_out = CreatePipe }
out <- runProcess $ createProcess(proc "exiftool" ["-short3", "-dateFormat", "%Y:%m:%d %H:%M:%S", "-EXIF:CreateDate", path]){ cwd = Just archivePath, std_out = CreatePipe }
let imgDate :: UTCTime = parseTimeOrError True defaultTimeLocale "%Y:%m:%d" (trim out) :: UTCTime
let imgDateStr :: String = formatTime defaultTimeLocale "%y%m%d" imgDate
let dateTime :: UTCTime = parseTimeOrError True defaultTimeLocale "%0Y:%m:%d %H:%M:%S" (trim out)
return dateTime
return imgDateStr
getFormattedImageDateTime :: Path -> String -> IO String
getFormattedImageDateTime path format = do
dateTime :: UTCTime <- getImageDateTime path
let dateTimeString :: String = formatTime defaultTimeLocale format dateTime
return dateTimeString
showZeroPad :: Int -> String

1
MIAnex.cabal
View File

@ -51,6 +51,7 @@ executable mia
base,
process,
directory,
filepath,
optparse-applicative,
text,
time,

5
mia.ini_example
View File

@ -4,6 +4,5 @@ mainBranch = main
importBranch = import/
initialCommit = a29e769623a6b4a1ad2f9e6f73dc4bf4b6640f06
[STRUCTURE]
normal = "%Y/%y%m%d/%y%m%d_%H%M%S%%-c.%%le"
normalIdentifier = "%Y/%y%m%d-IDENTIFIER/%y%m%d_%H%M%S%%-c.%%le"
[SCHEMA]
schema = %Y/%y%m%d*i/%y%m%d_%H%M%S*c.*e