{-|

Module      : ShowFile
Description : Effective Haskell exercises, Chapter 7 Understanding IO.
Copyright   : © Frank Jung, 2024
License     : GPL-3.0-only

-}

module ShowFile (
  -- * Types
    FileInfo (..)
  -- * Functions
  , noPasswd
  , showContent
  , makeAndReadFile
  , makeAndShow
  , safeIO
  , getFileInfo
  , showTime
  , parseTime
  ) where

import           Control.Monad    ((<=<))
import qualified Data.Time.Clock  as Clock
import           Data.Time.Format (defaultTimeLocale, formatTime, parseTimeM)
import qualified System.Directory as Dir

data FileInfo = FileInfo {
  FileInfo -> FilePath
_path  :: FilePath
, FileInfo -> Integer
_size  :: Integer
, FileInfo -> UTCTime
_mtime :: Clock.UTCTime
, FileInfo -> Bool
_read  :: Bool
, FileInfo -> Bool
_write :: Bool
, FileInfo -> Bool
_exec  :: Bool
} deriving (Int -> FileInfo -> ShowS
[FileInfo] -> ShowS
FileInfo -> FilePath
(Int -> FileInfo -> ShowS)
-> (FileInfo -> FilePath) -> ([FileInfo] -> ShowS) -> Show FileInfo
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileInfo -> ShowS
showsPrec :: Int -> FileInfo -> ShowS
$cshow :: FileInfo -> FilePath
show :: FileInfo -> FilePath
$cshowList :: [FileInfo] -> ShowS
showList :: [FileInfo] -> ShowS
Show)

-- | Show path except if `/etc/passwd`.
-- Better as an Either, filename or "invalid file error".
noPasswd :: FilePath -> IO String
noPasswd :: FilePath -> IO FilePath
noPasswd FilePath
path
  | FilePath
path FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"/etc/passwd" = FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"no passwd"
  | Bool
otherwise = FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path

-- | Show file content.
showContent :: FilePath -> IO String
showContent :: FilePath -> IO FilePath
showContent = FilePath -> IO FilePath
noPasswd

-- | Make and read a file.
-- Write and then read a file.
makeAndReadFile :: Int -> IO String
makeAndReadFile :: Int -> IO FilePath
makeAndReadFile Int
fnumber =
  let fname :: FilePath
fname = FilePath
"/tmp/test-" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
fnumber
  in FilePath -> FilePath -> IO ()
writeFile FilePath
fname FilePath
fname IO () -> IO FilePath -> IO FilePath
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO FilePath
readFile FilePath
fname

-- | Make and show file helper function.
-- Write and read a file.
makeAndShow :: Int -> IO ()
makeAndShow :: Int -> IO ()
makeAndShow = FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> (Int -> IO FilePath) -> Int -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Int -> IO FilePath
makeAndReadFile

-- | Test writing and reading a number of files.
-- Efficient sequencing of IO actions ensuring file handle is closed.
safeIO :: Int -> IO ()
safeIO :: Int -> IO ()
safeIO Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
100000 = (Int -> IO ()) -> [Int] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Int -> IO ()
makeAndShow [Int
1..Int
n]
  | Bool
otherwise = FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error FilePath
"Must be a positive number between 1 and 100,000."

-- | Get file info.
getFileInfo :: FilePath -> IO FileInfo
getFileInfo :: FilePath -> IO FileInfo
getFileInfo FilePath
filePath = do
  Integer
size <- FilePath -> IO Integer
Dir.getFileSize FilePath
filePath
  UTCTime
mtime <- FilePath -> IO UTCTime
Dir.getModificationTime FilePath
filePath
  Permissions
perms <- FilePath -> IO Permissions
Dir.getPermissions FilePath
filePath
  FileInfo -> IO FileInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FileInfo -> IO FileInfo) -> FileInfo -> IO FileInfo
forall a b. (a -> b) -> a -> b
$ FileInfo {
    _path :: FilePath
_path = FilePath
filePath
  , _size :: Integer
_size = Integer
size
  , _mtime :: UTCTime
_mtime = UTCTime
mtime
  , _read :: Bool
_read = Permissions -> Bool
Dir.readable Permissions
perms
  , _write :: Bool
_write = Permissions -> Bool
Dir.writable Permissions
perms
  , _exec :: Bool
_exec = Permissions -> Bool
Dir.executable Permissions
perms
  }

-- | Helper function to convert UTCTime to ISO date string.
showTime :: Clock.UTCTime -> String
showTime :: UTCTime -> FilePath
showTime = TimeLocale -> FilePath -> UTCTime -> FilePath
forall t. FormatTime t => TimeLocale -> FilePath -> t -> FilePath
formatTime TimeLocale
defaultTimeLocale FilePath
"%Y-%m-%dT%T%Z"

-- | Helper function to convert ISO date string to UTCTime.
--
-- ISO date/time format string is "%Y-%m-%dT%T%Z"
--
-- Example: @"2023-11-22T04:27:27Z"@
parseTime :: String -> Maybe Clock.UTCTime
parseTime :: FilePath -> Maybe UTCTime
parseTime = Bool -> TimeLocale -> FilePath -> FilePath -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> FilePath -> FilePath -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale FilePath
"%Y-%m-%dT%T%Z"