{-# LANGUAGE OverloadedStrings #-}

module Photoname.Links
  ( describeHardLinkPolicy
  , linksTest
  )
  where

import Formatting ((%+), formatToString, int)
import System.Posix (FileStatus, linkCount)

import Photoname.Common (Links (Exactly, NoLimit))
import Photoname.Log (lname, noticeM)


linksTest :: Links -> FileStatus -> Bool
linksTest :: Links -> FileStatus -> Bool
linksTest (Exactly CNlink
linkCountWanted) FileStatus
fileStatus = CNlink
linkCountWanted CNlink -> CNlink -> Bool
forall a. Eq a => a -> a -> Bool
== FileStatus -> CNlink
linkCount FileStatus
fileStatus
linksTest Links
NoLimit                   FileStatus
_          = Bool
True


describeHardLinkPolicy :: Links -> IO ()
describeHardLinkPolicy :: Links -> IO ()
describeHardLinkPolicy Links
l = case Links
l of
  Exactly CNlink
1 -> String -> String -> IO ()
noticeM String
lname String
"Only processing files with 1 hard link"
  Exactly CNlink
n -> String -> String -> IO ()
noticeM String
lname (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Format String (Integer -> String) -> Integer -> String
forall a. Format String a -> a
formatToString
    (Format (Integer -> String) (Integer -> String)
"Only processing files with" Format (Integer -> String) (Integer -> String)
-> Format String (Integer -> String)
-> Format String (Integer -> String)
forall r a r'. Format r a -> Format r' r -> Format r' a
%+ Format String (Integer -> String)
forall a r. Integral a => Format r (a -> r)
int Format String (Integer -> String)
-> Format String String -> Format String (Integer -> String)
forall r a r'. Format r a -> Format r' r -> Format r' a
%+ Format String String
"hard links") (CNlink -> Integer
forall a. Integral a => a -> Integer
toInteger CNlink
n)
  Links
NoLimit   -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()