Hdoc/Utils.hs

   1 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
   2 {-# LANGUAGE OverloadedStrings #-}
   3 {-# OPTIONS_GHC -fno-warn-orphans #-}
   4 module Hdoc.Utils where
   5
   6 import Control.Monad (Monad(..))
   7 import Data.Bool
   8 import Data.Default.Class (Default(..))
   9 import Data.Eq (Eq(..))
  10 import Data.Foldable (Foldable(..))
  11 import Data.Function (($), (.))
  12 import Data.Functor ((<$>))
  13 import Data.Hashable (Hashable(..))
  14 import Data.Int (Int)
  15 import Data.List.NonEmpty (NonEmpty(..))
  16 import Data.Maybe (Maybe(..))
  17 import Data.Ord (Ord(..))
  18 import Data.Sequence (Seq)
  19 import Data.Text (Text)
  20 import Prelude (pred, succ)
  21 import System.IO (IO, FilePath)
  22 import Text.Show (Show(..))
  23 import qualified Data.ByteString.Lazy as BSL
  24 import qualified Data.HashMap.Strict as HM
  25 import qualified Data.HashSet as HS
  26 import qualified Data.Text.Lazy as TL
  27 import qualified Data.Text.Lazy.Encoding as TL
  28 import qualified System.Directory as IO
  29 import qualified System.IO as IO
  30 import qualified System.IO.Error as IO
  31
  32 instance Default Text where
  33         def = ""
  34 instance Default TL.Text where
  35         def = ""
  36 instance Default a => Default (NonEmpty a) where
  37         def = def:|[]
  38 instance Hashable a => Hashable (Seq a) where
  39         hashWithSalt s = hashWithSalt s . toList
  40 instance Default (HM.HashMap k a) where
  41         def = HM.empty
  42 instance Default (HS.HashSet a) where
  43         def = HS.empty
  44 {-
  45 instance Hashable a => Hashable (TS.Tree a) where
  46         hashWithSalt s (TS.Tree a ts) =
  47                 s`hashWithSalt`a
  48                  `hashWithSalt`ts
  49 -}
  50
  51 -- * Filesystem utilities
  52 readFile :: FilePath -> IO TL.Text
  53 readFile fp = TL.decodeUtf8 <$> BSL.readFile fp
  54
  55 writeFile :: FilePath -> TL.Text -> IO ()
  56 writeFile fp s = BSL.writeFile fp $ TL.encodeUtf8 s
  57
  58 withFile :: FilePath -> IO.IOMode -> (IO.Handle -> IO a) -> IO a
  59 withFile = IO.withFile
  60
  61 removeFile :: FilePath -> IO ()
  62 removeFile f =
  63         IO.removeFile f `IO.catchIOError` \e ->
  64                 if IO.isDoesNotExistError e
  65                 then return ()
  66                 else IO.ioError e
  67
  68 -- * Arithmetical utilities
  69 -- ** Type 'Nat'
  70 newtype Nat = Nat { unNat :: Int }
  71  deriving (Eq,Ord,Hashable)
  72 instance Show Nat where
  73         showsPrec p = showsPrec p . unNat
  74 instance Default Nat where
  75         def = Nat 0
  76
  77 succNat :: Nat -> Nat
  78 succNat (Nat n) = Nat $ succ n
  79
  80 predNat :: Nat -> Maybe Nat
  81 predNat (Nat n) | n <= 0    = Nothing
  82                 | otherwise = Just $ Nat $ pred n
  83
  84 -- ** Type 'Nat1'
  85 newtype Nat1 = Nat1 { unNat1 :: Int }
  86  deriving (Eq,Ord,Hashable)
  87 instance Show Nat1 where
  88         showsPrec p = showsPrec p . unNat1
  89 instance Default Nat1 where
  90         def = Nat1 1
  91
  92 succNat1 :: Nat1 -> Nat1
  93 succNat1 (Nat1 n) = Nat1 $ succ n
  94 predNat1 :: Nat1 -> Maybe Nat1
  95 predNat1 (Nat1 n) | n <= 1    = Nothing
  96                   | otherwise = Just $ Nat1 $ pred n