]> Git — Sourcephile - doclang.git/blob - Hdoc/Utils.hs
Update to megaparsec-7 and new symantic-xml
[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 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