{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hdoc.Utils where

import Control.Monad (Monad(..))
import Data.Bool
import Data.Default.Class (Default(..))
import Data.Eq (Eq(..))
import Data.Foldable (Foldable(..))
import Data.Function (($), (.))
import Data.Functor ((<$>))
import Data.Hashable (Hashable(..))
import Data.Int (Int)
import Data.NonNull (NonNull(..), toNullable)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Maybe (Maybe(..))
import Data.Ord (Ord(..))
import Data.Sequence (Seq)
import Data.Text (Text)
import Prelude (pred, succ)
import System.IO (IO, FilePath)
import Text.Show (Show(..))
import qualified Data.ByteString.Lazy as BSL
import qualified Data.HashMap.Strict as HM
import qualified Data.HashSet as HS
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import qualified Data.TreeMap.Strict as TM
import qualified System.Directory as IO
import qualified System.IO as IO
import qualified System.IO.Error as IO

instance Default Text where
	def = ""
instance Default TL.Text where
	def = ""
instance Default a => Default (NonEmpty a) where
	def = def:|[]
instance Hashable a => Hashable (Seq a) where
	hashWithSalt s = hashWithSalt s . toList
instance Hashable a => Hashable (NonNull a) where
	hashWithSalt s = hashWithSalt s . toNullable
instance Default (HM.HashMap k a) where
	def = HM.empty
instance Default (HS.HashSet a) where
	def = HS.empty
instance Default (TM.TreeMap k a) where
	def = TM.empty
{-
instance Hashable a => Hashable (TS.Tree a) where
	hashWithSalt s (TS.Tree a ts) =
		s`hashWithSalt`a
		 `hashWithSalt`ts
-}

-- * Filesystem utilities
readFile :: FilePath -> IO TL.Text
readFile fp = TL.decodeUtf8 <$> BSL.readFile fp

writeFile :: FilePath -> TL.Text -> IO ()
writeFile fp s = BSL.writeFile fp $ TL.encodeUtf8 s

withFile :: FilePath -> IO.IOMode -> (IO.Handle -> IO a) -> IO a
withFile = IO.withFile

removeFile :: FilePath -> IO ()
removeFile f =
	IO.removeFile f `IO.catchIOError` \e ->
		if IO.isDoesNotExistError e
		then return ()
		else IO.ioError e

-- * Arithmetical utilities
-- ** Type 'Nat'
newtype Nat = Nat { unNat :: Int }
 deriving (Eq,Ord,Hashable)
instance Show Nat where
	showsPrec p = showsPrec p . unNat
instance Default Nat where
	def = Nat 0

succNat :: Nat -> Nat
succNat (Nat n) = Nat $ succ n

predNat :: Nat -> Maybe Nat
predNat (Nat n) | n <= 0    = Nothing
                | otherwise = Just $ Nat $ pred n

-- ** Type 'Nat1'
newtype Nat1 = Nat1 { unNat1 :: Int }
 deriving (Eq,Ord,Hashable)
instance Show Nat1 where
	showsPrec p = showsPrec p . unNat1
instance Default Nat1 where
	def = Nat1 1

succNat1 :: Nat1 -> Nat1
succNat1 (Nat1 n) = Nat1 $ succ n
predNat1 :: Nat1 -> Maybe Nat1
predNat1 (Nat1 n) | n <= 1    = Nothing
                  | otherwise = Just $ Nat1 $ pred n