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