photoname 3.3 → 5.0
raw patch · 49 files changed
+1911/−1367 lines, 49 filesdep +ansi-wl-pprintdep +containersdep +heredocdep −HUnitdep −exifdep −old-localesetup-changedbinary-added
Dependencies added: ansi-wl-pprint, containers, heredoc, hsexif, hslogger, newtype-generics, optparse-applicative, photoname, tasty, tasty-hunit, tasty-quickcheck
Dependencies removed: HUnit, exif, old-locale
Files
- .gitignore +4/−1
- LICENSE +1/−1
- README.md +13/−6
- Setup.hs +0/−2
- TODO.md +0/−8
- changelog.md +98/−50
- doc/dev/notes +0/−41
- hsinstall/share/applications/photoname.desktop +7/−0
- hsinstall/share/icons/hicolor/scalable/apps/photoname.svg +320/−0
- package.yaml +77/−0
- photoname.cabal +114/−70
- src/Photoname/Common.hs +0/−25
- src/Photoname/Date.hs +0/−72
- src/Photoname/DateFormat.hs +0/−34
- src/Photoname/Exif.hs +0/−50
- src/Photoname/Opts.hs +0/−192
- src/Photoname/SerialFormat.hs +0/−69
- src/app/Photoname/Opts.hs +236/−0
- src/app/photoname.hs +60/−0
- src/lib/Photoname/Common.hs +125/−0
- src/lib/Photoname/CopyLink.hs +86/−0
- src/lib/Photoname/Date.hs +139/−0
- src/lib/Photoname/Exif.hs +36/−0
- src/lib/Photoname/Exiv2.hs +54/−0
- src/lib/Photoname/Log.hs +45/−0
- src/photoname.hs +0/−86
- src/tests/Test/Photoname/Date.hs +81/−0
- src/tests/TestLink.hs +340/−0
- src/tests/Util.hs +39/−0
- src/tests/runtests.hs +14/−0
- stack.yaml +6/−3
- stack.yaml.lock +12/−0
- testsuite/TestHelp.hs +0/−36
- testsuite/TestLink.hs +0/−247
- testsuite/Util.hs +0/−42
- testsuite/resources/img_1220.jpg binary
- testsuite/resources/noExif.jpg +0/−1
- testsuite/resources/noSerial.jpg binary
- testsuite/runtests.hs +0/−32
- util/install.hs +0/−295
- util/resources/test.conf +0/−4
- util/resources/test/dateTime.jpg binary
- util/resources/test/dateTimeDigitized.jpg binary
- util/resources/test/dateTimeOriginal.jpg binary
- util/resources/test/foobar-2021-10-04-17-29-49-942.jpg binary
- util/resources/test/noDate.jpg binary
- util/resources/test/noExif.jpg binary
- util/resources/test/notAnImage.txt +1/−0
- util/resources/test/test.conf +3/−0
.gitignore view
@@ -1,5 +1,8 @@ # Vim swap files *.sw? -# stack build artifacts+# Stack uses this directory as scratch space. .stack-work/++# Stack generates the Cabal file from `package.yaml` through hpack.+/*.cabal
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2007-2016, Dino Morelli <dino@ui3.info>+Copyright (c) 2007-2021, Dino Morelli <dino@ui3.info> Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided
README.md view
@@ -13,24 +13,31 @@ photo shoot date information contained within the file's EXIF tags. +## Getting binaries++photoname is available for Linux in AppImage form [from github](https://github.com/dino-/photoname/releases)++ ## Getting source -- Download the cabalized source package [from Hackage](http://hackage.haskell.org/package/photoname)-- epub-tools is available for Arch Linux [from the AUR](https://aur.archlinux.org/packages/photoname/) - Get the source with git: `$ git clone https://github.com/dino-/photoname.git`-- If you're just looking, [browse the source](https://github.com/dino-/photoname)+- Download the cabalized source package [from Hackage](http://hackage.haskell.org/package/photoname) And once you have it, building the usual way: $ stack build+ $ stack run $ stack test $ stack clean +If you're just looking, [browse the source](https://github.com/dino-/photoname) -## Installing -Build and install with the included `install.hs` script:- `# ./util/install.hs --prefix=/some/dir`+## Building for release++For Linux builds, I recommend using the excellent+[hsinstall](https://github.com/dino-/hsinstall) utility which will simplify+creation of an [AppImage](https://appimage.org/) executable. ## Contact
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
− TODO.md
@@ -1,8 +0,0 @@-- Allow user to specify permissions for newly-created dirs and- files. Bonus points for parsing the octal codes everyone knows- and loves.-- Add a `--force` switch to disregard existing links.-- Deal gracefully with unknown dates. This means not just putting- pictures into the 0000/0000-00-00 directory, but making sure that- the `_###` serial number part is incremented from the highest one- in there.
changelog.md view
@@ -1,92 +1,140 @@+5.0 (2020-11-26)++ * Updated Stackage resolver+ * Moved copyright date up to 2021+ * Moved Photoname.Opts module into the app src tree+ * Removed the useless tests for program help+ * Switched to optparse-applicative for arg parsing+ * cabalized projects no longer need a Setup.hs+ * Added the -a|--artist option+ * Changed lookup order of EXIF date tags+ * Added ability to parse the filename for date and time+ * Fixed broken smoke tests+ * Switched test suite to use Tasty+ * Attempt to copy if the hard link fails+ * Added new --copy switch and behavior+ * Moved AppImage desktop and icon into hsinstall tree+ * Added new --prefix switch and behavior+ * Output is now handled via hslogger+ * Now using newtype wrappers nearly everywhere+++4.1 (2019-03-30)++ * Removed some AppImage desktop file categories+++4.0 (2019-03-26)++ * All imports are now explicit+ * Added tests for several missing cases+ * Removed --old-style switch and behavior+ * Removed unnecessary Control.Applicative imports+ * Switched EXIF library from from exif to hsexif+ * Removed unused old-locale dep+ * Removed License and Author comments from source code+ * Moved copyright up to 2019+ * Redesign source code directory layout+ * Removed outdated TODO.md and doc/dev/notes files+ * Updated build to use hpack and hsinstall+++3.4 (2018-10-09)++ * Added a new --version switch+ * Now supporting building to an AppImage+ * Moved copyright up to 2018++ 3.3 (2017-12-27) - * A variety of build-related fixes were made+ * A variety of build-related fixes were made 3.2 (2016-10-02) - * Switched the build from cabal to stack- * Added hsinstall installation script- * Update copyright year- * Various updates to the cabal file+ * Switched the build from cabal to stack+ * Added hsinstall installation script+ * Update copyright year+ * Various updates to the cabal file 3.1 (2015-06-28) - * Removed ambiguous import of `System.Locale.defaultTimeLocale`- * Updated to use `Data.Version` to fish the version out of cabal info- * Replaced deprecated ErrorT with ExceptT- * Added pragma for Control.Applicative import- * Updated README and cabal file with current info- * Moved copyright year up to 2015+ * Removed ambiguous import of `System.Locale.defaultTimeLocale`+ * Updated to use `Data.Version` to fish the version out of cabal info+ * Replaced deprecated ErrorT with ExceptT+ * Added pragma for Control.Applicative import+ * Updated README and cabal file with current info+ * Moved copyright year up to 2015 3.0.1 (2012-11-01) - * Updated test suite to build cleanly (without warnings) and- run against modern cabal versions- * Updated cabal file to modern cabal standards. Unit testing is- now cabal-driven and we now fully support cabal sdist.- * Fixed a problem where try is no longer available. Now importing- Control.Exception to bring it into scope.- * Adjusted usage to explain a change in how we find the EXIF- date stamps- * Moved copyright year up to 2012+ * Updated test suite to build cleanly (without warnings) and+ run against modern cabal versions+ * Updated cabal file to modern cabal standards. Unit testing is+ now cabal-driven and we now fully support cabal sdist.+ * Fixed a problem where try is no longer available. Now importing+ Control.Exception to bring it into scope.+ * Adjusted usage to explain a change in how we find the EXIF+ date stamps+ * Moved copyright year up to 2012 3.0.0 (2011-05-08) - * New naming scheme that uses date/time only, no serial. This- is a BIG change but the old naming scheme is still available.- * Parent directory is now a switch- * Subdirectory path creation of year and day can be suppressed- * User can specify an arbitrary suffix string for the new names- * User can now put switches into a config file+ * New naming scheme that uses date/time only, no serial. This+ is a BIG change but the old naming scheme is still available.+ * Parent directory is now a switch+ * Subdirectory path creation of year and day can be suppressed+ * User can specify an arbitrary suffix string for the new names+ * User can now put switches into a config file 2.3.0 (2010-01-25) - * Problem fixed that had recently come up with the Exif- library. Specifically, files with no EXIF data were causing- an IO error to be thrown and processing to halt. (thanks to- Josh Hoyt)- * Other minor updates to things like copyright info and version- number+ * Problem fixed that had recently come up with the Exif+ library. Specifically, files with no EXIF data were causing+ an IO error to be thrown and processing to halt. (thanks to+ Josh Hoyt)+ * Other minor updates to things like copyright info and version+ number 2.2 (2009-06-07) - * No changes in how the software behaves- * Updated build-depends to be explicit about base version- requirement- * Minor update to BSD3 copyright notices to bring them up to 2009- * Debian binary package of v2.2 available+ * No changes in how the software behaves+ * Updated build-depends to be explicit about base version+ requirement+ * Minor update to BSD3 copyright notices to bring them up to 2009+ * Debian binary package of v2.2 available 2.1 (2008-10-11) - * More big changes to the transformers used. No longer using- WriterT. Now using ErrorT for error handling.- * Changed to record-style data for the arg parsing. + * More big changes to the transformers used. No longer using+ WriterT. Now using ErrorT for error handling.+ * Changed to record-style data for the arg parsing. 2.0 (2008-03-05) - * Upgraded to build under GHC 6.8.2- * Major internal changes. Now using ReaderT and WriterT- * Changed version numbering scheme to be more conventional. Recent- versions of cabal were not amused with the strange version- string.- * This project now added to HackageDB + * Upgraded to build under GHC 6.8.2+ * Major internal changes. Now using ReaderT and WriterT+ * Changed version numbering scheme to be more conventional. Recent+ versions of cabal were not amused with the strange version+ string.+ * This project now added to HackageDB 003 (2007-09-13) - * Repairs for a build problem with GHC > 6.6 specifically related- to depending on FilePath instead of filepath and now requiring- import of Data.Time.Format+ * Repairs for a build problem with GHC > 6.6 specifically related+ to depending on FilePath instead of filepath and now requiring+ import of Data.Time.Format 002 (2007-04-28) - * Initial release+ * Initial release
− doc/dev/notes
@@ -1,41 +0,0 @@-------- To change the app version:- - Edit photoname.cabal- - Edit src/Photoname/Opts.hs, usageText near the bottom of footer-- I'd like to make a script in util/ to automate this.- After such a script has been made, may want to put developer notes on using it in doc/dev/<somefile>-------------File naming format:--yyyymmdd_[oth_]nnn[-e[n]].jpg-yyyymmdd-hhmmss[_oth][_ss].jpg--date: year month day-time: hour minute second-oth: could be photographer: 2 or 3 character initials-ss: edited or sized, optional number for more than one- _sp _ep : sized/edited for printing- _sd1920x1080 _ed : sized/edited for desktop- _sw _ew : sized/edited for web---These files are arranged into a dir structure--top-level/- 0000/- 0000-00-00/- 00000000_001.jpg -- Unknown pictures- 00000000_002.jpg- 2006/- 2006-10-13/- 20061013_431.jpg- 20061013_509.jpg- 2007/- 2007-01-30/- 20070130_002.jpg- 20070130_119-ew.jpg- 2007-04-19/- 20070419_bmd_323.jpg- 20070419_bmd_325-sd.jpg
@@ -0,0 +1,7 @@+[Desktop Entry]+Name=photoname+Exec=photoname+Icon=photoname+Type=Application+Categories=Graphics;Photography;ConsoleOnly;+Terminal=true
@@ -0,0 +1,320 @@+<?xml version="1.0" encoding="UTF-8" standalone="no"?>+<!-- Created with Inkscape (http://www.inkscape.org/) -->++<svg+ xmlns:dc="http://purl.org/dc/elements/1.1/"+ xmlns:cc="http://creativecommons.org/ns#"+ xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"+ xmlns:svg="http://www.w3.org/2000/svg"+ xmlns="http://www.w3.org/2000/svg"+ xmlns:xlink="http://www.w3.org/1999/xlink"+ xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"+ xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"+ width="864"+ height="864"+ viewBox="0 0 228.59999 228.60001"+ version="1.1"+ id="svg8"+ inkscape:version="0.92.2 2405546, 2018-03-11"+ sodipodi:docname="unix-terminal.svg"+ inkscape:export-filename="/home/dino/doc/artwork/icons/unix-terminal/unix-terminal_32x32.png"+ inkscape:export-xdpi="3.5599999"+ inkscape:export-ydpi="3.5599999">+ <defs+ id="defs2" />+ <sodipodi:namedview+ id="base"+ pagecolor="#ffffff"+ bordercolor="#666666"+ borderopacity="1.0"+ inkscape:pageopacity="0.0"+ inkscape:pageshadow="2"+ inkscape:zoom="0.99109527"+ inkscape:cx="351.28122"+ inkscape:cy="432"+ inkscape:document-units="mm"+ inkscape:current-layer="layer4"+ showgrid="false"+ units="px"+ inkscape:snap-bbox="true"+ inkscape:bbox-paths="true"+ inkscape:snap-page="true"+ inkscape:window-width="3438"+ inkscape:window-height="1412"+ inkscape:window-x="0"+ inkscape:window-y="26"+ inkscape:window-maximized="0" />+ <metadata+ id="metadata5">+ <rdf:RDF>+ <cc:Work+ rdf:about="">+ <dc:format>image/svg+xml</dc:format>+ <dc:type+ rdf:resource="http://purl.org/dc/dcmitype/StillImage" />+ <dc:title></dc:title>+ </cc:Work>+ </rdf:RDF>+ </metadata>+ <g+ inkscape:groupmode="layer"+ id="layer2"+ inkscape:label="window border"+ sodipodi:insensitive="true">+ <rect+ style="color:#000000;clip-rule:nonzero;display:inline;overflow:visible;visibility:visible;opacity:1;isolation:auto;mix-blend-mode:normal;color-interpolation:sRGB;color-interpolation-filters:linearRGB;solid-color:#000000;solid-opacity:1;fill:#b0b0b0;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:0.52413958;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1;color-rendering:auto;image-rendering:auto;shape-rendering:auto;text-rendering:auto;enable-background:accumulate"+ id="rect4668"+ width="198.33279"+ height="197.51245"+ x="14.704174"+ y="15.072358" />+ </g>+ <g+ inkscape:groupmode="layer"+ id="layer3"+ inkscape:label="window contents">+ <rect+ y="35.809155"+ x="35.527096"+ height="156.03886"+ width="156.68694"+ id="rect4689"+ style="color:#000000;clip-rule:nonzero;display:inline;overflow:visible;visibility:visible;opacity:1;isolation:auto;mix-blend-mode:normal;color-interpolation:sRGB;color-interpolation-filters:linearRGB;solid-color:#000000;solid-opacity:1;fill:#000000;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:0.41408095;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1;color-rendering:auto;image-rendering:auto;shape-rendering:auto;text-rendering:auto;enable-background:accumulate" />+ </g>+ <g+ inkscape:groupmode="layer"+ id="layer4"+ inkscape:label="terminal text">+ <g+ id="g4728"+ transform="matrix(1.2556933,0,0,1.2556933,-4.7488909,-11.718906)">+ <rect+ y="50.008144"+ x="78.415092"+ height="57.930435"+ width="32.035267"+ id="rect4702"+ style="color:#000000;clip-rule:nonzero;display:inline;overflow:visible;visibility:visible;opacity:1;isolation:auto;mix-blend-mode:normal;color-interpolation:sRGB;color-interpolation-filters:linearRGB;solid-color:#000000;solid-opacity:1;fill:#ffffff;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:0.48090959;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1;color-rendering:auto;image-rendering:auto;shape-rendering:auto;text-rendering:auto;enable-background:accumulate" />+ <path+ d="m 55.628147,91.343219 q 2.413,0 4.021667,-0.335137 1.675696,-0.402167 2.614083,-1.072447 0.93839,-0.737303 1.340556,-1.675693 0.402167,-1.005417 0.402167,-2.14489 0,-1.675693 -0.804333,-2.815167 -0.804334,-1.2065 -2.211917,-2.07786 -1.340556,-0.93839 -3.083277,-1.608666 -1.742723,-0.737307 -3.619502,-1.407584 -1.80975,-0.670279 -3.6195,-1.474613 -1.742721,-0.804333 -3.150304,-1.943803 -1.340556,-1.2065 -2.211917,-2.815167 -0.871363,-1.675696 -0.871363,-4.088696 0,-4.289777 2.547057,-6.970887 2.547056,-2.681113 7.373056,-3.418419 v -6.903861 h 4.960057 v 6.702777 q 2.68111,0.134057 4.893026,0.67028 2.278944,0.469193 3.6195,1.005416 l -1.139473,4.691944 q -1.407583,-0.536221 -3.55247,-1.072444 -2.14489,-0.60325 -5.42925,-0.60325 -3.619503,0 -5.563306,1.340557 -1.87678,1.340554 -1.87678,3.88761 0,1.407583 0.536223,2.345973 0.60325,0.938387 1.675694,1.675694 1.072446,0.737306 2.480029,1.340556 1.47461,0.60325 3.28436,1.273527 2.278947,0.87136 4.423834,1.876777 2.144889,0.93839 3.753556,2.278946 1.608667,1.340554 2.547056,3.217333 1.005417,1.876777 1.005417,4.49086 0,3.95464 -2.614083,6.70278 -2.614083,2.748137 -8.043333,3.418416 v 7.708189 H 54.35462 v -7.507105 q -4.22275,-0.134057 -6.836833,-0.93839 -2.614083,-0.804333 -3.887613,-1.54164 l 1.474613,-4.624916 q 1.80975,0.871363 4.289777,1.675696 2.480027,0.737304 6.233583,0.737304 z"+ style="font-style:normal;font-variant:normal;font-weight:normal;font-stretch:normal;font-size:medium;line-height:125%;font-family:'Ubuntu Mono';-inkscape-font-specification:'Ubuntu Mono, Normal';font-variant-ligatures:normal;font-variant-caps:normal;font-variant-numeric:normal;font-feature-settings:normal;text-align:start;letter-spacing:0px;word-spacing:0px;writing-mode:lr-tb;text-anchor:start;fill:#ffffff;fill-opacity:1;stroke:none;stroke-width:0.26458332px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"+ id="path4722"+ inkscape:connector-curvature="0" />+ </g>+ </g>+ <g+ inkscape:label="tracing image"+ inkscape:groupmode="layer"+ id="layer1"+ transform="translate(0,-68.399983)"+ style="display:none;opacity:0.5"+ sodipodi:insensitive="true">+ <image+ y="68.399986"+ x="0"+ id="image4664"+ xlink:href="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAIAAAACACAYAAADDPmHLAAAgAElEQVR4nO19eZCcxZXnL/P76ujq+6m4hJNCJEFhChxHsMNj42DG3ATM2YGZnba9PDnvDjtmZjfAc3pnA3tjxxICPsDfADmyOHe/OzsQe+s+sFc0iAD9lgMDYjhBBGAiQEQsio1VdVV31f5ts/8viyvv6OrFYJM2O96Iqu+r48XuZ7+d7Lly8z+gWNwDI7BMTgGx+AYHINjcAyOwW8WsKNYJtffmf5+tOr75wik/0v9nfR3991AYFAEYc4nSH1CKAYw+DHEMysEQXAKIAYjUh5zPEcGREsQd4QGAiv7UP3H9p9+5fMWKd9eHGm+uVWvLqrXqSsYYiAgAA2MA+YwAR7DMiAhGBgYFxtwqdhgEhZ5CkeygmhFUOkgBAPeWEIYMQqg5VgMpjf8PgYvAgMPOSASQBgy9j+gCQCZwYXUw7ThVKSnxikLSuhD+cMBAKDaXOCi5Sk3utnjDF0ZjsvdrqzL7dmZra//NJL991+681b+AcwCiPRHoFdCzJuAR5KXQ43wKoChD3z447+9bv3Ga4dHRs89acWy41avWonFi47H6EgTxy0YO4Kq+fvNg/PAEJqem8erBX+GFvfuwb//+8cnDh7//zI4d3/7v//WOnwFoA+hCSQjDCH3DfBjAFfUVAEOX+Xn7F+rPf+vY/Wbt27eVnnL4Op6w6CY3G0JyMpDNS6rczSAuRSr93y8v6j4zvpgye8TsLR7fRefik+25EHbtlZeYra32q18dyevfjH7U9j17PP3vXTh3/y1/fc9X+ehmIEIxH6lgb9MoDBOQRQAzD62c99+/s9OO23ddee85V9UN65baxPGACIJiBgQUolYkkqMMwZIaZrMrCgkUnKacVONEr8gJYIBIAgYpNQP+CSAYMc56RGrIGQQRQFqMc6bT2awJaGqQpZApU7MJ06Je46Nf94hxi7/Fm9m2WdXGWE9+twwS6gsP+uC2Tc6BaVcxZcdB9aucv8dPHft7duXPnt2764hf+CsAkgI7u9r6YIPBNiETkVwA0Tl59yvI/+uO/+uP2ySy76vfe8+/xgyQmLEQNox8DUrER3VkJIgpSKIFKqBlo1y+B0SML7jDGwAIAEBBECpnQnEXMY+xx2lDIIAro0GKVVHSyKlay2TMZDuVJLqudLx6foT3MgQHYCUAob/TXLFF9RDUFOX0ulz5YiUEkSk+GRkQQipmYQRihv9UPiEkOh2CFAyzMSAYQ8CBExcdj9M3rg+aI6NvWXnKaWfteX7Xjw4fHu9gHqrA+lwHMkKwAaLzr/ItO/+BHPvF3v3fVe3/rzNM3gHGO6S4w25GIY8WArrGl/hgECW0kAUyqHhRC6FGQ+GEFSKinAwCCk6hjOGEhZe5pppP4iwUkZjUSAlBKcM/2f98g4khJCMjugVXmJIDYMKYR0nsGWJaU2+zhkzbwFAtQdSM6FqhIhJMRup8oKAw0gGYgyQTEslVRfTooEEWeZkjCEImB5IEnEs0Y0ByRmqIceq+FcuwfNmyk0cWLnp31I0feeH53eNIjEMvCPtggBDA0IqVq1Zeevn77vjYh/7VqScsXoQOgHYbECIG+C5i2yIGYJAJNYMYZAhagEoYIXFEMgIhrKxvgTKmLQE8YTVmM6RZJDq6VtRCB/h4ookmFZLXKEcdA+pZLibabSSlJiTJUXIAgMAQFDvzC0UxAQAwIWQAglPYQAwMi2gwBUSJVtQEqABwAj9b9CgW0joNop+VTEAKiCdjiQQxwRBErEgxdw8wcVIy3Y7RhSGqNeBNaeejI988PffxBj7L7uefeaKfS/u2avRMuqg+EHwYwBh8NQDHfey6f3vLVe+97NQTFi/CVBfodoUVWRT3ToeIcYwMh6iEQBQDrdYsOlEXQiqxR7pH+GGeOQtVl6akSZ26Pwaaz9gQcQ8/0MoNN0zsd6zW5bJWOju95BtjnBicAYIHGlxLGBZSqMlXZKaVR+QhmWJVl7xzSCoVqrYniorvsswPRMZCWCaS0RIYoixDFDXA9x4uJFeN97Ll19eHzylr/8/J99GH34+CsoYwOj9KoCxf/fZz/35pRdf+I41p67GdAREUYwoirV4Y7ZRQkgcN1YFCHj6mV24567/i5/8ZCv2+vvACpqcmIYRwiqdUdXm/s2zzIrTz7Pm8urLeIydN3jwha57iWx8QBAFGR0ex4qRVOOdt78Tl73sf+1q5ZAzBgYqqrpY5hRvW/3Y4gZQVrTl2Nyy656B3T01N//rUvffEGJI6kQrugbBZgjL6R8y+69F0f++vDH/v6jH7w66IBjZiYCESXiFAARQxByjA4HeGLbdnzxCzfg4R9vxezsLOr1KprNUdRqNQScO86S+jEoZB5i0Bt98wMWrGNyJ4q8HiEirF0Kn08H09DQ6s23U6kN42zv+Jf7DDTfgjE2nY2pGoNvtWrVg++o8xhuHhCmqQuPNv/4f42+/c+fsPbr73BwCmoKaIuV1RJAHc0X/c29/5rhsuOPcdAQUcralYI82V+jmfK6Bpq1MBJ4D9+/gv45s3/GUSElStXYsGCBajV6qhUwh7E3Q6wlVpvGxV+pxQDJV693mdZdfmm+ySozDXl49gNufUSEOI7R6XRweHwcW3/wEC674Pv41Gf+AH/8p59DpVJHq9XpqVMSYWYmQtCs4MJz+3xk8//wLNzy4+d73Q00NC/0DZQwQAmhcfNl7z12/bt3pq1Yux6EZCRHHqkQptTVNaDRqEN02Pv7x+j2HL/fdg5UmrsHTJEtTrdW1BS23x9xJ77lTp6EA/dfmkHRTuLiEBpQYqlQpqtRqazSYWLV6MAwcO+4Gtfvgnbt2/D7Xf8DepDQ2jPzDq+DQYRRZiZDbFq5XKsO23N6Rdf+rvn3n/P//suEgmQiWzRNJAD+qANY+L6rP/AXl1x47qqRhYvQbnct0XUTwDhHJSB84qMfwZb778X69RuwbNky1Go1xHGMOI4hhLBz+YPNxfwOY8z4r3Xw//ZThk/ZIcHLzpr8LISCEQBzHCIIAtVoNo6OjaDabePSRR7B9+zZceeVVkMR7++s5MqYNqiHoY4KVXXh17+Mc/vBfKU5g7I+BZD5FY/tXjFy1evvTEE89Zu+YUtNpCjXpSlq0kQkwS+oyNVfOWmG/HA/fdiw4YNOOGEEwAAnU4H3W63h/iG29PfizrUQDpPVjl5+X2el5WThb+LW1E5ZW3I++nS7XXQ6StwvXrwYGzZswJb778dXbrwRY6MVCKGmStLJ056VWPOm1ViybPk5xy9avBxKhQfIMXTK+GKD+zt85//zVJ6+qUlhBFEWQmliQElISxppD2PHUDnzj5q/j5NWrsWjRIkgp0e12EcdxbgcBmCMB+0h2a9duHSfJ+lxG1bFSncS4a4f3gLaWck8eVCN1uF1JKLFq0CKtXr8Y3bvk6tj3xFEZH6or4Oj+R+MiIprOCUk0+qvvN3zj8fSorPiwFCAM0lS5efvXLFUnS76BXjMDNcwl//p8+DiHDiiScCgB31buMN+mPyuRMjqIB+CZRHPLS+vLheXNJHSZafTZ9WbVU4W02QRuawdygMYo9vtAgCWLFkCIokb/+oLlqLG+7jQDLuoCK5cvxYlLl50NoKlpmckAeUagkQDN5ujI6kXHL0SnG1lkmXbLDjca2LVrF7Zu/RFWrVqF+arWKKIos8dOGknkmtSPINDBtCKV/W6RS1n8Wg7nf3fSm87NmE1l15ZXr4p2uJ/08ndcldrr96Xfp+fomiCIwxVKtVnLTqZPx461Y8++wvseqUN2FmugXOuZ2VdaIYi45fiJGR0dVQDNC3BDABHvXG0PAJ+owvGIKTQSEpIkhBColYJsOV7d6HbjTA6OmZFf1q0pbnc/HdHjttxRSLRTV+mUvIYJC2u0wRKS44i+lZIu002XLjsLhyyc8lRDFKlBODY6im63iy333Y1aGKh6HCaKoggjC8bQaAyfgEQFZNK6SAVwANUg+DIbD6hCibqwQsghySBHjscceRmNoCLVa1VqwRXoy6136mduBWQQqIqhbZhYh3U7Ne+8yW1bePLGd+rj+rHe7/otlAnoqIogi1Wg2NoSE8+sjDakpOBBJCGYRSIo4FqrUhVKqVYSgjMDccr8wPUK1UqrUw+rELIdoIMA4IKR3u2jb1792C42QTnHJ1Ox3ZalpMmTbQsFZFOlyfus9RGkRjPKtsFVxQXqZis9mWl+cfHPK8c8c+vMKs/9HscxwjBEs9nEiy/uwWynjSAMIePYGgNSSoRhFZwHNSgGyPVOFdkASgpwDiLd+aOPvlxIgQtTtYmpyCvV6fY6jp4iYRY3P+t2DmNPILGL5QlGn+5RVlKaM6Ok0QDZTZdVnDL1avYqp+ySnE3QhgVcRCWBdxEKjVSw1udPYcKJMATEQRhJDgBAiS6mEQqKUNCbviZkRaUUPyOiOrs8pGdFmZ+RVAmaXxdv/PJb6BMShbhreoIQJLUwlqYDAweBFYt6EW3XOIDPsvBRCAQhA6tMkuyChfZs8qQ1s9F+jTMBDwCs9VrGCEU+e9+ZRB5eRaooK1/RbCJPahWpiaJ6s2weQE3DCcoZxPS7OIoAqChkHyhlAIJa+nZMy1ggAkAKccTAiMKfhhohup+SNCMYYwjDEzMwMpJQYHh4GoERcnmjMUxnpTsr67QP9qBMfYvmm+TRPYDI50e9NMRkQqaIZrw9EpOxbCxksWQd4swILUhHWtWiHUVNDMULIs17zplSknjmM0m03cdttt+uOiiixBFEdrtNsIwRBiGuQ2e0wED/KQtc996i/KVffLaV+Y6t0zDoGhBpGwzFzzGQLkEoN4pkQp4+5LZwYqRj6IpVQNpZQqSWPTdt2oRNmzbh6aefxh133IEf/ehHiKLIGpZxHPetX4tUiG8ZeWXmqSPT+rn7L9pU2BvcgCBxmg12YM4tHhglI+ox/DwlAcu58tsddaWIzC0ZHmjFMg9rtNn7xi18AANavX48b+b7wRt99+O8477zxEUYROp4NarWYlgu8oS3de+ns/EqGoDf1IiSORSm75bt8zVSGIYINWLR7IkAjz+YgAixCJ2uBAgIbTYkSBWLNryOgxQawbXX389PvvZz2Lnzp2WEW666SbceeedOO+889DpdNBut1Gp+VHpUg09n+YrbMvHsS9gi5uj3U9R/7m9JEkSGKQhSCogosvGWZeARFMq0ESh7rV1JACOQIIgcT14W+pN+HYYjNmzfjoYcewgUXXIBrrrkGa9euxfr16/GlL30JTz31FG6//Xb84Ac/gBACjUYDcRzPIXbZ++kDWtDIPx34hr/z0exfKjOQi3IiU2iWmpYJw+h8qhF5JapFbhgEPBiBt8KlYfyPuYdcC1TTEBHpm+Le6YBrsNMCOWc45arQbGGO655x488MADPYywceNGfPnLX8ZTTz2F2267Dd///vctIxgbIT0CTX15+TJB+lzXVzCJAkQ2RZrwyL2c6b174W7puYwNARyBLAkiHj5u+kIzZ9ZoyKGUAKQXU7lUOsztGCAFh+9IvDyWa24E5jsjrAfWfWDzjnqNfrYIzhe9/7HjZv3oyLLroI1157LdasWYONGzfiK1/5Cp566il8++9vfxpYtWyCEQLPZRKTnvulOzXvm/s/zyBVJjCLmyKs/j3Gy0mfhlae2GCVGILQE6EeylTMAKUNB+iAhESrwwpuPyOVn9k0bOQJYVnv4OqI6PoghBEKBarSIIAtx333344Q9/iHPOOQfXXHMN3vzmN2Pj+xo346le/iueeew633HIL7r333h7bIM+9m+VuziNY1ijM8j2UOanc52lxn9cPaUjX4brcpSRISBAF+vWUYW82DEfw8gYzB3XMHwIp/ssnyrfD0erfbAWkwUcZGRURRZANM5qKWbTjljd48ovuoijyJktW2+LM+g72JPXh1A74IViJQPQCrDbw6eRHAOWcgFDxUgrW/Z6Gz1XdidMGZqmI76zWtgFoGMZ5Axhlar+hUqlggsuuADXXXcdNmzYYNNt374dt956KzZv3gwpJRqNRo/qyaovC48swvajt4vS+Kif+dRBRHbB+RxABkGo9xlUJAQPsbuwBGIFJ4SoKyHoEJc2ZAmZFwxQ1CEgIDwAzMzOoVqu45JJLcP3112P9+vU2+3ZNPPolbb70VDz30kDUCTfRsut4yfevi4ONWHgT44uSTRhGXAOjBSLAOM0YqvxACMkNqpsHPE0jS+rgWoZ4CQEqHeqiRl0pmuqM6zlo2RxTkHY8wS/rLLLsMnP/lJrFu3zqbfvn07vvnNb+Khhx5CFEVo+NBo29qBoNGV9z7MD0h1fpJ+zZhB5bSyzA7LAVSd5i19mFkAkwZg+voZzFRyq8wvHYVQEXgygvwDM+ia2zyCpbwJ2Xp3VWTzkaTAdFUYRLL70Un/rUp3pGvCH8li1bIKXE0NAQgiDoCTlLl+XdloxnWQaa+j3jPY5Yyo7KoDWX9l0hdtQ4AmUzDLdMQWXutCDxmARIkSW+nTlyjnAcI9JoA0xyXtgHS3Jw2jGq1+Gr7zne/gzDPPtHm2bduGb3zjG3bEN5tNCCFsPFzW6MsjfhljpIkxH9GfZwSmyyuzLfKe5fafPleB+9EEaSX7FGPpbKf4eswBlabp+Zc44hIiBShUSZENOXFvAGCt5nWsMOEP8J598EjfffHOPjuec94z4+dCcblWO+z0GdsmcEpn5ARc+4v8ugXwfPfKCs/8iMbiIQgzpUwqYDAG2febiDyyWAkFA7dbU40qog+CMKE0xzR7y4bl41Mxhgef/xxfOtb38IDDzxgRX0Yhj06PmvubGyIkZERVKvVnoMUiuq07ZIqgrnd+bltH0nzVSFY9WWI/C4+ievLSEZGNAhZCWMns9o+M5eBUgIjVgoNZOxJxDM4DkD4Fw0zD0lE9eQaP+mc5MTEzg/e9/P4QQGB0dtbtg8vRsTwOlRLPZxN13343h4eHMTs4z2Ez9k5OTeM973oOZmZm+GSjv+WZZNkfW+DPL6z7SdJCWrgQyIo1gdo2PayTAYCaCxgRAExoRFSEgJKfUGRZ1GZlieRUZSHMd2J2yW+VZ+PDlmJNDY2hkqlUp4pA9zRmjdqi9YN0mW5+dLf8xgonS4NaTySj3LLEzgERWAMyvFDAnEsIWMx+mMUgkibuj6w3kEiCicA6g5Q12qsC8hqS/m3WAnzA7cQwDNFqtXDttdeiUqn0jBRfMTs7O4vZ2dk5+qsstIw/vsvYVvXetfF+Ya1wzgBGkkGr5lwhBQDCnjuqJYmm55SoAvSNECHXEmUWC5s5zs8CH28sg+rcNnZ2dx//33W3+CW09Wnp52aWllYhHz0s53huEDeVKmrD7VzypMn0gCnIP0NnyCR5CHAx4SQK09+My3qOdebE6o6AkUlsgZJnng8kqlWFpjR02g0Css0uj092qwqy8C5SJK5MN+29MNoBh93cKkJgDYE+QXYWoBxDWi1rO6EMvGwABkKc6hAZx6AwUOcEiN6tT76j8EjAlFlGKKNe0kZhnq7v16mUZ+zl5ZmP+YZilhhgRQOadsb+UZxAAIiG8YgJLGcCMkPR8W3GfUQHZoVE9CDsdPF9IE8/3nZumTIf7Ej/Ls1fW+xrK6i/KZstViXGJsS5EEfhCp+A21JuC3NuO3GuiMIous81sxyNxDEdKNKOqAMsJl+eqz0vnmLWOm+Mka1LvEM9eZj1WcxURGkZyuCCAGZABDRQ+yEOQYSEgYl5iWBqwGvkIc5P5cghRJDaWs+qyMHYUX3+m86HIHnP5yu2fSBdRtZ2saz+M2JfHTXK9Mg3sQJKIkg5oFkAWd0eq/NMNRIBY8kpYZkIFlu3Rbq4+KJ15ViRuj1TVpMuYDwOl3/djJ5T1nzBBoBKI40jFY2i7gHMdIk5+U8xyCaDdv8a6VAiIZBNCz9Qk++3ycIigyGl0i5635Z3WYjxXvY+xlGYUuU/Tj3MmrK83Ibrq8ss2QIyKASMdtqrOZo64ACwKVxkNI+lUsABkiZ7Nczi0KCCMQ4ojhG1O3khmz5Qpb+zHpW5HMoS+/+LmKQLL2ex2y+hC4DF5+iNQTD3LOz+HVRrKhgExNSsjKtlOYpjSCEGZATGAkRMHfAM0/EAoggyrAAEdLsRZmZm0Gq17N4+45zxnU/7iu1++O3g+BCrLk4dvv+I+Dx/zzBywaf675y9FURfValXNCJjyCSj6OHsKB8EAlsutxWkaH6rz/5FE+Jh1+e845wjBEEAQIgqB0aTjd8H79CP160rLe5dVTZgf0a3SWgTvVdkPezH8zsJjZ9k8McRQplz1LDpdK+7xbOg3I/gBQgkmr3CRK9F8cCtZryBZiIIBMwqjhURfMyxnoYway/Z4nQrAUj8zzrWZ6YzhqBWSLW+5C3S53k2iot/2QJSGrJW+Ex+91RV97Q1k85IAwKgdgaLVD/qcHEpB6MCSCo9k0QGqZsxKpVAR51K+a2zkuVvjOLbHnJmPqyYMU7gEzerYfp4VtinjfZExmmbKPEYtKt8Fl3kMsd0dTqYOVxpk4UlSqWO1+K6gLgIPp+3YIfotNfvsCSDeKEbiORLU+dB2FWrSenm6IlNIeKGUYwGWGtFs2rUKKvh8J+JZTpkrM+d1cqGk9qenS77TP5+rEh4ihGFMcgYggCbvcImOl7GXioAJkUpqwMmOmelMYZ0d/SZhZDuMfKGlFH+RJYh3I+7+mdgUEzgC0YUp2clLmHJ6StXPfTo8iP0VzAGe1SswaMf8PMESgkRCXXcIBkRxiCcyxby+9KQvpCWIaVCWd9HUl7UMbDZPpus2DOWDh+vmTfs10nZLFoGzcHWfl0Ufmbx5/UekCA+og7vM5hCD+hzolzC/OwmstgKCnGhL2uCkhY8g4nONscPVXv5A2eLLAfe5uIzPg3qjhBldm1ZUexUXPs8pzf2fh+eySjuzAvg+13EUuA9a7V2AW8gfgB9NZw62uGIRS3N2cBNEccZjXGx0oussh9DD53pJdN/fLEZtZz+Vy0ZHFzbpMwrmPXdbXO6nUXlMJtHbdkXglndb/JL7bcpA68DIoxRwcPQjjowv40HPnN0H8gieFbZ+ZdOvPGL51p/H5GX+AF+jNY/x54DBAyo+cM4MzEPNAJ6zAHVHAIH0/jMighQCcWQuovAXdXkjubfK+/q3xMmdOWnfPF462senjQ3CJ7QbjMM4hhQAxFbk9OBtAyp6dwIA6kZIcuucZWf3OkecLvuW6HTwo+6TQIyGPSPPWUZEx0vzQzKUUqP6O3LIHVh0L0HElOEpAi7knXrw98kJ3vGp55Ruigpo6DmL4NCkRs+xL82fM001CMkHPB0BYMIpCNPjQFKJMBQPwLUBws+3rdBpet3iusDvsxoLoZw86lDIpU6ZmGodwr5+lenlB4ilSM4LNMgyZk8KNuhkOYMG2fE+kFVOmeGYBh8cBiW9fNcNTJo5Pn4CQAxm+z4jBqJI2W6D+WgtQ6wFasZhgBEBtSCitYi5kieJBdOh8R6VLhNfbyJtPfZzznkEn9DmOILKDUpLfYpDXXIFI6Rap+pxtSSnVDhbk+3UFsbt7BBU0MAt4oRh/gx7Dp/jNOKnMTJJFIzmeAKyn8BpVfVLBWAcxxfBApLpuv+JjwahMhyxxrIctEeTVzy4Ejrmhsax3qO8yUiIDnKuRS8GABa59sKGIMQMaSs9VTUz4LQ0YR+HC2/+ThgELrEO1zMBugBA0dz4zDzwui8AcIhLZosYhyRhFgPf8PBGIvwgQcbSzgRYzzTdbznYZ1nKFmhu+DjVZWUYF/9Q6+teB75EbvclqEA+4XquJe/Y5Cs+gUK/Tws3af3JGoLY8wTJ1jc80K0sPv15ewjeS+zj/SGUEsYn1iuPqdvtyjDLwYQImY5BgSc4mkWgsAgP4cI8aTlrfqNV/wZaJ05E66DPf/0YAyT2V5+3Wr9xYp7SqK2SC/W+dpjXtNAM6Uwiw4h01fROgaAcQXnEXdOE1LetH7dyP1AOmqnn3qyRmg/Zfg6+etxy8/LMGTDqoXX/SimBMNRX+vgZgaUMIIQ5BSTxRMUy1ptFElTcSJoyxN3n81lAKgoWyXrn1uPL+aFmBKfMNckn/71fs5+NuVDBXqkBKyCiCORpmYItBlviUhHxbH7SDZFZn5fnNXWlRBv12fFbD3bp8+R3DeSPT1KbiE67ed6f7LtJtA6jQwKeyx8VZlDyos3NxG5a4tc85VsGjJhQTpzijrhH5HaR5kRSCV+gcEvnbYob5m/wWdFMr087Vu+zq2JrUe8EABjSi6QshPKwG8xKO69wowxBmbCo+a1GlAMbuelvwP9+i3Hf5/PFcT64DQIfxqAOitRGoEZEnRKmYznLwMsIZIwgItEbFKldwUXk94mDc7k8Sy2kv/uO5n4h+z3bIw9c3BjAPv35mK3nSSZVjruAz0z8VJ0ikThArg3IbwBwNE5gtYeYaeTmHeK4Ocp9n6d4iPZoF+PsZiXtllfgcfghQZhb4zmiJjOO93mvBuXQywB0Rx3isJyLHPisD7tPDEoFB7AVnGwdDmDuC8cgYd+RJE1InwXgnxGq0+aQUgbn8FgngdBcj0MIdm6n9XvPkfE+N0bGCfzTFK7EApHja9uzBNtZWX2k8bn+me/oT0O/xluZmjFpyhi2Jz+c8Hb0em59wC8s3DkIxiAghHOhJPJP8chCOp3GqI88izj9Luu9+zxv+6pZnuGXhlJW3qI4iyVJWXp6EybOTAJhdeiDnviBzbD8DU8bhYM4HkD0cRQCgjUHOAoUK63UC9SsW+ixgl750v8XzqKHruU3eWsdhPXT6eUwM2+JapBSGVjyOKOsnR92RmAeXgcVQsrB+AMeYEhRJAfpGn+afB1FfcLZXZGv46g1wv6xUdKCUgJQN3iJqQ+KZycsw4GtRxMOtbcdp49O1hnJ9LI+DfmaBDAt8w3+IvHnZyBz2D0BOgrYDCzjvR3I5dEukpKS7WDqPLq5N3YO2tL3JZiPMemrRl5PMHj3PXA4tLePawuN+0I27STrFEaVlli8GSedOQKlOAzEcJswUsbSa/iBvTv1GIFgZHE0c3b6QmhaxiPVxsQKMmCMF/JxN+pQxgbqHgjnhJECAfdzOAuc4W3wWVowmDlrqRUJYAAAwCSURBVFYGfBxLR1Jm7+aQZIYGJAEh7qER+RVDKALHeGaROCklWmgSZLeIcAJUeepDu7LxDm/opwwdeb6lxJExVhGtaxQkhwAMV/mu8fu7KrbIP+BmEDaHVCpDYduPsCgjBEozmCOE7dWVfQCF94I4j7+eLg69yaD5ipnhACI80RVCoVdcCUNQRVOkl+++BcxAAEgKWU3itRxb6BkF7CIBCqVCpYuXWrdkJVKpS+j7fUAH+/bGwV8jFiXAZYsW45KtWYHpZTC+em27nS6EkB2kdUQK8hjAZJBCxO12u205yxBbMFXJ+o1ngEgFiZjLnwfRwUeTQQalco7EduknrXsy+SaVSsdG/p2083QbnuOVyzjEzMwOSsg0km4gyyy6oVwLodjud18bHx1EJndFN6rTw8fFxvHnTb6HR+aKDT6SAMwzkXOP1ThPkacf202zetWegxxA+CAK3WDBqNBjZtOguHDr3WM+iICJUwxPT0BLqd2UMA+upinBJAAup12e//4+DiqtaqdDhpfQKczi+MWLsJZZ5+DmelpSClRrVYz1wXyGlfk/s3LMwgoGr39+LFANUp0UMR5jDNWqosHMTAtnnX0Ojlu4CLPtts1rjMBKtYJDh8bR6c6+DMUARgrMgTwGkAAEgNl2+e+rpffv2oRKEFjn3oMP9B/bj6n/9YQw1GpiamrT3AJor4Y8EytYBBtH5Pr57n7z95ClaSMpaBGOM+oVaroVKpYHJyEo1GA1d/4MN4+ZWXASRbxk3MZhAE2LdvH1oz0zsBzELRMnNEFkkAAWD60K8OPLp7+9644EukzaRXCE+PjaDRH8cF/83G027NotVoW2XQD05A30orWy908/UTdZC3A5OHiqwLylm6z6kvn+81nkMgxQq9VQr9fRarUwOzuLD37kExhuLsDE+CEVH2Dc81oCcMawa/eu+NDB/Y8CmIaiZV8SgADE+AKbjKNo/NTmx68W9e9BoDCXTQI1opVLBM8/sxMWXX4FzL7gQExMTaLfbGBoawvDwsD3ps0wlZBHM+jTLKSuu7CpfubDdvmhiuX96tp6jMdN15aq1McrkSFlB9Ozw8jKGhIbRaLUxMTODcCy7GxZddgZ07+d1iDEIzra3uA4eEGntu9G1MTh3fFUbQfigHMaV5zIMjERAHT7xsgaobV+lvWr1+PVqsF62vQy5KM+cxw88Cp+98qrcfDAK3hm5w4IITA0NIR6vW7PAk6LOvcDJNEuxqnkHsKYlbasrKLf6fSmLrfcovrT+703erDzu7/TRt+m0YRiiWq2iXq+jXldH8ExOTmJ6ehrnXnAhPv2Hf4rHH3sMjKl9gSwI9FkNqt+a+zWFs3boVz+16+u877dZPARxAogbmQJ6iNiqgC+C1w4cOPrx797PvffXAgZWjo2OYnpkBkHieGGOI+uh08/tjP8Ok/+hOsOW0t/tudt+PAgQNoNBqWEXyNw984YAwg6nHvRlGM6alpTM9MY2hoCNd96jN4+9+VX4vGf/QySJCqVinbHC3AoYtXrNbx64ABeeGH3ixOHfvUwgNegaJirAopMXQ6gCmAMwLrm6IKr+zjjrbZ+54sor+eHDE/Zw52RUA1KqEys3nXEG2q0p/N137sCjj/wYrVYLnKsr54MgUJVa7tdNJmgc+k+eJpJmLXPqd+5vIjEonXNo0ijMb3MKZ8pily0mXWYTPXGnuqpC5eCdlO+mkqtRM+UQcQxKhMdzA+W976Nnzoo9ejVh/Gtm1PWCPPPQ7XSJaR5jDuuutuue3nD98yNTH+PwHsBDCBZCYwF5+sh867AMAQ+gKUAzlp20ql/cOHFl56zbt16TExMAIxBihg8qEDdWqkaMTs7i8WLF+NNb1qLqYnX8MQvHseT//gL+vLRvD2ampvQqoqWUDTJJI2OfmaSAcxWa+sV6diaQvknDsHuS1tSRUDjBgekFL5f6zJaYLpdsee5v+t9MsPgSYq92gy0/iKnpbqQjLMNIcxbIVJ2Hj6Wfgt9/6doyMjGHXrmdx4MAB1Ov11HmMHEQxAIYF+Y2N4+ukd2HL/PY/sf/G5rwN4HMB+AG3MUwKoGoAKgFEAqwG8ZdWp6//9e6+4avXSpctwWDMBiHTf+cRAJgHNIfUnEgoULsXzpMoyMjYJEDFKBLHoUEriWCARCwLmeyqiKhZBggbtezhTG2uBRMRE6ZlE6+o5vr+D+CY+YywO5jUG7tgDN1vRoBQcAhSEsFoaphXJ3GDam+gzFw6PuTONdNV3UTs7yDgKl2MABC+UsKSnIEzFcXDoW5fhz5vWe3q5eABA+dquvfii3tx+PA4KtUqQt03xvZwDcqxsVEc2P8Kvvvdf9iz+Z9eOLwF4FMDzACYBRChYsS9jACMFagCOA7A2CMJ3nLpu0x9e9f6rFw43m5ieaulrS9TlUkCyXGkd+R3olkQchgoDDjBuz1GzHI+sdkeZaOsY4GGdaVPbOj00nGEgPcJgbth09a4hj0rtiW+XQQZWU3IZi+1JbBkfRvc3Kaqzrs1TmpjiQzULg7aJI0RKrOKFKBNuZWFZi+cfAwEmtsbBRTk5P4h//9vw7t3rnt+a0LEWwH8EsA4gA4KRj9QPAuweMExComkmJ6amNj/yqvrFy9eXF94/ELEcWRHP2OKwMnplarTecAR+huosfzWQNSOY6VHGtMp4tzhP9KN5xqzOTHbCqPr11NEpm6tdEz07m5KprDM1IzUSyfmddL6z8ZL0+TUmCHOmexOYbHKWUSayeIHu0romx5D3EJ21HSYTVKgLnBhX3FnCDWxhwNEeaePmll/C9u+86vOe5+nXdE3c7D/RDflwHcugWAWRFH7cOHDr60/8DBVY3G8IJlK5YjDEN0u5HuLC0PKbl4wXay0aEMPe+U+LaAOPKY4th3LWQAEvEd/9h7T7pYz14tm6zT5KSEQoM48ZlbqOBYGMzdzJeBO1wgcBD0Lct67vgT3+Ei0eMH3WonoXcG6HvyEqC5I6DeO6p32YjTdjY6OoVCrYuWMHtmy+b8/e3Ttui7rdR6CMvteQTPsK+iQ/0zwASSqe0iGR7cvxXLx48+KuF+/a9dOLw8DBbsnSJ1sPCcu1cJ0vv/T8cQGRPIdfPXbnIYA9B+djsazvf0LR9cfXFmKMpbZhnCMAPTR6wxBkDdt2NVC1P2BmcMsZgb7yBFrG8sCZTkQWJkMofw5pmd+mWiSGGZQNoTUePDkRlZTj5Z2YRigXq9hZGQEL+7diwcffFBue+LxJ17eu+tviOjnUMQ/CGX05Tp++0lBmA6TTcijfwRCUTbAawIZafejMxSeuOG/lyaecsm7dOixZuhS1Wg1EyaZFIWK1Vg3YBvaMZC2m+7YhiAezuVseBlFgMTqemIJEMlmWgeJf1bF9TDCGgbtrqnZoZm2GOnWGN3oSJjGVrGDxrtsLRa4lZ+2ydVh5RArRYiCJT+DwOOIAzRbrex/+WX8cwzz2DPC7uff+3Ayw92ZltPANgBZfCNIyF+7uJPGvph+AJOeQTFBDcpHsASKEU5pDI+cObbwhLPrjeEVK1asqC1fvhLNkaZ1Z9ZqtaQDiLRuV7/NPTd22ieT+4+gAQJBAwAKn63rFfObKnDPbdO0IzoGAV/QFy8zaEExLApKxY0OynjqA3qti0msj5pkR2a4EtOVo+Zjd50lPgVquFbreL6elpTE9NYd9L+7Bv34udTqu1b2L84GOt6cknADwHRfhXoOb6HSQj34v4hqD9+gmGCAGqKOARgARQjnARgOYATmmPHndYYHj0lrFTHgjBsch7Uw7AyZDuR1P2DxmBL61v3GYHAWe8J+2WaEGduYMaZPLnWmjdZi1+qGcZ1GSRcG9OSzNeupZBonwyzmZm637jQTpvfmpv0ISnxhTh2MMcRR+1BYynhVxPB1H3YnWzORz0xPjzwB4FcBLAPZCEf4w1KiPkOh8b+InbegfTD6jEqpQjDAKYKH+LIZS+EyMA6lASo6LzzLfef+7g2lkdKGNuCkq8HwRwSH8moQjfRSLyTf6+4EgJYaQBRyIRqlAEb0ARf8h5+znGMAYrAMICEIm4ERegpAC0ohjDPzRp/36PehUERgqFXNaQ/LuGPEb8YDEENI4iMD+EICW/gaBDD+VQ8s43MMyoEyPvMW88fgGByDY3AMjsExOAZp+P9wARPsg4qOiwAAAABJRU5ErkJggg==+"+ preserveAspectRatio="none"+ height="228.59999"+ width="228.60001" />+ </g>+</svg>
+ package.yaml view
@@ -0,0 +1,77 @@+name: photoname+version: '5.0'+license: ISC+copyright: 2007-2021 Dino Morelli+author: Dino Morelli+maintainer: Dino Morelli <dino@ui3.info>+stability: stable+homepage: http://hub.darcs.net/dino/photoname+synopsis: Rename photo image files based on EXIF shoot date+description: Command-line utility for renaming/moving photo image files based on EXIF tags.+category: Application, Console+tested-with: GHC >= 8.2.2++extra-source-files:+- changelog.md+- doc/hcar-photoname.tex+- .gitignore+- hsinstall/share/applications/photoname.desktop+- hsinstall/share/icons/hicolor/scalable/apps/photoname.svg+- package.yaml+- README.md+- stack.yaml+- stack.yaml.lock+- util/resources/test/*++github: dino-/photoname++ghc-options:+- -fwarn-tabs+- -Wall+- -Wcompat+- -Wincomplete-record-updates+- -Wincomplete-uni-patterns+- -Wredundant-constraints++dependencies:+- base >= 4.5 && < 5.0+- directory+- filepath+- unix++library:+ source-dirs: src/lib+ dependencies:+ - containers+ - hsexif+ - hslogger+ - mtl+ - newtype-generics+ - parsec+ - process+ - time++executables:+ photoname:+ source-dirs: src/app+ main: photoname.hs+ dependencies:+ - ansi-wl-pprint+ - heredoc+ - hslogger+ - newtype-generics+ - optparse-applicative+ - photoname++tests:+ photoname-tests:+ source-dirs: src/tests+ main: runtests.hs+ dependencies:+ - photoname+ - process+ - regex-posix+ - time+ - tasty+ - tasty-hunit+ - tasty-quickcheck
photoname.cabal view
@@ -1,74 +1,118 @@-name: photoname-cabal-version: >= 1.8-version: 3.3-build-type: Simple-license: ISC-license-file: LICENSE-copyright: 2007-2016 Dino Morelli-author: Dino Morelli -maintainer: Dino Morelli <dino@ui3.info>-stability: stable-homepage: http://hub.darcs.net/dino/photoname-synopsis: Rename photo image files based on EXIF shoot date-description: - Command-line utility for renaming/moving photo image files based on - EXIF tags.-category: Application, Console-tested-with: GHC >= 8.0.1+cabal-version: 1.12 -extra-source-files: changelog.md- doc/dev/notes- doc/hcar-photoname.tex- .gitignore- README.md- stack.yaml- testsuite/resources/*.jpg- TODO.md- util/install.hs- util/resources/test.conf+-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack -source-repository head- type: darcs- location: http://hub.darcs.net/dino/photoname+name: photoname+version: 5.0+synopsis: Rename photo image files based on EXIF shoot date+description: Command-line utility for renaming/moving photo image files based on EXIF tags.+category: Application, Console+stability: stable+homepage: http://hub.darcs.net/dino/photoname+bug-reports: https://github.com/dino-/photoname/issues+author: Dino Morelli+maintainer: Dino Morelli <dino@ui3.info>+copyright: 2007-2021 Dino Morelli+license: ISC+license-file: LICENSE+build-type: Simple+tested-with:+ GHC >= 8.2.2+extra-source-files:+ changelog.md+ doc/hcar-photoname.tex+ .gitignore+ hsinstall/share/applications/photoname.desktop+ hsinstall/share/icons/hicolor/scalable/apps/photoname.svg+ package.yaml+ README.md+ stack.yaml+ stack.yaml.lock+ util/resources/test/dateTime.jpg+ util/resources/test/dateTimeDigitized.jpg+ util/resources/test/dateTimeOriginal.jpg+ util/resources/test/foobar-2021-10-04-17-29-49-942.jpg+ util/resources/test/noDate.jpg+ util/resources/test/noExif.jpg+ util/resources/test/notAnImage.txt+ util/resources/test/test.conf -executable photoname- main-is: photoname.hs- build-depends: base >=4.5 && < 5.0- , directory- , exif- , filepath- , mtl- , old-locale- , parsec- , time- , unix- other-modules: Paths_photoname- Photoname.Common- Photoname.DateFormat- Photoname.Date- Photoname.Exif- Photoname.Opts- Photoname.SerialFormat- hs-source-dirs: src- ghc-options: -Wall+source-repository head+ type: git+ location: https://github.com/dino-/photoname -test-suite photoname-tests- type: exitcode-stdio-1.0- main-is: runtests.hs- build-depends: base >=4.5 && < 5.0- , directory- , exif- , filepath- , HUnit- , mtl- , old-locale- , parsec- , process- , regex-posix- , time- , unix- other-modules: TestHelp- TestLink- Util- hs-source-dirs: src testsuite- ghc-options: -Wall+library+ exposed-modules:+ Photoname.Common+ Photoname.CopyLink+ Photoname.Date+ Photoname.Exif+ Photoname.Exiv2+ Photoname.Log+ other-modules:+ Paths_photoname+ hs-source-dirs:+ src/lib+ ghc-options: -fwarn-tabs -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+ build-depends:+ base >=4.5 && <5.0+ , containers+ , directory+ , filepath+ , hsexif+ , hslogger+ , mtl+ , newtype-generics+ , parsec+ , process+ , time+ , unix+ default-language: Haskell2010++executable photoname+ main-is: photoname.hs+ other-modules:+ Photoname.Opts+ Paths_photoname+ hs-source-dirs:+ src/app+ ghc-options: -fwarn-tabs -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+ build-depends:+ ansi-wl-pprint+ , base >=4.5 && <5.0+ , directory+ , filepath+ , heredoc+ , hslogger+ , newtype-generics+ , optparse-applicative+ , photoname+ , unix+ default-language: Haskell2010++test-suite photoname-tests+ type: exitcode-stdio-1.0+ main-is: runtests.hs+ other-modules:+ Test.Photoname.Date+ TestLink+ Util+ Paths_photoname+ hs-source-dirs:+ src/tests+ ghc-options: -fwarn-tabs -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+ build-depends:+ base >=4.5 && <5.0+ , directory+ , filepath+ , photoname+ , process+ , regex-posix+ , tasty+ , tasty-hunit+ , tasty-quickcheck+ , time+ , unix+ default-language: Haskell2010
− src/Photoname/Common.hs
@@ -1,25 +0,0 @@--- License: BSD3 (see LICENSE)--- Author: Dino Morelli <dino@ui3.info>--module Photoname.Common- ( Ph, runRename-- -- Re-exporting:- , MonadError- , ask, asks- , liftIO- , throwError- )- where--import Control.Monad.Except-import Control.Monad.Reader--import Photoname.Opts ( Options (..) )---type Ph a = ReaderT Options (ExceptT String IO) a---runRename :: Options -> Ph a -> IO (Either String a)-runRename env action = runExceptT $ runReaderT action env
− src/Photoname/Date.hs
@@ -1,72 +0,0 @@--- License: BSD3 (see LICENSE)--- Author: Dino Morelli <dino@ui3.info>--{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}--module Photoname.Date- ( formatYear, formatDateHyphens, formatDate, formatDateTime- , readDate- )- where--import Data.Time.Calendar-import Data.Time.Format-import Data.Time.LocalTime-import Text.ParserCombinators.Parsec---{- Parse a date string in the form "yyyy:mm:dd hh:mm:ss" into a - CalendarTime datatype. Strings that fail to parse in this manner are- returned as Nothing--}-readDate :: String -> Maybe LocalTime-readDate s =- case (parse dateParser "" s) of- Left _ -> Nothing- Right x -> Just x- where- digit4 = count 4 digit- digit2 = count 2 digit- colon = char ':'- dateParser = do- year <- digit4 ; colon ; month <- digit2 ; colon ; day <- digit2- space- hour <- digit2 ; colon ; minute <- digit2- colon ; second <- digit2- return $- LocalTime- (fromGregorian (read year) (read month) (read day))- (TimeOfDay (read hour) (read minute)- (fromIntegral ((read second) :: Integer)))---{- Format a Maybe CalendarTime into a "yyyy" string. Dates that are- Nothing in value format to "0000"--}-formatYear :: Maybe LocalTime -> String-formatYear Nothing = "0000"-formatYear (Just x) = formatTime defaultTimeLocale "%Y" x---{- Format a Maybe CalendarTime into a "yyyy-mm-dd" string. Dates that are- Nothing in value format to "0000-00-00"--}-formatDateHyphens :: Maybe LocalTime -> String-formatDateHyphens Nothing = "0000-00-00"-formatDateHyphens (Just x) = formatTime defaultTimeLocale "%Y-%m-%d" x---{- Format a Maybe CalendarTime into a "yyyymmdd" string. Dates that are- Nothing in value format to "00000000"--}-formatDate :: Maybe LocalTime -> String-formatDate Nothing = "00000000"-formatDate (Just x) = formatTime defaultTimeLocale "%Y%m%d" x---{- Format a Maybe CalendarTime into a "yyyymmdd-HHMMSS" string. Dates - that are Nothing in value format to "00000000-000000"--}-formatDateTime :: Maybe LocalTime -> String-formatDateTime Nothing = "00000000-000000"-formatDateTime (Just x) = formatTime defaultTimeLocale "%Y%m%d-%H%M%S" x
− src/Photoname/DateFormat.hs
@@ -1,34 +0,0 @@--- License: BSD3 (see LICENSE)--- Author: Dino Morelli <dino@ui3.info>--module Photoname.DateFormat- ( buildDatePath- )- where--import System.FilePath-import Text.Printf--import Photoname.Common-import Photoname.Date-import Photoname.Exif-import Photoname.Opts ( Options (..) )---{- Given a path to a file with EXIF data, construct a new path based on the- date and some serial number info we can parse out of the filename.--}-buildDatePath :: FilePath -> Ph FilePath-buildDatePath oldPath = do- dateString <- getDate oldPath- let date = readDate dateString-- suffix <- asks optSuffix- let fileName = printf "%s%s.jpg" (formatDateTime date) suffix-- parentDir <- asks optParentDir- noDirs <- asks optNoDirs- return $ if (noDirs)- then parentDir </> fileName- else parentDir </> (formatYear date) </>- (formatDateHyphens date) </> fileName
− src/Photoname/Exif.hs
@@ -1,50 +0,0 @@--- License: BSD3 (see LICENSE)--- Author: Dino Morelli <dino@ui3.info>--{-# LANGUAGE FlexibleContexts #-}--module Photoname.Exif- where--import Control.Exception-import Control.Monad.Except-import Graphics.Exif ( fromFile, getTag, Exif )-import System.IO.Error---{- load Exif information from a filename, returning Nothing if libexif- encounters a NULL instead of raising an IO error.-- This is somewhat bogus because of the error type that is used by- the EXIF library. We have to compare the error string to see if it- is the kind of user error that we expect. If we build against an- EXIF library that raises some other exception, then this build will- still succeed, and the exception will be propagated instead of- transformed into a handled photoname error.--}-safeExif :: FilePath -> IO (Maybe Exif)-safeExif = try . fromFile >=> either handleBadExif (return . Just)- where- isBadExif e =- ioeGetErrorString e == "mkExif: NULL" && isUserError e- handleBadExif e =- if isBadExif e then return Nothing else ioError e---{- Get shoot date from the exif information. There are several tags - potentially containing dates. Try them in a specific order until we- find one that has data.--}-getDate :: (MonadError String m, MonadIO m) => FilePath -> m String-getDate = loadExif >=> getOneOf dateTagNames- where- loadExif = (liftIO . safeExif) >=>- maybe (throwError "Failed EXIF loading") return-- getOneOf [] _ = throwError "has no EXIF date"- getOneOf (tagName:tagNames) exif =- maybe (getOneOf tagNames exif) return =<<- liftIO (getTag exif tagName)-- dateTagNames =- ["DateTimeDigitized", "DateTimeOriginal", "DateTime"]
− src/Photoname/Opts.hs
@@ -1,192 +0,0 @@--- License: BSD3 (see LICENSE)--- Author: Dino Morelli <dino@ui3.info>---- This is for GHC 7.8/7.10 compatibility with the--- Control.Applicative import below-{-# OPTIONS_GHC -fno-warn-unused-imports #-}--module Photoname.Opts- ( Options (..)- , parseOpts, usageText- )- where--import Control.Applicative-import Data.Version ( showVersion )-import Paths_photoname ( version )-import System.Console.GetOpt-import System.Directory---data Options = Options- { optConfig :: String- , optHelp :: Bool- , optMove :: Bool- , optNoAction :: Bool- , optNoConfig :: Bool- , optNoDirs :: Bool- , optOldStyle :: Bool- , optParentDir :: String- , optQuiet :: Bool- , optSuffix :: String- }--defaultConfig :: String-defaultConfig = "~/.config/photoname.conf"--defaultOptions :: Options-defaultOptions = Options- { optConfig = defaultConfig- , optHelp = False- , optMove = False- , optNoAction = False- , optNoConfig = False- , optNoDirs = False- , optOldStyle = False- , optParentDir = "."- , optQuiet = False- , optSuffix = ""- }---options :: [OptDescr (Options -> Options)]-options =- [ Option ['c'] ["config"]- (ReqArg (\c opts -> opts { optConfig = c }) "FILE")- ("Defaults to " ++ defaultConfig ++ ". See CONFIG")- , Option ['C'] ["no-config"]- (NoArg (\opts -> opts { optNoConfig = True } )) - "Do not load config file"- , Option ['D'] ["no-dirs"]- (NoArg (\opts -> opts { optNoDirs = True } )) - "No subdirectory hierarchy. Just do DIR/NEWFILE"- , Option ['h'] ["help"] - (NoArg (\opts -> opts { optHelp = True } ))- "This help text"- , Option [] ["move"] - (NoArg (\opts -> opts { optMove = True } ))- "Move the files, don't just hard-link to the new locations"- , Option ['n'] ["no-action"]- (NoArg (\opts -> opts { optNoAction = True } )) - "Display what would be done, but do nothing"- , Option ['o'] ["old-style"]- (NoArg (\opts -> opts { optOldStyle = True } )) - "Use older name format with serial. See FILENAME FORMAT"- , Option ['p'] ["parent-dir"]- (ReqArg (\d opts -> opts { optParentDir = d } ) "DIR") - "Top-level directory where new links are created. Default: ."- , Option ['q'] ["quiet"] - (NoArg (\opts -> opts { optQuiet = True } )) - "Suppress normal output of what's being done"- , Option ['s'] ["suffix"]- (ReqArg (\s opts -> opts { optSuffix = s } ) "SUF") - "Add optional suffix to each name. See SUFFIX"- ]---{- Try to load a config file, converting its lines into a [String] - of long options to be parsed--}-loadConfig :: FilePath -> IO [String]-loadConfig path = do- confExists <- doesFileExist path-- if confExists- then (map ("--" ++) . lines) <$> readFile path- else return []---{- Perform the actual parse of a [String]--}-parseOpts' :: [String] -> IO (Options, [String])-parseOpts' args =- case getOpt Permute options args of- (o,n,[] ) -> return (foldl (flip id) defaultOptions o, n)- (_,_,errs) -> ioError $ userError (concat errs ++ usageText)---{- The set of steps to parse args from both the command-line and a - config file--}-parseOpts :: [String] -> IO (Options, [String])-parseOpts cliArgs = do- -- Parse argv first time to get -c and/or -C- (prelimOpts, _) <- parseOpts' cliArgs-- -- Load config file- confArgs <- if (optNoConfig prelimOpts)- then return []- else loadConfig $ optConfig prelimOpts-- -- Parse second time with all args- parseOpts' (confArgs ++ cliArgs)---usageText :: String-usageText = (usageInfo header options) ++ "\n" ++ footer- where- header = init $ unlines- [ "Usage: photoname [OPTIONS] FILES"- , "Rename and move photo files based on EXIF data"- , ""- , "Options:"- ]- footer = init $ unlines- [ "This software is for renaming and storing your digital photos. It will attempt to construct a meaningful filename based on the EXIF shoot date in the file and optionally some other information."- , ""- , "CONFIG"- , ""- , "The program will attempt to load a config file from this location: " ++ defaultConfig ++ " A different path may be specified with the --config switch"- , "Entries in this file should be the long switches above minus the -- and including any arguments they may have. To completely ignore an existing config file, use the --no-config switch."- , ""- , "Example config contents:"- , ""- , " move"- , " old-style"- , " parent-dir=~/mypics"- , " suffix=_dwm"- , ""- , ""- , "FILENAME FORMAT"- , ""- , "Normal operation builds a subdirectory hierarchy consisting of directories for the years, then subdirs within those for the day photos were shot. These day dirs contain the image files, named as follows:"- , ""- , "A photo shot on 2002-May-02 01:23:07 PM:"- , " img_1790.jpg -> <PARENTDIR>/2002/2002-05-02/20020502-132307.jpg"- , ""- , "The EXIF date/time stamp used for naming is the first of these fields to be found: Exif.Photo.DateTimeDigitized, Exif.Photo.DateTimeOriginal, Exif.Image.DateTime"- , ""- , "The <PARENTDIR> is the one given by the --parent-dir switch and represents the top-level of where you're storing photos."- , ""- , "The --no-dirs switch will suppress the directory-hierarchy-creating part of this, instead placing the new links directly in <PARENTDIR>. So you get files like:"- , ""- , " <PARENTDIR>/20020502-132307.jpg"- , ""- , "Default behavior is to create hard links to the new paths and leave the original links as they were. You can use the --move switch to not leave the original links."- , ""- , "The --old-style switch specifies the prior behavior of photoname where the name is a date followed by the last three digits of the camera-assigned number from the original filename:"- , ""- , " img_1790.jpg -> <PARENTDIR>/2002/2002-05-02/20020502_790.jpg"- , ""- , "The code is basically looking for three digits before the file extension to use as a 'serial' number for the day's photos. This is a seemingly common occurrance with cameras that we can pick numbers off the end of the filename. Examples of the two that I have:"- , ""- , " vvv (use these digits)"- , " Panasonic: P###0###.jpg"- , " Canon: img_####.jpg"- , " ^^^"- , " ^^^"- , ""- , "The --old-style behavior in photoname remains for backwards compatibility. Many cameras today (and particularly camera phones) don't generate a name we can use in this way, and so something needed to change in this software."- , ""- , "Another nagging problem is the old-style naming is non-deterministic. Using photoname --old-style on a file may not always give you the same name, say if the serial info in the name is ever lost. Naming based on the EXIF data alone is more reliable."- , ""- , ""- , "SUFFIX"- , ""- , "The optional --suffix switch can be used to provide a string placed between the date/time and extension. Use it for anything you like. An example is photographer initials or series info. Example:"- , ""- , "photoname invoked with --suffix=_dwm :"- , " 20020502-132307_dwm.jpg"- , ""- , "Version " ++ (showVersion version) ++ " Dino Morelli <dino@ui3.info>"- ]
− src/Photoname/SerialFormat.hs
@@ -1,69 +0,0 @@--- License: BSD3 (see LICENSE)--- Author: Dino Morelli <dino@ui3.info>--{-# LANGUAGE FlexibleContexts #-}-{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}--module Photoname.SerialFormat- ( buildSerialPath- )- where--import System.FilePath-import Text.ParserCombinators.Parsec--import Photoname.Common-import Photoname.Date-import Photoname.Exif-import Photoname.Opts ( Options (..) )---{- Combinator similar to manyTill, but evaluates to end instead of p--}-skipTill :: GenParser tok st t1 -> GenParser tok st t -> GenParser tok st t-skipTill p end = scan- where- scan = do { end } -- If end succeeds, return that.- <|>- do { p; scan } -- Otherwise, match p and recurse.---serialNum :: GenParser Char st [Char]-serialNum =- skipTill anyChar $ try $ do -- Skip anything up to..- serial <- count 3 digit -- 3 digits..- char '.' -- followed by a period..- count 3 alphaNum -- followed by 3 alphaNumS..- eof -- at the end of the string.- return serial -- Return those 3 digits---{- Evaluates one or more parsers trying to find the serial number in the- supplied path. Transforms the result from Either to Maybe--}-getSerial :: (MonadError String m) => String -> m String-getSerial path =- case (parse serialNum "" path) of- Left _ -> throwError "Can't determine serial"- Right serial -> return serial---{- Given a path to a file with EXIF data, construct a new path based on the- date and some serial number info we can parse out of the filename.--}-buildSerialPath :: FilePath -> Ph FilePath-buildSerialPath oldPath = do- dateString <- getDate oldPath- serial <- getSerial oldPath- let date = readDate dateString-- suffix <- asks optSuffix- let fileName = (formatDate date) ++ "_" ++ serial- ++ suffix <.> "jpg"-- parentDir <- asks optParentDir- noDirs <- asks optNoDirs- return $ if (noDirs)- then parentDir </> fileName- else parentDir </> (formatYear date) </>- (formatDateHyphens date) </> fileName
+ src/app/Photoname/Opts.hs view
@@ -0,0 +1,236 @@+{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}++module Photoname.Opts+ ( parseOpts+ )+ where++import Data.Version ( showVersion )+import Options.Applicative+import Paths_photoname ( version )+import System.Directory ( doesFileExist )+import System.Environment ( getArgs, getProgName )+import System.Exit ( exitFailure )+import System.IO ( hPutStrLn, stderr )+import System.Log ( Priority (INFO) )+import Text.Heredoc ( here )+import Text.PrettyPrint.ANSI.Leijen ( string )+import Text.Printf ( printf )++import Photoname.Common+ ( Artist (..)+ , ConfigPath (..)+ , CopySwitch (..)+ , MoveSwitch (..)+ , NoActionSwitch (..)+ , NoDirsSwitch (..)+ , Options (..)+ , ParentDir (..)+ , Prefix (..)+ , Suffix (..)+ , Verbosity (Verbose)+ , readVerbosity+ )+++parser :: Parser Options+parser = Options+ <$> optional ( option (maybeReader $ Just . Artist)+ ( long "artist"+ <> short 'a'+ <> metavar "ARTIST"+ <> help "Set artist info in the Exif.Image.Artist tag. Requires exiv2. See ARTIST"+ )+ )+ <*> optional ( option (maybeReader $ Just . ConfigPath)+ ( long "config"+ <> short 'c'+ <> metavar "FILE"+ <> help "Path to a config file. See CONFIG"+ )+ )+ <*> ( CopySwitch <$> switch+ ( long "copy"+ <> help "Copy files instead of hard linking, even if on the same filesystem"+ )+ )+ <*> ( NoDirsSwitch <$> switch+ ( long "no-dirs"+ <> short 'D'+ <> help "No subdirectory hierarchy. Just do DIR/NEWFILE"+ )+ )+ <*> ( MoveSwitch <$> switch+ ( long "move"+ <> help "Move the files, don't just hard-link to the new locations. In other words, remove the source path."+ )+ )+ <*> ( NoActionSwitch <$> switch+ ( long "no-action"+ <> short 'n'+ <> help "Display what would be done, but do nothing"+ )+ )+ <*> ( ParentDir <$> strOption+ ( long "parent-dir"+ <> short 'p'+ <> metavar "DIR"+ <> help "Top-level directory where new links are created."+ <> showDefault+ <> value "."+ )+ )+ <*> ( Prefix <$> strOption+ ( long "prefix"+ <> short 'P'+ <> metavar "PRE"+ <> help "Add optional prefix to each name. See PREFIX"+ <> value ""+ )+ )+ <*> ( Suffix <$> strOption+ ( long "suffix"+ <> short 's'+ <> metavar "SUF"+ <> help "Add optional suffix to each name. See SUFFIX"+ <> value ""+ )+ )+ <*> option (eitherReader readVerbosity)+ ( long "verbose"+ <> short 'v'+ <> metavar "NUM"+ <> help "Verbosity level. 0=quiet, 1=normal messages, 2=more info, 3=debug"+ <> showDefault+ <> value (Verbose INFO)+ )+ <*> ( some $ strArgument+ $ metavar "FILES..."+ )+++{- Try to load a config file, converting its lines into a [String]+ of long options to be parsed+-}+loadConfig :: ConfigPath -> IO [String]+loadConfig (ConfigPath path) = do+ confExists <- doesFileExist path++ if confExists+ then (map ("--" ++) . lines) <$> readFile path+ else do+ hPutStrLn stderr $ "Config file " <> path <> " does not exist!"+ exitFailure+++versionHelper :: String -> Parser (a -> a)+versionHelper progName =+ infoOption (printf "%s %s" progName (showVersion version)) $ mconcat+ [ long "version"+ , help "Show version information"+ , hidden+ ]+++parseOpts :: IO Options+parseOpts = do+ -- Parse command-line args first to get -c+ cliOpts <- parseOpts' =<< getArgs++ case optConfig cliOpts of+ Just configPath -> do+ confArgs <- loadConfig configPath+ parseOpts' $ confArgs <> (optPaths cliOpts)+ Nothing -> pure cliOpts+++parseOpts' :: [String] -> IO Options+parseOpts' args = do+ pn <- getProgName+ handleParseResult $ execParserPure+ defaultPrefs+ ( info (parser <**> helper <**> versionHelper pn)+ ( header (printf "%s - Rename and move photo files based on EXIF data" pn)+ <> footer'+ )+ )+ args+++footer' :: InfoMod a+footer' = footerDoc . Just . string $ printf content (showVersion version)+ where content = [here|OVERVIEW++This software is for renaming and storing your digital photos. It will attempt to construct a meaningful filename based on the EXIF shoot date in the file or possibly date/time info in the old filename, and optionally some other information.++FILENAME FORMAT++Normal operation builds a subdirectory hierarchy consisting of directories for the years, then subdirs within those for the day photos were shot. These day dirs contain the image files, named as follows:++A photo shot on 2002-May-02 01:23:07 PM:+ img_1790.jpg -> <PARENTDIR>/2002/2002-05-02/20020502-132307.jpg++The EXIF date/time stamp used for naming is the first of these fields to be found: Exif.Photo.DateTimeOriginal, Exif.Photo.DateTimeDigitized, Exif.Image.DateTime++If none of the EXIF tags listed above is found, the program will try to gather date/time info from the filename itself. Filenames that are parsable look like:++ some/directory/foo2021-10-04-172949.jpg+ some/directory/foo2021-10-04-17-29-49-942.jpg++In the event the date/time info is gathered from the filename, the program will go ahead and write this into the file's EXIF tags. BEWARE: Unless you're using the --copy switch, this WILL MODIFY THE ORIGINAL FILES!++The EXIF modifications rely on the system having the `exiv2` binary installed and on the path. Without this, some of photoname's functions will fail including: setting the date from the filename and setting the artist info.++The <PARENTDIR> is the one given by the -p|--parent-dir switch and represents the top-level of where you're storing photos.++The -D|--no-dirs switch will suppress the directory-hierarchy-creating part of this, instead placing the new links directly in <PARENTDIR>. So you get files like:++ <PARENTDIR>/20020502-132307.jpg++Default behavior is to create hard links to the new paths and leave the original links as they were. You can use the --move switch to remove the original links. You can also use the --copy switch to make a copy instead of hard linking. Also, copying will be attempted if the hard linking fails, for instance if you're naming across different filesystems.++ARTIST++Set artist info in the Exif.Image.Artist tag. This can be any string you like but good conventional ones would look like:++ 'Role1, Name1[; Role2, Name2;...]'++ 'Photographer, Roscoe Jones'+ 'Camera owner, Ren Hoek; Photographer, Stimpson J Cat'++Be careful with what you put in here, we've seen problems with email addresses rendering the entire field not visible in some applications. Keep it simple as above!++Pass a quoted empty string to -a|--artist to delete an existing Artist tag, like this: -a '' or --artist=''++PREFIX++The optional -P|--prefix switch can be used to provide a string placed at the beginning of the new filename, before the date. Use it for anything you like. An example is subject matter. Example:++photoname invoked with --prefix=BirthdayParty_ :+ BirthdayParty_20020502-132307.jpg++SUFFIX++The optional -s|--suffix switch can be used to provide a string placed between the date/time and extension. Use it for anything you like. An example is photographer initials or edit info. Example:++photoname invoked with --suffix=_dwm :+ 20020502-132307_dwm.jpg++photoname invoked with --suffix=_sd1920x1080 (Sized for Desktop 1920x1080) :+ 20020502-132307_sd1920x1080.jpg++photoname invoked with --suffix=_BirthdayParty :+ 20020502-132307_BirthdayParty.jpg++CONFIG++If the -c|--config switch is used the program will attempt to load a config file from the supplied path+Entries in this file should be the long switches above minus the -- and including any arguments they may have. If a config file is used, all other command-line switches are ignored.++Example config contents:++ move+ parent-dir=~/mypics+ suffix=_dwm++Version %s Dino Morelli <dino@ui3.info>|]
+ src/app/photoname.hs view
@@ -0,0 +1,60 @@+import Control.Monad ( filterM, forM_, when )+import Control.Newtype.Generics ( op )+import System.Posix ( getFileStatus, isRegularFile )+import Text.Printf ( printf )++import Photoname.Common ( CopySwitch (..), MoveSwitch (..),+ NoActionSwitch (..), Options (..), Ph, SrcPath (..), runRename )+import Photoname.CopyLink ( createNewLink )+import Photoname.Date ( PhDate, parseExifDate, parseFilenameDate )+import Photoname.Exif ( getExifDate )+import Photoname.Exiv2 ( setArtist, setExifDate )+import Photoname.Log ( errorM, initLogging, infoM, lname )+import Photoname.Opts ( parseOpts )+++acquireDate :: SrcPath -> Ph PhDate+acquireDate srcPath = do+ dateString <- getExifDate srcPath+ pure $ mconcat+ [ parseExifDate dateString+ , parseFilenameDate srcPath+ ]+++processFile :: SrcPath -> Ph ()+processFile srcPath = do+ imageDate <- acquireDate srcPath+ destPath <- createNewLink imageDate srcPath+ setExifDate imageDate destPath+ setArtist destPath+++-- Figure out and execute what the user wants based on the supplied args.+main :: IO ()+main = do+ opts <- parseOpts++ initLogging $ optVerbosity opts++ -- Get rid of anything not a regular file from the list of paths+ actualPaths <- map SrcPath <$> filterM+ (\p -> getFileStatus p >>= pure . isRegularFile) (optPaths opts)++ -- Notify user of the switches that will be in effect.+ when (op NoActionSwitch . optNoAction $ opts) $+ infoM lname "No-action mode, nothing will be changed."++ when (op CopySwitch . optCopy $ opts) $+ infoM lname "Copy has been specified instead of the default of hard linking."++ when (op MoveSwitch . optMove $ opts) $+ infoM lname "Removing original links after new links are in place."++ -- Do the link manipulations, and report any errors.+ forM_ actualPaths $ \srcPath -> do+ result <- runRename opts $ processFile srcPath+ either (\em -> errorM lname $ printf "** Processing %s: %s\n" (op SrcPath srcPath) em)+ (const pure ()) result++ -- Perhaps we should get an ExitCode back from all this above?
+ src/lib/Photoname/Common.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE DeriveGeneric #-}++module Photoname.Common+ ( Artist (..)+ , ConfigPath (..)+ , CopySwitch (..)+ , DestPath (..)+ , MoveSwitch (..)+ , NoActionSwitch (..)+ , NoDirsSwitch (..)+ , ParentDir (..)+ , Options (..)+ , Ph+ , Prefix (..)+ , SrcPath (..)+ , Suffix (..)+ , Verbosity (..)+ , readVerbosity+ , runRename++ -- Re-exporting:+ , MonadError+ , ask, asks+ , liftIO+ , throwError+ )+ where++import Control.Monad.Except ( ExceptT, MonadError, runExceptT, throwError )+import Control.Monad.Reader ( ReaderT, ask, asks, runReaderT )+import Control.Monad.Trans ( liftIO )+import Control.Newtype.Generics+import GHC.Generics+import System.Log.Logger ( Priority (..) )+++data Verbosity+ = Quiet+ | Verbose Priority++instance Show Verbosity where+ show Quiet = "0"+ show (Verbose NOTICE) = "1"+ show (Verbose INFO) = "2"+ show (Verbose DEBUG) = "3"+ show _ = "Should never see this, invalid verbosity level being shown"++readVerbosity :: String -> Either String Verbosity+readVerbosity "0" = Right Quiet+readVerbosity "1" = Right $ Verbose NOTICE+readVerbosity "2" = Right $ Verbose INFO+readVerbosity "3" = Right $ Verbose DEBUG+readVerbosity _ = Left "Invalid verbosity level, expecting 0-3"+++newtype Artist = Artist String++newtype ConfigPath = ConfigPath FilePath++newtype CopySwitch = CopySwitch Bool+ deriving Generic++instance Newtype CopySwitch++newtype NoDirsSwitch = NoDirsSwitch Bool+ deriving Generic++instance Newtype NoDirsSwitch++newtype MoveSwitch = MoveSwitch Bool+ deriving Generic++instance Newtype MoveSwitch++newtype NoActionSwitch = NoActionSwitch Bool+ deriving Generic++instance Newtype NoActionSwitch++newtype ParentDir = ParentDir FilePath+ deriving Generic++instance Newtype ParentDir++newtype Prefix = Prefix String+ deriving Generic++instance Newtype Prefix++newtype Suffix = Suffix String+ deriving Generic++instance Newtype Suffix++data Options = Options+ { optArtist :: Maybe Artist+ , optConfig :: Maybe ConfigPath+ , optCopy :: CopySwitch+ , optNoDirs :: NoDirsSwitch+ , optMove :: MoveSwitch+ , optNoAction :: NoActionSwitch+ , optParentDir :: ParentDir+ , optPrefix :: Prefix+ , optSuffix :: Suffix+ , optVerbosity :: Verbosity+ , optPaths :: [FilePath]+ }+++newtype SrcPath = SrcPath FilePath+ deriving Generic++instance Newtype SrcPath++newtype DestPath = DestPath FilePath+ deriving Generic++instance Newtype DestPath+++type Ph a = ReaderT Options (ExceptT String IO) a+++runRename :: Options -> Ph a -> IO (Either String a)+runRename env action = runExceptT $ runReaderT action env
+ src/lib/Photoname/CopyLink.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Photoname.CopyLink+ ( createNewLink+ )+ where++import Control.Exception ( try )+import Control.Monad ( unless, when )+import Control.Newtype.Generics ( op )+import Data.Time.LocalTime ( LocalTime )+import GHC.IO.Exception ( IOException )+import System.Directory ( copyFile, createDirectoryIfMissing )+import System.FilePath ( (</>), takeDirectory )+import System.Posix ( createLink, fileExist, removeLink )+import Text.Printf ( printf )++import Photoname.Common ( CopySwitch (..), DestPath (..), MoveSwitch (..),+ NoActionSwitch (..), NoDirsSwitch (..), ParentDir (..), Options (..),+ Ph, Prefix (..), SrcPath (..), Suffix (..),+ ask, asks, liftIO, throwError )+import Photoname.Date+ ( PhDate (ExifDate, FilenameDate, NoDateFound)+ , formatDateHyphens, formatDateTime, formatYear+ )+import Photoname.Log ( lname, noticeM, warningM )+++createNewLink :: PhDate -> SrcPath -> Ph DestPath+createNewLink imageDate srcPath@(SrcPath srcFp) = do+ opts <- ask+ destPath@(DestPath destFp) <- case imageDate of+ ExifDate lt -> buildDatePath lt+ FilenameDate lt -> buildDatePath lt+ NoDateFound -> throwError "Could not extract any date information"++ -- Check for existance of the target file+ exists <- liftIO $ fileExist destFp+ when exists $ throwError $ "Destination " ++ destFp ++ " exists!"++ -- Display what will be done+ liftIO $ noticeM lname $ srcFp ++ " -> " ++ destFp++ unless (op NoActionSwitch . optNoAction $ opts) $ do+ -- Make the target dir+ liftIO $ createDirectoryIfMissing True $ takeDirectory destFp++ -- Make the new file+ if (op CopySwitch . optCopy $ opts)+ then liftIO $ copyFile srcFp destFp+ else tryHardLink srcPath destPath++ -- If user has specified, remove the original link+ when (op MoveSwitch . optMove $ opts) $+ liftIO $ removeLink srcFp++ pure destPath+++tryHardLink :: SrcPath -> DestPath -> Ph ()+tryHardLink (SrcPath srcFp) (DestPath destFp) = do+ ei <- liftIO $ try $ createLink srcFp destFp+ either failureHandler pure ei+ where+ failureHandler :: IOException -> Ph ()+ failureHandler _ = do+ liftIO $ warningM lname "Hard link failed, attempting to copy instead"+ liftIO $ copyFile srcFp destFp+++{- Construct the destination file path based on the information we have (parent+ dir, subdirs wanted or not, prefix and suffix, and the date info that was+ gathered).+-}+buildDatePath :: LocalTime -> Ph DestPath+buildDatePath date = do+ prefixStr <- asks (op Prefix . optPrefix)+ suffixStr <- asks (op Suffix . optSuffix)+ let fileName = printf "%s%s%s.jpg" prefixStr (formatDateTime date) suffixStr++ parentFp <- asks (op ParentDir . optParentDir)+ noDirs <- asks (op NoDirsSwitch . optNoDirs)+ pure . DestPath $ if (noDirs)+ then parentFp </> fileName+ else parentFp </> (formatYear date) </>+ (formatDateHyphens date) </> fileName
+ src/lib/Photoname/Date.hs view
@@ -0,0 +1,139 @@+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}+{-# LANGUAGE FlexibleContexts #-}++module Photoname.Date+ ( PhDate (..)+ , formatYear, formatDateHyphens, formatDate, formatDateTime+ , formatDateForExif+ , parseExifDate+ , parseFilenameDate+ )+ where++import Control.Newtype.Generics ( op )+import Data.Functor.Identity ( Identity )+import Data.Time.Calendar ( fromGregorian )+import Data.Time.Format ( defaultTimeLocale, formatTime )+import Data.Time.LocalTime ( LocalTime (..), TimeOfDay (..) )+import System.FilePath ( takeFileName )+import Text.Parsec ( ParsecT )+import Text.ParserCombinators.Parsec ( anyChar, char, count, digit,+ lookAhead, manyTill, parse, space, try )++import Photoname.Common ( SrcPath (..) )+++data PhDate+ = ExifDate LocalTime+ | FilenameDate LocalTime+ | NoDateFound+ deriving (Eq, Show)++instance Semigroup PhDate where+ (<>) e@(ExifDate _) _ = e+ (<>) (FilenameDate _) e@(ExifDate _) = e+ (<>) f@(FilenameDate _) _ = f+ (<>) NoDateFound x = x++instance Monoid PhDate where+ mempty = NoDateFound+++-- Parsec helper defs++colon :: ParsecT String u Identity Char+colon = char ':'++digit2, digit4 :: ParsecT String u Identity [Char]+digit2 = count 2 digit+digit4 = count 4 digit+++{- Parse a string in the form "yyyy:mm:dd hh:mm:ss" into a + CalendarTime datatype. Strings that fail to parse in this manner are+ returned as Nothing+-}+parseExifDate :: Maybe String -> PhDate+parseExifDate Nothing = NoDateFound+parseExifDate (Just s) =+ case (parse dateParser "" s) of+ Left _ -> NoDateFound+ Right x -> ExifDate x+ where+ dateParser = do+ year <- digit4 ; colon ; month <- digit2 ; colon ; day <- digit2+ space+ hour <- digit2 ; colon ; minute <- digit2+ colon ; second <- digit2+ pure $+ LocalTime+ (fromGregorian (read year) (read month) (read day))+ (TimeOfDay (read hour) (read minute)+ (fromIntegral ((read second) :: Integer)))+++{- Parse a string in one of the the forms below into a CalendarTime datatype.++ /some/path/ANYTHINGyyyy-mm-dd-hhmmss.jpg+ /some/path/ANYTHINGyyyy-mm-dd-hh-mm-ss-ttt.jpg+ ANYTHINGyyyy-mm-dd-hhmmss.jpg+ ANYTHINGyyyy-mm-dd-hh-mm-ss-ttt.jpg+ yyyymmdd-hhmmss.jpg+ yyyymmdd-hhmmss_xyz.jpg+ PXL_yyyymmdd_hhmmssttt.jpg+ PXL_yyyymmdd_hhmmssttt_xyz.jpg+-}+parseFilenameDate :: SrcPath -> PhDate+parseFilenameDate srcPath =+ case (parse dateParser "" (takeFileName . op SrcPath $ srcPath)) of+ Left _ -> NoDateFound+ Right x -> FilenameDate x+ where+ dateParser = do+ manyTill anyChar (try $ lookAhead digit4)+ year <- digit4+ manyTill anyChar (try $ lookAhead digit2)+ month <- digit2+ manyTill anyChar (try $ lookAhead digit2)+ day <- digit2+ manyTill anyChar (try $ lookAhead digit2)+ hour <- digit2+ manyTill anyChar (try $ lookAhead digit2)+ minute <- digit2+ manyTill anyChar (try $ lookAhead digit2)+ second <- digit2+ pure $+ LocalTime+ (fromGregorian (read year) (read month) (read day))+ (TimeOfDay (read hour) (read minute)+ (fromIntegral ((read second) :: Integer)))+++{- Format a Maybe CalendarTime into a "yyyy" string+-}+formatYear :: LocalTime -> String+formatYear = formatTime defaultTimeLocale "%Y"+++{- Format a Maybe CalendarTime into a "yyyy-mm-dd" string+-}+formatDateHyphens :: LocalTime -> String+formatDateHyphens = formatTime defaultTimeLocale "%Y-%m-%d"+++{- Format a Maybe CalendarTime into a "yyyymmdd" string+-}+formatDate :: LocalTime -> String+formatDate = formatTime defaultTimeLocale "%Y%m%d"+++{- Format a Maybe CalendarTime into a "yyyymmdd-HHMMSS" string+-}+formatDateTime :: LocalTime -> String+formatDateTime = formatTime defaultTimeLocale "%Y%m%d-%H%M%S"+++{- Format a Maybe CalendarTime into a "yyyy:mm:dd HH:MM:SS" string+-}+formatDateForExif :: LocalTime -> String+formatDateForExif = formatTime defaultTimeLocale "%Y:%m:%d %H:%M:%S"
+ src/lib/Photoname/Exif.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE FlexibleContexts #-}++module Photoname.Exif+ ( getExifDate+ )+ where++import Control.Monad.Except ( MonadIO, liftIO )+import Control.Newtype.Generics ( ala )+import qualified Data.Map as M+import Data.Monoid ( First (..) )+import Graphics.HsExif ( ExifTag, ExifValue, dateTime, dateTimeDigitized,+ dateTimeOriginal, parseFileExif )++import Photoname.Common ( SrcPath (..) )+++{-+ Load EXIF information from filepath, or evaluate to Nothing+-}++getExifDate :: MonadIO m => SrcPath -> m (Maybe String)+getExifDate (SrcPath fp) = liftIO $ extractDate <$> parseFileExif fp+++{-+ Extract the date from the passed in EXIF data, if we got any from the file.+ Evaluate to Nothing if we can't locate a date at all.+-}++extractDate :: Either String (M.Map ExifTag ExifValue) -> Maybe String+extractDate (Left _) = Nothing+extractDate (Right exifMap) =+ -- Find the first date available in the Map+ show <$> ( ala First foldMap $ map (flip M.lookup exifMap)+ [dateTimeOriginal, dateTimeDigitized, dateTime] )
+ src/lib/Photoname/Exiv2.hs view
@@ -0,0 +1,54 @@+module Photoname.Exiv2+ ( setArtist+ , setExifDate+ )+ where++import Control.Monad ( unless )+import Control.Newtype.Generics ( op )+import System.Process ( callCommand )+import Text.Printf ( printf )++import Photoname.Common ( Artist (..), DestPath (..), NoActionSwitch (..),+ Options (..), Ph, ask, liftIO )+import Photoname.Date ( PhDate (FilenameDate), formatDateForExif )+import Photoname.Log ( lname, noticeM )+++newtype Command = Command { unCommand :: String }+++execCommands :: [Command] -> Ph ()+execCommands commands = do+ opts <- ask++ -- Display what will be done+ liftIO $ mapM_ (noticeM lname . unCommand) commands++ -- Execute the commands+ unless (op NoActionSwitch . optNoAction $ opts) $+ liftIO $ mapM_ (callCommand . unCommand) commands++ pure ()+++setArtist :: DestPath -> Ph ()+setArtist (DestPath destFp) = do+ opts <- ask++ case optArtist opts of+ Nothing -> pure ()+ Just (Artist "") -> execCommands . map Command $+ [ printf "exiv2 --Modify 'del Exif.Image.Artist' %s" destFp ]+ Just (Artist artistInfo) -> execCommands . map Command $+ [ printf "exiv2 --Modify 'set Exif.Image.Artist %s' %s" artistInfo destFp ]+++setExifDate :: PhDate -> DestPath -> Ph ()++setExifDate (FilenameDate lt) (DestPath destFp) =+ execCommands . map Command $+ [ printf "exiv2 --Modify 'set Exif.Image.DateTime Ascii %s' --Modify 'set Exif.Photo.UserComment charset=Ascii DateTime is a guess' %s" (formatDateForExif lt) destFp+ ]++setExifDate _ _ = pure ()
+ src/lib/Photoname/Log.hs view
@@ -0,0 +1,45 @@+module Photoname.Log+ ( initLogging+ , lname+ , logTest++ -- Re-exported from System.Log+ , debugM, infoM, noticeM, warningM, errorM, criticalM, alertM, emergencyM+ )+ where++import System.IO ( Handle, stdout )+import System.Log.Handler.Simple ( GenericHandler, streamHandler )+import System.Log.Logger++import Photoname.Common ( Verbosity (Quiet, Verbose) )+++lname :: String+lname = rootLoggerName+++initLogging :: Verbosity -> IO ()+initLogging verbosity = do+ updateGlobalLogger lname . setHandlers =<< handlers verbosity+ case verbosity of+ Quiet -> pure ()+ Verbose loggerLevel -> updateGlobalLogger lname $ setLevel loggerLevel+++handlers :: Verbosity -> IO [GenericHandler Handle]+handlers Quiet = pure []+handlers (Verbose _) = sequence [streamHandler stdout DEBUG]+++-- Test function to generate every kind of log message+logTest :: IO ()+logTest = do+ debugM lname "log test message DEBUG 1 of 8"+ infoM lname "log test message INFO 2 of 8"+ noticeM lname "log test message NOTICE 3 of 8"+ warningM lname "log test message WARNING 4 of 8"+ errorM lname "log test message ERROR 5 of 8"+ criticalM lname "log test message CRITICAL 6 of 8"+ alertM lname "log test message ALERT 7 of 8"+ emergencyM lname "log test message EMERGENCY 8 of 8"
− src/photoname.hs
@@ -1,86 +0,0 @@--- License: BSD3 (see LICENSE)--- Author: Dino Morelli <dino@ui3.info>--{-# LANGUAGE FlexibleContexts #-}--import Control.Monad ( filterM, forM_, unless, when )-import System.Directory ( createDirectoryIfMissing )-import System.Environment ( getArgs )-import System.FilePath ( takeDirectory )-import System.Posix ( createLink, fileExist, getFileStatus,- isRegularFile, removeLink )-import Text.Printf ( printf )--import Photoname.Common ( Ph, ask, liftIO, runRename, throwError )-import Photoname.Opts ( Options (..) , parseOpts, usageText )-import Photoname.DateFormat ( buildDatePath )-import Photoname.SerialFormat ( buildSerialPath )---{- Take a file path to a JPEG file and use EXIF information available to- link the file at its new location below the given basedir.--}-createNewLink :: FilePath -> Ph ()-createNewLink oldPath = do- opts <- ask- newPath <- if (optOldStyle opts)- then buildSerialPath oldPath- else buildDatePath oldPath-- -- Check for existance of the target file- exists <- liftIO $ fileExist newPath- when exists $ throwError $ "Destination " ++ newPath ++ " exists!"-- -- Display what will be done- unless (optQuiet opts) $- liftIO $ putStrLn $ oldPath ++ " -> " ++ newPath-- unless (optNoAction opts) $ do- -- Make the target dir- liftIO $ createDirectoryIfMissing True $ takeDirectory newPath-- -- Make the new hard link- liftIO $ createLink oldPath newPath-- -- If user has specified, remove the original link- when (optMove opts) $- liftIO $ removeLink oldPath-- return ()----- Figure out and execute what the user wants based on the supplied args.-executeCommands :: Options -> [String] -> IO ()---- User gave no files at all. Display help-executeCommands _ [] = putStrLn usageText---- Normal program operation, process the files with the args.-executeCommands opts filePaths = do- -- Get rid of anything not a regular file from the list of paths- actualPaths <- filterM- (\p -> getFileStatus p >>= return . isRegularFile) filePaths-- -- Notify user of the switches that will be in effect.- when (optNoAction opts) $- putStrLn "No-action mode, nothing will be changed."-- when (optMove opts) $- putStrLn "Removing original links after new links are in place."-- -- Do the link manipulations, and report any errors.- forM_ actualPaths $ \path -> do- result <- runRename opts $ createNewLink path- either (\em -> printf "** Processing %s: %s\n" path em)- (const return ()) result---main :: IO ()-main = do- -- Parse the arguments- (opts, paths) <- getArgs >>= parseOpts-- -- Do the photo naming procedure- executeCommands opts paths-- -- Perhaps we should get an ExitCode back from all this above?
+ src/tests/Test/Photoname/Date.hs view
@@ -0,0 +1,81 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Test.Photoname.Date+ ( tests+ )+ where++import Data.Time.Calendar+import Data.Time.LocalTime+import Photoname.Common ( SrcPath (..) )+import Photoname.Date ( PhDate (..), parseExifDate, parseFilenameDate )+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck+++expectedLocalTime :: LocalTime+expectedLocalTime = LocalTime (fromGregorian 2021 10 04)+ (TimeOfDay 17 29 (fromIntegral (49 :: Integer)))+++tests :: TestTree+tests = testGroup "Photoname.Date"+ [ parsingTests+ , propsPhDate+ ]+++parsingTests :: TestTree+parsingTests = testGroup "parsing tests"+ [ testCase "parse a datetime in EXIF format" $+ ExifDate expectedLocalTime @=?+ (parseExifDate $ Just "2021:10:04 17:29:49")+ , testCase "parse a date from a file path with directories" $+ FilenameDate expectedLocalTime @=?+ parseFilenameDate (SrcPath "some/directory/signal-2021-10-04-172949.jpg")+ , testCase "parse a date from a file path with directories and more hyphens" $+ FilenameDate expectedLocalTime @=?+ parseFilenameDate (SrcPath "some/directory/signal-2021-10-04-17-29-49-942.jpg")+ , testCase "parse a date from a file path with no directories" $+ FilenameDate expectedLocalTime @=?+ parseFilenameDate (SrcPath "signal-2021-10-04-172949.jpg")+ , testCase "parse a date from a file path with more hyphens but no directories" $+ FilenameDate expectedLocalTime @=?+ parseFilenameDate (SrcPath "signal-2021-10-04-17-29-49-942.jpg")+ , testCase "parse a date from a previously-named file path" $+ FilenameDate expectedLocalTime @=?+ parseFilenameDate (SrcPath "20211004-172949.jpg")+ , testCase "parse a date from a previously-named file path with suffix" $+ FilenameDate expectedLocalTime @=?+ parseFilenameDate (SrcPath "20211004-172949_xyz.jpg")+ , testCase "parse a date from a Pixel phone path file path" $+ FilenameDate expectedLocalTime @=?+ parseFilenameDate (SrcPath "PXL_20211004_172949000.jpg")+ , testCase "parse a date from a Pixel phone path file path with extra suffix" $+ FilenameDate expectedLocalTime @=?+ parseFilenameDate (SrcPath "PXL_20211004_172949000_foo.jpg")+ ]+++instance Arbitrary PhDate where+ arbitrary = do+ oneof+ [ pure $ ExifDate expectedLocalTime+ , pure $ FilenameDate expectedLocalTime+ , pure NoDateFound+ ]++propsPhDate :: TestTree+propsPhDate = testGroup "testing the Semigroup and Monoid properties of PhDate"+ [ testProperty "Semigroup associativity x <> (y <> z) == (x <> y) <> z" $+ \(x :: PhDate) (y :: PhDate) (z :: PhDate) ->+ x <> (y <> z) == (x <> y) <> z+ , testProperty "Monoid right identity x <> mempty == x" $+ \(x :: PhDate) -> x <> mempty == x+ , testProperty "Monoid left identity mempty <> x == x" $+ \(x :: PhDate) -> mempty <> x == x+ , testProperty "Monoid concatenation mconcat xs == foldr (<>) mempty xs" $+ \(xs :: [PhDate]) -> mconcat xs == foldr (<>) mempty xs+ ]
+ src/tests/TestLink.hs view
@@ -0,0 +1,340 @@+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}++module TestLink+ ( tests+ )+ where++import System.Directory ( copyFile, removeDirectoryRecursive, removeFile )+import System.FilePath.Posix ( (</>), (<.>) )+import System.Posix.Files ( fileExist )+import System.Process ( waitForProcess )+import Text.Regex.Posix ( (=~) )+import Test.Tasty+import Test.Tasty.HUnit+import qualified Util+++parentDir, oldPath, newLinkPathDate :: FilePath++parentDir = Util.resourcesPath </> "testParentDir"+oldPath = Util.resourcesPath </> "dateTimeDigitized.jpg"+newLinkPathDate = parentDir </> "2003/2003-09-02/20030902-114303.jpg"+++tests :: TestTree+tests = testGroup "test the normal behavior of hard-linking original files to new paths"+ [ testLinkDigitized+ , testLinkOriginal+ , testLinkDate+ , testNoDate+ , testMove+ , testLinkNoAction+ , testLinkNoActionLong+ , testLinkQuiet+ , testLinkQuietLong+ , testLinkSuffix+ , testLinkPrefix+ , testNoExif+ , testNotAnImage+ , testDirForFile+ , testLinkFilenameDate+ ]+++testLinkDigitized :: TestTree+testLinkDigitized = testCase "tests for DateTimeDigitized" $ do+ -- Run the program with known input data+ (output, procH) <- Util.getBinaryOutput+ [ "--parent-dir=" ++ parentDir, oldPath ]+ waitForProcess procH++ -- Check that the correct output path exists+ existsNew <- fileExist newLinkPathDate+ assertBool "make link, date digitized: existance of new link" existsNew++ -- Check that old path still exists+ existsOld <- fileExist oldPath+ assertBool "make link, date digitized: existance of old link" existsOld++ -- Remove files and dirs that were created+ removeDirectoryRecursive parentDir++ -- Test output to stdout+ assertBool "make link, date digitized: correct output"+ (output =~ newLinkPathDate :: Bool)+++testLinkOriginal :: TestTree+testLinkOriginal = testCase "tests for DateTimeOriginal" $ do+ let digitizedOldPath = Util.resourcesPath </> "dateTimeOriginal.jpg"++ -- Run the program with known input data+ (output, procH) <- Util.getBinaryOutput+ [ "--parent-dir=" ++ parentDir, digitizedOldPath ]+ waitForProcess procH++ -- Check that the correct output path exists+ existsNew <- fileExist newLinkPathDate+ assertBool "make link, date original: existance of new link" existsNew++ -- Check that old path still exists+ existsOld <- fileExist digitizedOldPath+ assertBool "make link, date original: existance of old link" existsOld++ -- Remove files and dirs that were created+ removeDirectoryRecursive parentDir++ -- Test output to stdout+ assertBool "make link, date original: correct output"+ (output =~ newLinkPathDate :: Bool)+++testLinkDate :: TestTree+testLinkDate = testCase "tests for DateTime" $ do+ let dateOldPath = Util.resourcesPath </> "dateTime.jpg"+ let customLinkPathDate = parentDir </> "2019/2019-03-26/20190326-075309.jpg"++ -- Run the program with known input data+ (output, procH) <- Util.getBinaryOutput+ [ "--parent-dir=" ++ parentDir, dateOldPath ]+ waitForProcess procH++ -- Check that the correct output path exists+ existsNew <- fileExist customLinkPathDate+ assertBool "make link, date: existance of new link" existsNew++ -- Check that old path still exists+ existsOld <- fileExist dateOldPath+ assertBool "make link, date: existance of old link" existsOld++ -- Remove files and dirs that were created+ removeDirectoryRecursive parentDir++ -- Test output to stdout+ assertBool "make link, date: correct output"+ (output =~ customLinkPathDate :: Bool)+++testNoDate :: TestTree+testNoDate = testCase "test for no date in the file" $ do+ -- Run the program with known input data+ (output, procH) <- Util.getBinaryOutput+ [ "--parent-dir=" ++ parentDir, Util.resourcesPath </> "noDate.jpg" ]+ waitForProcess procH++ -- Test output to stdout+ assertBool "no EXIF: correct output"+ (output =~ "\\*\\* Processing util/resources/test/noDate.jpg: Could not extract any date information" :: Bool)+++testMove :: TestTree+testMove = testCase "tests to ensure the file is moved (original link removed)" $ do+ -- Make a dummy copy of the source file. This test will be getting rid+ -- of it, if successful.+ let newOldPath = Util.resourcesPath </> "moveTest.jpg"+ copyFile oldPath newOldPath++ -- Run the program with known input data+ (output, procH) <- Util.getBinaryOutput+ [ "--move", "--parent-dir=" ++ parentDir, newOldPath ]+ waitForProcess procH++ -- Check that the correct output path exists+ existsNew <- fileExist newLinkPathDate+ assertBool "move file: existance of new link" existsNew++ -- Check that old path still exists+ existsOld <- fileExist newOldPath+ Util.assertFalse "move file: existance of old link" existsOld++ -- Remove files and dirs that were created+ removeDirectoryRecursive parentDir++ -- Test output to stdout+ assertBool "move file: correct output"+ (output =~ newLinkPathDate :: Bool)+++testLinkNoAction :: TestTree+testLinkNoAction = testLinkNoAction' "no action" "-n"+++testLinkNoActionLong :: TestTree+testLinkNoActionLong = testLinkNoAction' "no action long" "--no-action"+++testLinkNoAction' :: String -> String -> TestTree+testLinkNoAction' label switch = testCase label $ do+ -- Run the program with known input data+ (output, procH) <- Util.getBinaryOutput+ [ switch, "--parent-dir=" ++ parentDir, oldPath ]+ waitForProcess procH++ -- Check that the correct output path exists+ existsNew <- fileExist parentDir+ Util.assertFalse (label ++ ": existance of new link") existsNew++ -- Check that old path still exists+ existsOld <- fileExist oldPath+ assertBool (label ++ ": existance of old link") existsOld++ -- Test output to stdout+ assertBool (label ++ ": correct output")+ (output =~ newLinkPathDate :: Bool)+++testLinkQuiet :: TestTree+testLinkQuiet = testLinkQuiet' "make link quiet" "-v0"+++testLinkQuietLong :: TestTree+testLinkQuietLong = testLinkQuiet' "make link quiet long" "--verbose 0"+++-- Reusable test code for above short/long versions of the quiet switch+testLinkQuiet' :: String -> String -> TestTree+testLinkQuiet' label switch = testCase label $ do+ -- Run the program with known input data+ (output, procH) <- Util.getBinaryOutput+ [ switch, "--parent-dir=" ++ parentDir, oldPath ]+ waitForProcess procH++ -- Check that the correct output path exists+ existsNew <- fileExist newLinkPathDate+ assertBool (label ++ ": existance of new link") existsNew++ -- Check that old path still exists+ existsOld <- fileExist oldPath+ assertBool (label ++ ": existance of old link") existsOld++ -- Remove files and dirs that were created+ removeDirectoryRecursive parentDir++ -- Test output to stdout+ Util.assertFalse (label ++ ": no output")+ (output =~ newLinkPathDate :: Bool)+++testLinkSuffix :: TestTree+testLinkSuffix = testCase "test link with a suffix" $ do+ let suffix = "_dwm"++ -- Run the program with known input data+ (output, procH) <- Util.getBinaryOutput+ [ "--parent-dir=" ++ parentDir, "--suffix=" ++ suffix, oldPath ]+ waitForProcess procH++ let newLinkPath = parentDir </>+ ("2003/2003-09-02/20030902-114303" ++ suffix) <.> "jpg"++ -- Check that the correct output path exists+ existsNew <- fileExist newLinkPath+ assertBool "make link: existance of new link" existsNew++ -- Check that old path still exists+ existsOld <- fileExist oldPath+ assertBool "make link: existance of old link" existsOld++ -- Remove files and dirs that were created+ removeDirectoryRecursive parentDir++ -- Test output to stdout+ assertBool "make link: correct output"+ (output =~ newLinkPath :: Bool)+++testLinkPrefix :: TestTree+testLinkPrefix = testCase "test link with a prefix" $ do+ let prefix = "SomeSubject_"++ -- Run the program with known input data+ (output, procH) <- Util.getBinaryOutput+ [ "--parent-dir=" ++ parentDir, "--prefix=" ++ prefix, oldPath ]+ waitForProcess procH++ let newLinkPath = parentDir </>+ ("2003/2003-09-02/" <> prefix <> "20030902-114303") <.> "jpg"++ -- Check that the correct output path exists+ existsNew <- fileExist newLinkPath+ assertBool "make link: existance of new link" existsNew++ -- Check that old path still exists+ existsOld <- fileExist oldPath+ assertBool "make link: existance of old link" existsOld++ -- Remove files and dirs that were created+ removeDirectoryRecursive parentDir++ -- Test output to stdout+ assertBool "make link: correct output"+ (output =~ newLinkPath :: Bool)+++testNoExif :: TestTree+testNoExif = testCase "test for a file without any EXIF data" $ do+ -- Run the program with known input data+ (output, procH) <- Util.getBinaryOutput+ [ "--parent-dir=" ++ parentDir, Util.resourcesPath </> "noExif.jpg" ]+ waitForProcess procH++ -- Test output to stdout+ assertBool "no EXIF: correct output"+ (output =~ "\\*\\* Processing util/resources/test/noExif.jpg: Could not extract any date information" :: Bool)+++testNotAnImage :: TestTree+testNotAnImage = testCase "test for a file that isn't an image" $ do+ -- Run the program with known input data+ (output, procH) <- Util.getBinaryOutput+ [ "--parent-dir=" ++ parentDir, Util.resourcesPath </> "notAnImage.txt" ]+ waitForProcess procH++ -- Test output to stdout+ assertBool "no EXIF: correct output"+ (output =~ "\\*\\* Processing util/resources/test/notAnImage.txt: Could not extract any date information" :: Bool)+++testDirForFile :: TestTree+testDirForFile = testCase "test when a directory is passed instead of a file" $ do+ -- Run the program with known input data+ (output, procH) <- Util.getBinaryOutput+ [ "--parent-dir=" ++ parentDir, Util.resourcesPath ]+ waitForProcess procH++ -- Test output to stdout+ assertBool "dir as file to change: correct output"+ (output =~ "" :: Bool)+++testLinkFilenameDate :: TestTree+testLinkFilenameDate = testCase "test to ensure the date can be acquired from the file name" $ do+ -- Make a dummy copy of the source file. This test will be modifying+ -- it, if successful.+ let newOldPath = Util.resourcesPath </> "copy-of-foobar-2021-10-04-17-29-49-942.jpg"+ copyFile (Util.resourcesPath </> "foobar-2021-10-04-17-29-49-942.jpg") newOldPath+ let newLinkPathDate' = parentDir </> "2021/2021-10-04/20211004-172949.jpg"++ -- Run the program with known input data+ (output, procH) <- Util.getBinaryOutput+ [ "--parent-dir=" ++ parentDir, newOldPath ]+ waitForProcess procH++ -- Check that the correct output path exists+ existsNew <- fileExist newLinkPathDate'+ assertBool "filename date: existance of new link" existsNew++ -- Check that old path still exists+ existsOld <- fileExist newOldPath+ assertBool "filename date: existance of old link" existsOld++ -- Remove files and dirs that were created+ removeFile newOldPath+ removeDirectoryRecursive parentDir++ -- WARNING We are NOT checking for the new EXIF tags in the files!!++ -- Test output to stdout+ assertBool "filename date: correct output"+ (output =~ newLinkPathDate' :: Bool)
+ src/tests/Util.hs view
@@ -0,0 +1,39 @@+module Util+ ( resourcesPath+ , getProcessOutput, getBinaryOutput+ , assertFalse+ )+ where++import Data.List ( intercalate )+import System.IO ( hGetContents )+import System.Process ( ProcessHandle, runInteractiveCommand )+import Test.Tasty.HUnit ( Assertion, assertBool )+++command :: String+command = "stack exec photoname"+++resourcesPath :: FilePath+resourcesPath = "util/resources/test"+++{- Quick and dirty function to run a process and grab its output.+ This evil thing doesn't watch STDERR at all or otherwise do anything+ even remotely safe.+-}+getProcessOutput :: String -> [String] -> IO (String, ProcessHandle)+getProcessOutput path' args = do+ (_, outH, _, procH) <- runInteractiveCommand+ $ path' ++ " -- " ++ (intercalate " " args)+ output <- hGetContents outH+ pure (output, procH)+++getBinaryOutput :: [String] -> IO (String, ProcessHandle)+getBinaryOutput = getProcessOutput command+++assertFalse :: String -> Bool -> Assertion+assertFalse l b = assertBool l $ not b
+ src/tests/runtests.hs view
@@ -0,0 +1,14 @@+module Main+ where++import Test.Tasty++import qualified TestLink ( tests )+import qualified Test.Photoname.Date ( tests )+++main :: IO ()+main = defaultMain $ testGroup " tests"+ [ Test.Photoname.Date.tests+ , TestLink.tests+ ]
stack.yaml view
@@ -1,7 +1,10 @@-resolver: lts-10.1+resolver: nightly-2021-11-15 packages: - . -extra-deps:-- exif-3000.0.0+extra-deps: []++flags:+ hsexif:+ iconv: false
+ stack.yaml.lock view
@@ -0,0 +1,12 @@+# This file was autogenerated by Stack.+# You should not edit this file by hand.+# For more information, please see the documentation at:+# https://docs.haskellstack.org/en/stable/lock_files++packages: []+snapshots:+- completed:+ size: 596363+ url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2021/11/15.yaml+ sha256: 4eb51ee07b71a0e11a4a9d32020ce6a5305e5a2f17da739afecdf7e876c78fec+ original: nightly-2021-11-15
− testsuite/TestHelp.hs
@@ -1,36 +0,0 @@--- License: BSD3 (see LICENSE)--- Author: Dino Morelli <dino@ui3.info>--module TestHelp (- testHelpAll-)- where--import qualified Util-import Test.HUnit ( Test (..), assertEqual )---testHelpAll :: Test-testHelpAll = TestList- [ TestLabel "testHelpSwitch" testHelpSwitch- , TestLabel "testHelpSwitchLong" testHelpSwitchLong- ]--expectedFirstLine :: String-expectedFirstLine = "Usage: photoname [OPTIONS] FILES"---testHelpSwitch :: Test-testHelpSwitch = TestCase $ do- (allOutput, _) <- Util.getBinaryOutput ["-h"]- assertEqual "-h switch output"- expectedFirstLine- $ head $ lines allOutput---testHelpSwitchLong :: Test-testHelpSwitchLong = TestCase $ do- (allOutput, _) <- Util.getBinaryOutput ["--help"]- assertEqual "--help switch output"- expectedFirstLine- $ head $ lines allOutput
− testsuite/TestLink.hs
@@ -1,247 +0,0 @@--- License: BSD3 (see LICENSE)--- Author: Dino Morelli <dino@ui3.info>--{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}--module TestLink (- testLinkAll-)- where--import System.Directory ( copyFile, removeDirectoryRecursive )-import System.FilePath.Posix ( (</>), (<.>) )-import System.Posix.Files ( fileExist )-import System.Process ( waitForProcess )-import Test.HUnit ( Test (..), assertBool )-import Text.Regex.Posix ( (=~) )-import qualified Util---{- Test the normal behavior of hard-linking the original file to a new- path.--}---testLinkAll :: Test-testLinkAll = TestList- [ TestLabel "testLinkDate" testLinkDate- , TestLabel "testLinkSerial" testLinkSerial- , TestLabel "testMove" testMove- , TestLabel "testLinkNoAction" testLinkNoAction- , TestLabel "testLinkNoActionLong" testLinkNoActionLong- , TestLabel "testLinkQuiet" testLinkQuiet- , TestLabel "testLinkQuietLong" testLinkQuietLong- , TestLabel "testLinkSuffix" testLinkSuffix- , TestLabel "testNoExif" testNoExif- , TestLabel "testNoSerial" testNoSerial- , TestLabel "testDirForFile" testDirForFile- ]---topDir, oldPath, newLinkPathDate, newLinkPathSerial :: FilePath--topDir = Util.resourcesPath </> "foo"-oldPath = Util.resourcesPath </> "img_1220.jpg"-newLinkPathDate = topDir </> "2003/2003-09-02/20030902-114303.jpg"-newLinkPathSerial = topDir </> "2003/2003-09-02/20030902_220.jpg"---testLinkDate :: Test-testLinkDate = TestCase $ do- -- Run the program with known input data- (output, procH) <- Util.getBinaryOutput- [ "--parent-dir=" ++ topDir, oldPath ]- waitForProcess procH-- -- Check that the correct output path exists- existsNew <- fileExist newLinkPathDate- assertBool "make link: existance of new link" existsNew-- -- Check that old path still exists- existsOld <- fileExist oldPath- assertBool "make link: existance of old link" existsOld-- -- Remove files and dirs that were created- removeDirectoryRecursive topDir-- -- Test output to stdout- assertBool "make link: correct output"- (output =~ newLinkPathDate :: Bool)---testLinkSerial :: Test-testLinkSerial = TestCase $ do- -- Run the program with known input data- (output, procH) <- Util.getBinaryOutput- [ "--parent-dir=" ++ topDir, "--old-style", oldPath ]- waitForProcess procH-- -- Check that the correct output path exists- existsNew <- fileExist newLinkPathSerial- assertBool "make link: existance of new link" existsNew-- -- Check that old path still exists- existsOld <- fileExist oldPath- assertBool "make link: existance of old link" existsOld-- -- Remove files and dirs that were created- removeDirectoryRecursive topDir-- -- Test output to stdout- assertBool "make link: correct output"- (output =~ newLinkPathSerial :: Bool)---testMove :: Test-testMove = TestCase $ do- let newNewLinkPath = topDir </> "2003/2003-09-02/20030902_321.jpg"-- -- Make a dummy copy of the source file. This test will be getting rid- -- of it, if successful.- let newOldPath = Util.resourcesPath </> "img_0321.jpg"- copyFile oldPath newOldPath-- -- Run the program with known input data- (output, procH) <- Util.getBinaryOutput- [ "--move", "--parent-dir=" ++ topDir, "--old-style", newOldPath ]- waitForProcess procH-- -- Check that the correct output path exists- existsNew <- fileExist newNewLinkPath- assertBool "move file: existance of new link" existsNew-- -- Check that old path still exists- existsOld <- fileExist newOldPath- Util.assertFalse "move file: existance of old link" existsOld-- -- Remove files and dirs that were created- removeDirectoryRecursive topDir-- -- Test output to stdout- assertBool "move file: correct output"- (output =~ newNewLinkPath :: Bool)---testLinkNoAction :: Test-testLinkNoAction = testLinkNoAction' "no action" "-n"---testLinkNoActionLong :: Test-testLinkNoActionLong = testLinkNoAction' "no action long" "--no-action"---testLinkNoAction' :: String -> String -> Test-testLinkNoAction' label switch = TestCase $ do- -- Run the program with known input data- (output, procH) <- Util.getBinaryOutput- [ switch, "--parent-dir=" ++ topDir, "--old-style", oldPath ]- waitForProcess procH-- -- Check that the correct output path exists- existsNew <- fileExist topDir- Util.assertFalse (label ++ ": existance of new link") existsNew-- -- Check that old path still exists- existsOld <- fileExist oldPath- assertBool (label ++ ": existance of old link") existsOld-- -- Test output to stdout- assertBool (label ++ ": correct output")- (output =~ newLinkPathSerial :: Bool)---testLinkQuiet :: Test-testLinkQuiet = testLinkQuiet' "make link quiet" "-q"---testLinkQuietLong :: Test-testLinkQuietLong = testLinkQuiet' "make link quiet long" "--quiet"----- Reusable test code for above short/long versions of the quiet switch-testLinkQuiet' :: String -> String -> Test-testLinkQuiet' label switch = TestCase $ do- -- Run the program with known input data- (output, procH) <- Util.getBinaryOutput- [ switch, "--parent-dir=" ++ topDir, "--old-style", oldPath ]- waitForProcess procH-- -- Check that the correct output path exists- existsNew <- fileExist newLinkPathSerial- assertBool (label ++ ": existance of new link") existsNew-- -- Check that old path still exists- existsOld <- fileExist oldPath- assertBool (label ++ ": existance of old link") existsOld-- -- Remove files and dirs that were created- removeDirectoryRecursive topDir-- -- Test output to stdout- Util.assertFalse (label ++ ": no output")- (output =~ newLinkPathSerial :: Bool)---testLinkSuffix :: Test-testLinkSuffix = TestCase $ do- let suffix = "_dwm"-- -- Run the program with known input data- (output, procH) <- Util.getBinaryOutput- [ "--parent-dir=" ++ topDir, "--suffix=" ++ suffix, oldPath ]- waitForProcess procH-- let newLinkPath = topDir </>- ("2003/2003-09-02/20030902-114303" ++ suffix) <.> "jpg"-- -- Check that the correct output path exists- existsNew <- fileExist newLinkPath- assertBool "make link: existance of new link" existsNew-- -- Check that old path still exists- existsOld <- fileExist oldPath- assertBool "make link: existance of old link" existsOld-- -- Remove files and dirs that were created- removeDirectoryRecursive topDir-- -- Test output to stdout- assertBool "make link: correct output"- (output =~ newLinkPath :: Bool)---testNoExif :: Test-testNoExif = TestCase $ do- -- Run the program with known input data- (output, procH) <- Util.getBinaryOutput- [ "--parent-dir=" ++ topDir, Util.resourcesPath </> "noExif.jpg" ]- waitForProcess procH-- -- Test output to stdout- assertBool "no EXIF: correct output"- (output =~ "\\*\\* Processing testsuite/resources/noExif.jpg: Failed EXIF loading" :: Bool)---testNoSerial :: Test-testNoSerial = TestCase $ do- -- Run the program with known input data- (output, procH) <- Util.getBinaryOutput- [ "--parent-dir=" ++ topDir- , "--old-style", Util.resourcesPath </> "noSerial.jpg" ]- waitForProcess procH-- -- Test output to stdout- assertBool "no serial in filename: correct output"- (output =~ "\\*\\* Processing testsuite/resources/noSerial.jpg: Can't determine serial" :: Bool)---testDirForFile :: Test-testDirForFile = TestCase $ do- -- Run the program with known input data- (output, procH) <- Util.getBinaryOutput- [ "--parent-dir=" ++ topDir, Util.resourcesPath ]- waitForProcess procH-- -- Test output to stdout- assertBool "dir as file to change: correct output"- (output =~ "" :: Bool)
− testsuite/Util.hs
@@ -1,42 +0,0 @@--- License: BSD3 (see LICENSE)--- Author: Dino Morelli <dino@ui3.info>--module Util (- resourcesPath,- getProcessOutput, getBinaryOutput,- assertFalse-)- where--import Data.List ( intercalate )-import System.IO ( hGetContents )-import System.Process ( ProcessHandle, runInteractiveCommand )-import Test.HUnit ( Assertion, assertBool )---command :: String-command = "stack exec photoname"---resourcesPath :: FilePath-resourcesPath = "testsuite/resources"---{- Quick and dirty function to run a process and grab its output.- This evil thing doesn't watch STDERR at all or otherwise do anything- even remotely safe.--}-getProcessOutput :: FilePath -> [String] -> IO (String, ProcessHandle)-getProcessOutput path' args = do- (_, outH, _, procH) <- runInteractiveCommand- $ path' ++ " -- " ++ (intercalate " " args)- output <- hGetContents outH- return (output, procH)---getBinaryOutput :: [String] -> IO (String, ProcessHandle)-getBinaryOutput = getProcessOutput command---assertFalse :: String -> Bool -> Assertion-assertFalse l b = assertBool l $ not b
− testsuite/resources/img_1220.jpg
binary file changed (78486 → absent bytes)
− testsuite/resources/noExif.jpg
@@ -1,1 +0,0 @@-This is not an image file at all!
− testsuite/resources/noSerial.jpg
binary file changed (78486 → absent bytes)
− testsuite/runtests.hs
@@ -1,32 +0,0 @@--- License: BSD3 (see LICENSE)--- Author: Dino Morelli <dino@ui3.info>--module Main- where--import System.Exit-import Test.HUnit ( Counts (..), Test (..), runTestTT )-import TestHelp-import TestLink---main :: IO ()-main = do- counts <- runTestTT tests- exit $ testsPassed counts---exit :: Bool -> IO ()-exit True = exitWith ExitSuccess-exit False = exitWith $ ExitFailure 1---testsPassed :: Counts -> Bool-testsPassed (Counts _ _ e f) = (e == 0) && (f == 0)---tests :: Test-tests = TestList- [ TestLabel "testHelpAll" testHelpAll- , TestLabel "testLinkAll" testLinkAll- ]
− util/install.hs
@@ -1,295 +0,0 @@-#! /usr/bin/env stack-{- stack runghc -}--{-# LANGUAGE ScopedTypeVariables #-}--import Control.Exception-import Control.Monad-import Data.List-import Distribution.Package-import Distribution.PackageDescription hiding ( error, options )-import Distribution.PackageDescription.Parse-import Distribution.Verbosity-import Distribution.Version-import System.Console.GetOpt-import System.Directory-import System.Environment-import System.Exit-import System.FilePath-import System.Process-import Text.Printf-import Text.Read---defaultOptions :: Options-defaultOptions = Options- { optClean = False- , optDelete = False- , optHelp = False- , optPrefix = "/opt"- , optRsrcCpVerbose = True- , optInstType = FHS- , optVersion = True- }--data InstallType = Bundle | FHS---main :: IO ()-main = do- -- Parse args- (opts, _) <- parseOpts =<< getArgs-- -- User asked for help- when (optHelp opts) $ putStrLn usageText >> exitSuccess-- -- Locate cabal file- cabalFiles <- (filter $ isSuffixOf ".cabal") <$> getDirectoryContents "."-- when (null cabalFiles) $ do- die "Can't continue because no cabal files were found in ."-- -- Parse the cabal file and extract things we need from it- -- then pass a pile of what we know to a function to create the- -- installation dirs- dirs <- constructDirs opts . package . packageDescription- <$> readGenericPackageDescription normal (head cabalFiles)--- -- Perform the installation-- -- Remove existing install directory- appDirExists <- doesDirectoryExist $ appDir dirs- when (optDelete opts && appDirExists) $ do- putStrLn $ "Removing existing directory " ++ (appDir dirs)- removeDirectoryRecursive $ appDir dirs-- -- Clean before building- when (optClean opts) $ system "stack clean" >> return ()-- -- Copy the binaries- installExitCode <- system $ "stack install --local-bin-path=" ++ (binDir dirs)- unless (ok installExitCode) $ die "Can't continue because stack install failed"-- -- Copy the license- putStrLn "\nCopying LICENSE"- createDirectoryIfMissing True $ docDir dirs- copyFile "LICENSE" (docDir dirs </> "LICENSE")-- -- Copy the resources- let rsrcDirSrc = "." </> "resources"- rsrcsExist <- doesDirectoryExist rsrcDirSrc- when rsrcsExist $ do- putStrLn $ "\nCopying resources"- copyTree (optRsrcCpVerbose opts) rsrcDirSrc (rsrcDir dirs)- return ()-- exitSuccess---data Dirs = Dirs- { appDir :: FilePath- , binDir :: FilePath- , docDir :: FilePath- , rsrcDir :: FilePath- }---constructDirs :: Options -> PackageId -> Dirs-constructDirs opts pkgId =- Dirs appDir binDir' (appDir </> "doc") (appDir </> "resources")-- where- project = unPackageName . pkgName $ pkgId- version = showVersion . pkgVersion $ pkgId- versionPart = if optVersion opts then "-" ++ version else ""- appDir = case (optInstType opts) of- Bundle -> optPrefix opts </> (project ++ versionPart)- FHS -> optPrefix opts </> "share" </> (project ++ versionPart)- binDir' = case (optInstType opts) of- Bundle -> appDir </> "bin"- FHS -> optPrefix opts </> "bin"---{- Turn an exit code (say, from system) into a Bool--}-ok :: ExitCode -> Bool-ok ExitSuccess = True-ok _ = False---{-- Argument parsing code--}--data Options = Options- { optClean :: Bool- , optDelete :: Bool- , optHelp :: Bool- , optPrefix :: FilePath- , optRsrcCpVerbose :: Bool- , optInstType :: InstallType- , optVersion :: Bool- }---instance Read InstallType where- readsPrec _ "bundle" = [(Bundle, "")]- readsPrec _ "fhs" = [(FHS, "")]- readsPrec _ _ = []--instance Show InstallType where- show Bundle = "bundle"- show FHS = "fhs"---readInstallType :: String -> InstallType-readInstallType s =- case (readEither s) of- Left _ -> error $ printf "Can't continue because %s is not a valid install type\n\n%s" s usageText- Right t -> t---options :: [OptDescr (Options -> Options)]-options =- [ Option ['c'] ["clean"]- (NoArg (\opts -> opts { optClean = True } ))- ("Do 'stack clean' first." ++ (defaultText . optClean $ defaultOptions))- , Option ['C'] ["no-clean"]- (NoArg (\opts -> opts { optClean = False } ))- ("Do not 'stack clean' first."- ++ (defaultText . not . optClean $ defaultOptions))- , Option ['d'] ["delete"]- (NoArg (\opts -> opts { optDelete = True } ))- ("Delete the app directory before copying files."- ++ (defaultText . optDelete $ defaultOptions))- , Option ['D'] ["no-delete"]- (NoArg (\opts -> opts { optDelete = False } ))- ("Do not delete the app directory before copying files."- ++ (defaultText . not . optDelete $ defaultOptions))- , Option ['h'] ["help"]- (NoArg (\opts -> opts { optHelp = True } ))- "This help information."- , Option ['p'] ["prefix"]- (ReqArg (\s opts -> opts { optPrefix = s } ) "PREFIX" )- (printf "Install prefix directory. Defaults to %s so what you'll end up with is %s/PROJECT-VERSION"- (optPrefix defaultOptions) (optPrefix defaultOptions))- , Option ['r'] ["resource-copy-verbose"]- (NoArg (\opts -> opts { optRsrcCpVerbose = True } ))- ("Be chatty when copying the resources directory."- ++ (defaultText . optRsrcCpVerbose $ defaultOptions))- , Option ['R'] ["no-resource-copy-verbose"]- (NoArg (\opts -> opts { optRsrcCpVerbose = False } ))- ("Don't be chatty when copying the resources directory. Useful when there are a LOT of resources."- ++ (defaultText . not . optRsrcCpVerbose $ defaultOptions))- , Option ['t'] ["type"]- (ReqArg (\s opts -> opts { optInstType = readInstallType s } ) "INST_TYPE" )- (printf "Installation type, see INSTALLATION TYPE below for details. Default: %s"- (show . optInstType $ defaultOptions))- , Option ['v'] ["version"]- (NoArg (\opts -> opts { optVersion = True } ))- (printf "Include version in installation path, meaning: %s/PROJECT-VERSION %s"- (optPrefix defaultOptions) (defaultText . optVersion $ defaultOptions))- , Option ['V'] ["no-version"]- (NoArg (\opts -> opts { optVersion = False } ))- (printf "Do not include version in installation path, meaning: %s/PROJECT %s"- (optPrefix defaultOptions) (defaultText . not . optVersion $ defaultOptions))- ]---defaultText :: Bool -> String-defaultText True = " Default"-defaultText False = ""---parseOpts :: [String] -> IO (Options, [String])-parseOpts args =- case getOpt Permute options args of- (o,n,[] ) -> return (foldl (flip id) defaultOptions o, n)- (_,_,errs) -> ioError $ userError (concat errs ++ usageText)---usageText :: String-usageText = (usageInfo header options) ++ "\n" ++ footer- where- header = init $ unlines- [ "Usage: install.hs [OPTIONS]"- , ""- , "options:"- ]- footer = init $ unlines- [ "INSTALLATION TYPE"- , ""- , "This is the topology used when copying files, one of: bundle, fhs"- , ""- , "bundle is sort-of a self-contained structure like this:"- , ""- , " $PREFIX/"- , " $PROJECT-$VERSION/ <-- this is the \"app directory\""- , " bin/..."- , " doc/LICENSE"- , " resources/..."- , ""- , "fhs is the more traditional UNIX structure like this:"- , ""- , " $PREFIX/"- , " bin/..."- , " share/"- , " $PROJECT-$VERSION/ <-- this is the \"app directory\""- , " doc/LICENSE"- , " resources/..."- , ""- , "Be aware that when the --delete switch is used along with fhs type, the binaries WILL NOT be deleted, only the \"app directory\"."- , ""- , "COMPILING"- , ""- , "install.hs was intentionally left as a script, but if you would prefer to compile it, do this:"- , ""- , " $ stack ghc -- -o util/install util/install.hs"- , ""- , ""- , "This script is part of the hsinstall package by Dino Morelli <dino@ui3.info>"- ]---{-- Recursive file copying code-- It was desireable to have a standalone recursive file copy in- this script for maximum cross-platform compatibility and to- avoid Haskell library dependencies.-- Many thanks to [abuzittin gillifirca](https://codereview.stackexchange.com/users/20251/abuzittin-gillifirca) for the StackOverflow post [Copying files in Haskell](https://codereview.stackexchange.com/questions/68908/copying-files-in-haskell) where the following code was lifted.--}--copyTree :: Bool -> FilePath -> FilePath -> IO ()-copyTree chatty s t = do- createDirectoryIfMissing True t- subItems <- getSubitems s- mapM_ (copyItem chatty s t) subItems---getSubitems :: FilePath -> IO [(Bool, FilePath)]-getSubitems path = getSubitems' ""- where- getChildren path = (\\ [".", ".."]) <$> getDirectoryContents path-- getSubitems' relPath = do- let absPath = path </> relPath- isDir <- doesDirectoryExist absPath- children <- if isDir then getChildren absPath else return []- let relChildren = [relPath </> p | p <- children]- ((isDir, relPath) :) . concat <$> mapM getSubitems' relChildren---copyItem :: Bool -> FilePath -> FilePath -> (Bool, FilePath) -> IO ()-copyItem chatty baseSourcePath baseTargetPath (isDir, relativePath) = do- let sourcePath = baseSourcePath </> relativePath- let targetPath = baseTargetPath </> relativePath-- when chatty $- putStrLn $ "Copying " ++ sourcePath ++ " to " ++ targetPath-- if isDir- then createDirectoryIfMissing False targetPath- else copyFile sourcePath targetPath
− util/resources/test.conf
@@ -1,4 +0,0 @@-move-old-style-parent-dir=~/mypics-suffix=_dwm
+ util/resources/test/dateTime.jpg view
binary file changed (absent → 82226 bytes)
+ util/resources/test/dateTimeDigitized.jpg view
binary file changed (absent → 82290 bytes)
+ util/resources/test/dateTimeOriginal.jpg view
binary file changed (absent → 82258 bytes)
+ util/resources/test/foobar-2021-10-04-17-29-49-942.jpg view
binary file changed (absent → 70806 bytes)
+ util/resources/test/noDate.jpg view
binary file changed (absent → 82194 bytes)
+ util/resources/test/noExif.jpg view
binary file changed (absent → 70806 bytes)
+ util/resources/test/notAnImage.txt view
@@ -0,0 +1,1 @@+This is not an image file at all!
+ util/resources/test/test.conf view
@@ -0,0 +1,3 @@+move+parent-dir=~/mypics+suffix=_dwm