{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | Utility functions that may be ultimately moved to some library.
module Data.Aeson.AutoType.Util( withFileOrHandle
                               , withFileOrDefaultHandle
                               ) where

import           Data.Hashable
import qualified Data.Set as Set
import           System.IO                 (withFile, IOMode(..), Handle, stdin, stdout)

-- | Generic function for opening file if the filename is not empty nor "-",
--   or using given handle otherwise (probably stdout, stderr, or stdin).
-- TODO: Should it become utility function?
withFileOrHandle :: FilePath -> IOMode -> Handle -> (Handle -> IO r) -> IO r
withFileOrHandle :: FilePath -> IOMode -> Handle -> (Handle -> IO r) -> IO r
withFileOrHandle        ""       _         handle :: Handle
handle action :: Handle -> IO r
action =                      Handle -> IO r
action Handle
handle
withFileOrHandle        "-"      _         handle :: Handle
handle action :: Handle -> IO r
action =                      Handle -> IO r
action Handle
handle
withFileOrHandle        name :: FilePath
name     ioMode :: IOMode
ioMode    _      action :: Handle -> IO r
action = FilePath -> IOMode -> (Handle -> IO r) -> IO r
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
name IOMode
ioMode Handle -> IO r
action

-- | Generic function for choosing either file with given name or stdin/stdout as input/output.
-- It accepts the function that takes the corresponding handle.
-- Stdin/stdout is selected by "-".
withFileOrDefaultHandle :: FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFileOrDefaultHandle :: FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFileOrDefaultHandle "-"      ReadMode         action :: Handle -> IO r
action = Handle -> IO r
action Handle
stdin
withFileOrDefaultHandle "-"      WriteMode        action :: Handle -> IO r
action = Handle -> IO r
action Handle
stdout
withFileOrDefaultHandle "-"      otherMode :: IOMode
otherMode        _      = FilePath -> IO r
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO r) -> FilePath -> IO r
forall a b. (a -> b) -> a -> b
$ "Incompatible io mode ("
                                                                FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ IOMode -> FilePath
forall a. Show a => a -> FilePath
show IOMode
otherMode
                                                                FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ") for `-` in withFileOrDefaultHandle."
withFileOrDefaultHandle filename :: FilePath
filename ioMode :: IOMode
ioMode           action :: Handle -> IO r
action = FilePath -> IOMode -> (Handle -> IO r) -> IO r
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
filename IOMode
ioMode Handle -> IO r
action

-- Missing instances
instance Hashable a => Hashable (Set.Set a) where
  hashWithSalt :: Int -> Set a -> Int
hashWithSalt = (a -> Int -> Int) -> Int -> Set a -> Int
forall a b. (a -> b -> b) -> b -> Set a -> b
Set.foldr ((Int -> a -> Int) -> a -> Int -> Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> a -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt)