-- | 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 (SystemPath -> SystemPath -> Bool
(SystemPath -> SystemPath -> Bool)
-> (SystemPath -> SystemPath -> Bool) -> Eq SystemPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemPath -> SystemPath -> Bool
$c/= :: SystemPath -> SystemPath -> Bool
== :: SystemPath -> SystemPath -> Bool
$c== :: SystemPath -> SystemPath -> Bool
Eq, ReadPrec [SystemPath]
ReadPrec SystemPath
Int -> ReadS SystemPath
ReadS [SystemPath]
(Int -> ReadS SystemPath)
-> ReadS [SystemPath]
-> ReadPrec SystemPath
-> ReadPrec [SystemPath]
-> Read SystemPath
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SystemPath]
$creadListPrec :: ReadPrec [SystemPath]
readPrec :: ReadPrec SystemPath
$creadPrec :: ReadPrec SystemPath
readList :: ReadS [SystemPath]
$creadList :: ReadS [SystemPath]
readsPrec :: Int -> ReadS SystemPath
$creadsPrec :: Int -> ReadS SystemPath
Read, Int -> SystemPath -> ShowS
[SystemPath] -> ShowS
SystemPath -> String
(Int -> SystemPath -> ShowS)
-> (SystemPath -> String)
-> ([SystemPath] -> ShowS)
-> Show SystemPath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SystemPath] -> ShowS
$cshowList :: [SystemPath] -> ShowS
show :: SystemPath -> String
$cshow :: SystemPath -> String
showsPrec :: Int -> SystemPath -> ShowS
$cshowsPrec :: Int -> SystemPath -> ShowS
Show, Typeable, Typeable SystemPath
DataType
Constr
Typeable SystemPath
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SystemPath -> c SystemPath)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SystemPath)
-> (SystemPath -> Constr)
-> (SystemPath -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SystemPath))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SystemPath))
-> ((forall b. Data b => b -> b) -> SystemPath -> SystemPath)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SystemPath -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SystemPath -> r)
-> (forall u. (forall d. Data d => d -> u) -> SystemPath -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SystemPath -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SystemPath -> m SystemPath)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SystemPath -> m SystemPath)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SystemPath -> m SystemPath)
-> Data SystemPath
SystemPath -> DataType
SystemPath -> Constr
(forall b. Data b => b -> b) -> SystemPath -> SystemPath
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SystemPath -> c SystemPath
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SystemPath
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SystemPath -> u
forall u. (forall d. Data d => d -> u) -> SystemPath -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SystemPath -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SystemPath -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SystemPath -> m SystemPath
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SystemPath -> m SystemPath
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SystemPath
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SystemPath -> c SystemPath
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SystemPath)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SystemPath)
$cInTempDir :: Constr
$cInB9UserDir :: Constr
$cInHomeDir :: Constr
$cPath :: Constr
$tSystemPath :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SystemPath -> m SystemPath
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SystemPath -> m SystemPath
gmapMp :: (forall d. Data d => d -> m d) -> SystemPath -> m SystemPath
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SystemPath -> m SystemPath
gmapM :: (forall d. Data d => d -> m d) -> SystemPath -> m SystemPath
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SystemPath -> m SystemPath
gmapQi :: Int -> (forall d. Data d => d -> u) -> SystemPath -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SystemPath -> u
gmapQ :: (forall d. Data d => d -> u) -> SystemPath -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SystemPath -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SystemPath -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SystemPath -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SystemPath -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SystemPath -> r
gmapT :: (forall b. Data b => b -> b) -> SystemPath -> SystemPath
$cgmapT :: (forall b. Data b => b -> b) -> SystemPath -> SystemPath
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SystemPath)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SystemPath)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SystemPath)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SystemPath)
dataTypeOf :: SystemPath -> DataType
$cdataTypeOf :: SystemPath -> DataType
toConstr :: SystemPath -> Constr
$ctoConstr :: SystemPath -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SystemPath
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SystemPath
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SystemPath -> c SystemPath
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SystemPath -> c SystemPath
$cp1Data :: Typeable SystemPath
Data)

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

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

-- * File System Directory Utilities

-- | Get all files from 'dir' that is get ONLY files not directories
getDirectoryFiles :: MonadIO m => FilePath -> m [FilePath]
getDirectoryFiles :: String -> m [String]
getDirectoryFiles String
dir = do
  [String]
entries <- IO [String] -> m [String]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO [String]
getDirectoryContents String
dir)
  [Bool]
fileEntries <- (String -> m Bool) -> [String] -> m [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> (String -> IO Bool) -> String -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO Bool
doesFileExist (String -> IO Bool) -> ShowS -> String -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
dir String -> ShowS
</>)) [String]
entries
  [String] -> m [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ((Bool, String) -> String
forall a b. (a, b) -> b
snd ((Bool, String) -> String) -> [(Bool, String)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Bool, String) -> Bool) -> [(Bool, String)] -> [(Bool, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool, String) -> Bool
forall a b. (a, b) -> a
fst ([Bool]
fileEntries [Bool] -> [String] -> [(Bool, String)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [String]
entries))

-- | Create all missing parent directories of a file path.
--
-- @since 1.1.0
ensureSystemPath :: MonadIO m => SystemPath -> m ()
ensureSystemPath :: SystemPath -> m ()
ensureSystemPath =
  SystemPath -> m String
forall (m :: * -> *). MonadIO m => SystemPath -> m String
resolve (SystemPath -> m String) -> (String -> m ()) -> SystemPath -> m ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (String -> IO ()) -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String -> IO ()
createDirectoryIfMissing Bool
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 :: String -> m ()
ensureDir String
p = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ ShowS
takeDirectory String
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 :: String -> a -> m ()
prettyPrintToFile String
f a
x = do
  String -> m ()
forall (m :: * -> *). MonadIO m => String -> m ()
ensureDir String
f
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> String -> IO ()
writeFile String
f (a -> String
forall a. Show a => a -> String
ppShow a
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 :: String -> m a
consult String
f = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ do
  String
c <- String -> IO String
readFile String
f
  case String -> Either String a
forall a. Read a => String -> Either String a
readEither String
c of
    Left String
e -> ConsultException -> IO a
forall e a. Exception e => e -> IO a
throwIO (ConsultException -> IO a) -> ConsultException -> IO a
forall a b. (a -> b) -> a -> b
$ String -> String -> ConsultException
ConsultException String
f String
e
    Right a
a -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

-- | An 'Exception' thrown by 'consult' to indicate the file does not
-- contain a 'read'able String
data ConsultException = ConsultException FilePath String
  deriving (Int -> ConsultException -> ShowS
[ConsultException] -> ShowS
ConsultException -> String
(Int -> ConsultException -> ShowS)
-> (ConsultException -> String)
-> ([ConsultException] -> ShowS)
-> Show ConsultException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConsultException] -> ShowS
$cshowList :: [ConsultException] -> ShowS
show :: ConsultException -> String
$cshow :: ConsultException -> String
showsPrec :: Int -> ConsultException -> ShowS
$cshowsPrec :: Int -> ConsultException -> ShowS
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 (ReadPrec [UUID]
ReadPrec UUID
Int -> ReadS UUID
ReadS [UUID]
(Int -> ReadS UUID)
-> ReadS [UUID] -> ReadPrec UUID -> ReadPrec [UUID] -> Read UUID
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UUID]
$creadListPrec :: ReadPrec [UUID]
readPrec :: ReadPrec UUID
$creadPrec :: ReadPrec UUID
readList :: ReadS [UUID]
$creadList :: ReadS [UUID]
readsPrec :: Int -> ReadS UUID
$creadsPrec :: Int -> ReadS UUID
Read, Int -> UUID -> ShowS
[UUID] -> ShowS
UUID -> String
(Int -> UUID -> ShowS)
-> (UUID -> String) -> ([UUID] -> ShowS) -> Show UUID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UUID] -> ShowS
$cshowList :: [UUID] -> ShowS
show :: UUID -> String
$cshow :: UUID -> String
showsPrec :: Int -> UUID -> ShowS
$cshowsPrec :: Int -> UUID -> ShowS
Show, UUID -> UUID -> Bool
(UUID -> UUID -> Bool) -> (UUID -> UUID -> Bool) -> Eq UUID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UUID -> UUID -> Bool
$c/= :: UUID -> UUID -> Bool
== :: UUID -> UUID -> Bool
$c== :: UUID -> UUID -> Bool
Eq, Eq UUID
Eq UUID
-> (UUID -> UUID -> Ordering)
-> (UUID -> UUID -> Bool)
-> (UUID -> UUID -> Bool)
-> (UUID -> UUID -> Bool)
-> (UUID -> UUID -> Bool)
-> (UUID -> UUID -> UUID)
-> (UUID -> UUID -> UUID)
-> Ord UUID
UUID -> UUID -> Bool
UUID -> UUID -> Ordering
UUID -> UUID -> UUID
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UUID -> UUID -> UUID
$cmin :: UUID -> UUID -> UUID
max :: UUID -> UUID -> UUID
$cmax :: UUID -> UUID -> UUID
>= :: UUID -> UUID -> Bool
$c>= :: UUID -> UUID -> Bool
> :: UUID -> UUID -> Bool
$c> :: UUID -> UUID -> Bool
<= :: UUID -> UUID -> Bool
$c<= :: UUID -> UUID -> Bool
< :: UUID -> UUID -> Bool
$c< :: UUID -> UUID -> Bool
compare :: UUID -> UUID -> Ordering
$ccompare :: UUID -> UUID -> Ordering
$cp1Ord :: Eq UUID
Ord)

instance PrintfArg UUID where
  formatArg :: UUID -> FieldFormatter
formatArg (UUID (Word32
a, Word16
b, Word16
c, Word16
d, Word32
e, Word16
f)) FieldFormat
fmt
    | FieldFormat -> Char
fmtChar (Char -> FieldFormat -> FieldFormat
vFmt Char
'U' FieldFormat
fmt) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'U' =
      let str :: String
str = (String
-> Word32
-> Word16
-> Word16
-> Word16
-> Word32
-> Word16
-> String
forall r. PrintfType r => String -> r
printf String
"%08x-%04x-%04x-%04x-%08x%04x" Word32
a Word16
b Word16
c Word16
d Word32
e Word16
f :: String)
       in String -> FieldFormatter
forall a. IsChar a => [a] -> FieldFormatter
formatString String
str (FieldFormat
fmt {fmtChar :: Char
fmtChar = Char
's', fmtPrecision :: Maybe Int
fmtPrecision = Maybe Int
forall a. Maybe a
Nothing})
    | Bool
otherwise =
      Char -> ShowS
forall a. Char -> a
errorBadFormat (Char -> ShowS) -> Char -> ShowS
forall a b. (a -> b) -> a -> b
$ FieldFormat -> Char
fmtChar FieldFormat
fmt

-- | Generate a random 'UUID'.
randomUUID :: MonadIO m => m UUID
randomUUID :: m UUID
randomUUID =
  IO UUID -> m UUID
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    ( (Word32, Word16, Word16, Word16, Word32, Word16) -> UUID
UUID
        ((Word32, Word16, Word16, Word16, Word32, Word16) -> UUID)
-> IO (Word32, Word16, Word16, Word16, Word32, Word16) -> IO UUID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( (,,,,,)
                (Word32
 -> Word16
 -> Word16
 -> Word16
 -> Word32
 -> Word16
 -> (Word32, Word16, Word16, Word16, Word32, Word16))
-> IO Word32
-> IO
     (Word16
      -> Word16
      -> Word16
      -> Word32
      -> Word16
      -> (Word32, Word16, Word16, Word16, Word32, Word16))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Word32
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO
                IO
  (Word16
   -> Word16
   -> Word16
   -> Word32
   -> Word16
   -> (Word32, Word16, Word16, Word16, Word32, Word16))
-> IO Word16
-> IO
     (Word16
      -> Word16
      -> Word32
      -> Word16
      -> (Word32, Word16, Word16, Word16, Word32, Word16))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Word16
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO
                IO
  (Word16
   -> Word16
   -> Word32
   -> Word16
   -> (Word32, Word16, Word16, Word16, Word32, Word16))
-> IO Word16
-> IO
     (Word16
      -> Word32
      -> Word16
      -> (Word32, Word16, Word16, Word16, Word32, Word16))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Word16
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO
                IO
  (Word16
   -> Word32
   -> Word16
   -> (Word32, Word16, Word16, Word16, Word32, Word16))
-> IO Word16
-> IO
     (Word32
      -> Word16 -> (Word32, Word16, Word16, Word16, Word32, Word16))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Word16
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO
                IO
  (Word32
   -> Word16 -> (Word32, Word16, Word16, Word16, Word32, Word16))
-> IO Word32
-> IO (Word16 -> (Word32, Word16, Word16, Word16, Word32, Word16))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Word32
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO
                IO (Word16 -> (Word32, Word16, Word16, Word16, Word32, Word16))
-> IO Word16 -> IO (Word32, Word16, Word16, Word16, Word32, Word16)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Word16
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO
            )
    )

removeIfExists :: FilePath -> IO ()
removeIfExists :: String -> IO ()
removeIfExists String
fileName = String -> IO ()
removeFile String
fileName IO () -> (IOError -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` IOError -> IO ()
handleExists
  where
    handleExists :: IOError -> IO ()
handleExists IOError
e
      | IOError -> Bool
isDoesNotExistError IOError
e = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | Bool
otherwise = IOError -> IO ()
forall e a. Exception e => e -> IO a
throwIO IOError
e