-- | Some utilities to deal with IO in B9.
module System.IO.B9Extras
  ( SystemPath (..),
    overSystemPath,
    resolve,
    ensureSystemPath,
    ensureDir,
    getDirectoryFiles,
    prettyPrintToFile,
    consult,
    ConsultException (..),
    randomUUID,
    UUID (),
    removeIfExists,
  )
where

import Control.Exception
import Control.Monad.Except
import Data.Data
import Data.Word
  ( Word16,
    Word32,
  )
import System.Directory
import System.FilePath
import System.IO.Error
import System.Random (randomIO)
import Text.Printf
import Text.Read (readEither)
import Text.Show.Pretty (ppShow)

-- * Relative Paths

-- | A data type encapsulating different kinds of relative or absolute paths.
data SystemPath
  = -- | A path that will just be passed through
    Path FilePath
  | -- | A OS specific path relative to
    -- the home directory of a user.
    InHomeDir FilePath
  | -- | A path relative to the @b9@ sub of
    -- the users application configuration
    -- directory 'getAppUserDataDirectory'
    InB9UserDir FilePath
  | -- | A path relative to the systems
    -- temporary directory.
    InTempDir FilePath
  deriving (Eq, Read, Show, Typeable, Data)

-- | Transform a 'SystemPath'
overSystemPath :: (FilePath -> FilePath) -> SystemPath -> SystemPath
overSystemPath f sp =
  case sp of
    Path p -> Path (f p)
    InHomeDir p -> InHomeDir (f p)
    InB9UserDir p -> InB9UserDir (f p)
    InTempDir p -> InTempDir (f p)

-- | Convert a 'SystemPath' to a 'FilePath'.
resolve :: MonadIO m => SystemPath -> m FilePath
resolve (Path p) = return p
resolve (InHomeDir p) = liftIO $ do
  d <- getHomeDirectory
  return $ d </> p
resolve (InB9UserDir p) = liftIO $ do
  d <- getAppUserDataDirectory "b9"
  return $ d </> p
resolve (InTempDir p) = liftIO $ do
  d <- getTemporaryDirectory
  return $ d </> p

-- * File System Directory Utilities

-- | Get all files from 'dir' that is get ONLY files not directories
getDirectoryFiles :: MonadIO m => FilePath -> m [FilePath]
getDirectoryFiles dir = do
  entries <- liftIO (getDirectoryContents dir)
  fileEntries <- mapM (liftIO . doesFileExist . (dir </>)) entries
  return (snd <$> filter fst (fileEntries `zip` entries))

-- | Create all missing parent directories of a file path.
--
-- @since 1.1.0
ensureSystemPath :: MonadIO m => SystemPath -> m ()
ensureSystemPath =
  resolve >=> liftIO . createDirectoryIfMissing True

-- | Create all missing parent directories of a file path.
-- Note that the file path is assumed to be of a regular file, and
-- 'takeDirectory' is applied before creating the directory.
ensureDir :: MonadIO m => FilePath -> m ()
ensureDir p = liftIO (createDirectoryIfMissing True $ takeDirectory p)

-- * Reading and Writing from/to Files

-- | Write a value of a type that is an instance of 'Show' to file.
-- This function uses 'ppShow' instead of the given 'Show' instance.
prettyPrintToFile :: (MonadIO m, Show a) => FilePath -> a -> m ()
prettyPrintToFile f x = do
  ensureDir f
  liftIO (writeFile f (ppShow x))

-- | Read a value of a type that is an instance of 'Read' from a file.
-- This function throws a 'ConsultException' when the read the file failed.
consult :: (MonadIO m, Read a) => FilePath -> m a
consult f = liftIO $ do
  c <- readFile f
  case readEither c of
    Left e -> throwIO $ ConsultException f e
    Right a -> return a

-- | An 'Exception' thrown by 'consult' to indicate the file does not
-- contain a 'read'able String
data ConsultException = ConsultException FilePath String
  deriving (Show, Typeable)

instance Exception ConsultException

-- * Unique Random IDs

-- | A bunch of numbers, enough to make globally unique IDs. Create one of these
-- using 'randomUUID'.
newtype UUID = UUID (Word32, Word16, Word16, Word16, Word32, Word16)
  deriving (Read, Show, Eq, Ord)

instance PrintfArg UUID where
  formatArg (UUID (a, b, c, d, e, f)) fmt
    | fmtChar (vFmt 'U' fmt) == 'U' =
      let str = (printf "%08x-%04x-%04x-%04x-%08x%04x" a b c d e f :: String)
       in formatString str (fmt {fmtChar = 's', fmtPrecision = Nothing})
    | otherwise =
      errorBadFormat $ fmtChar fmt

-- | Generate a random 'UUID'.
randomUUID :: MonadIO m => m UUID
randomUUID =
  liftIO
    ( UUID
        <$> ( (,,,,,)
                <$> randomIO
                <*> randomIO
                <*> randomIO
                <*> randomIO
                <*> randomIO
                <*> randomIO
            )
    )

removeIfExists :: FilePath -> IO ()
removeIfExists fileName = removeFile fileName `catch` handleExists
  where
    handleExists e
      | isDoesNotExistError e = return ()
      | otherwise = throwIO e