]> Git — Sourcephile - doclang.git/blob - Hdoc/Utils.hs
Fix HTML5 rendering of external references.
[doclang.git] / 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