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