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

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

-- * Relative Paths

-- | A data type encapsulating different kinds of relative or absolute paths.
data SystemPath = Path        FilePath  -- ^ A path that will just be passed through
                | InHomeDir   FilePath -- ^ A OS specific path relative to
                                      -- the home directory of a user.
                | InB9UserDir FilePath -- ^ A path relative to the @b9@ sub of
                                       -- the users application configuration
                                       -- directory 'getAppUserDataDirectory'
                | InTempDir   FilePath -- ^ A path relative to the systems
                                     -- temporary directory.
  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.
-- 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
      )
  )