msakai / toysolver / 496

Committed 10 Nov 2024 11:05AM UTC coverage: 69.994% (-1.1%) from 71.113%

Build # 496

Build Type

push

github

Committed by

web-flow

Commit Message

Merge pull request #117 from msakai/update-coveralls-and-haddock

GitHub Actions: Update coveralls and haddock configuration

Run Details

9872 of 14104 relevant lines covered (69.99%)

0.7 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

0.0

/src/ToySolver/FileFormat/Base.hs

{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  ToySolver.FileFormat.Base
-- Copyright   :  (c) Masahiro Sakai 2016-2018
-- License     :  BSD-style
--
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  provisional
-- Portability :  non-portable
--
-----------------------------------------------------------------------------
module ToySolver.FileFormat.Base
  (
  -- * FileFormat class
    FileFormat (..)
  , ParseError (..)
  , parseFile
  , readFile
  , writeFile
  ) where

import Prelude hiding (readFile, writeFile)
import Control.Exception
import Control.Monad.IO.Class
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.ByteString.Builder hiding (writeFile)
import Data.Typeable
import System.IO hiding (readFile, writeFile)

#ifdef WITH_ZLIB
import qualified Codec.Compression.GZip as GZip
import qualified Data.CaseInsensitive as CI
import System.FilePath
#endif

-- | A type class that abstracts file formats
class FileFormat a where
  -- | Parse a lazy byte string, and either returns error message or a parsed value
  parse :: BS.ByteString -> Either String a

  -- | Encode a value into 'Builder'
  render :: a -> Builder

-- | 'ParseError' represents a parse error and it wraps a error message.
data ParseError = ParseError String
  deriving (Show, Typeable)

instance Exception ParseError

-- | Parse a file but returns an error message when parsing fails.
parseFile :: (FileFormat a, MonadIO m) => FilePath -> m (Either String a)
parseFile filename = liftIO $ do
  s <- BS.readFile filename
#ifdef WITH_ZLIB
  let s2 = if CI.mk (takeExtension filename) == ".gz" then
             GZip.decompress s
           else
             s
#else
  let s2 = s
#endif
  return $ parse s2

-- | Parse a file. Similar to 'parseFile' but this function throws 'ParseError' when parsing fails.
readFile :: (FileFormat a, MonadIO m) => FilePath -> m a
readFile filename = liftIO $ do
  ret <- parseFile filename
  case ret of
    Left msg -> throwIO $ ParseError msg
    Right a -> return a

-- | Write a value into a file.
writeFile :: (FileFormat a, MonadIO m) => FilePath -> a -> m ()
writeFile filepath a = liftIO $ do
  withBinaryFile filepath WriteMode $ \h -> do
    hSetBuffering h (BlockBuffering Nothing)
#ifdef WITH_ZLIB
    if CI.mk (takeExtension filepath) == ".gz" then do
      BS.hPut h $ GZip.compress $ toLazyByteString $ render a
    else do
      hPutBuilder h (render a)
#else
    hPutBuilder h (render a)
#endif

1	{-# OPTIONS_GHC -Wall #-}
2	{-# OPTIONS_HADDOCK show-extensions #-}
3	{-# LANGUAGE CPP #-}
4	{-# LANGUAGE DeriveDataTypeable #-}
5	{-# LANGUAGE OverloadedStrings #-}
6	-----------------------------------------------------------------------------
7	-- \|
8	-- Module : ToySolver.FileFormat.Base
9	-- Copyright : (c) Masahiro Sakai 2016-2018
10	-- License : BSD-style
11	--
12	-- Maintainer : masahiro.sakai@gmail.com
13	-- Stability : provisional
14	-- Portability : non-portable
15	--
16	-----------------------------------------------------------------------------
17	module ToySolver.FileFormat.Base
18	(
19	-- * FileFormat class
20	FileFormat (..)
21	, ParseError (..)
22	, parseFile
23	, readFile
24	, writeFile
25	) where
26
27	import Prelude hiding (readFile, writeFile)
28	import Control.Exception
29	import Control.Monad.IO.Class
30	import qualified Data.ByteString.Lazy.Char8 as BS
31	import Data.ByteString.Builder hiding (writeFile)
32	import Data.Typeable
33	import System.IO hiding (readFile, writeFile)
34
35	#ifdef WITH_ZLIB
36	import qualified Codec.Compression.GZip as GZip
37	import qualified Data.CaseInsensitive as CI
38	import System.FilePath
39	#endif
40
41	-- \| A type class that abstracts file formats
42	class FileFormat a where
43	-- \| Parse a lazy byte string, and either returns error message or a parsed value
44	parse :: BS.ByteString -> Either String a
45
46	-- \| Encode a value into 'Builder'
47	render :: a -> Builder
48
49	-- \| 'ParseError' represents a parse error and it wraps a error message.
50	data ParseError = ParseError String
51	deriving (Show, Typeable)	×
52
53	instance Exception ParseError	×
54
55	-- \| Parse a file but returns an error message when parsing fails.
56	parseFile :: (FileFormat a, MonadIO m) => FilePath -> m (Either String a)
57	parseFile filename = liftIO $ do	×
58	s <- BS.readFile filename	×
59	#ifdef WITH_ZLIB
60	let s2 = if CI.mk (takeExtension filename) == ".gz" then	×
61	GZip.decompress s	×
62	else
63	s	×
64	#else
65	let s2 = s
66	#endif
67	return $ parse s2	×
68
69	-- \| Parse a file. Similar to 'parseFile' but this function throws 'ParseError' when parsing fails.
70	readFile :: (FileFormat a, MonadIO m) => FilePath -> m a
71	readFile filename = liftIO $ do	×
72	ret <- parseFile filename	×
73	case ret of	×
74	Left msg -> throwIO $ ParseError msg	×
75	Right a -> return a	×
76
77	-- \| Write a value into a file.
78	writeFile :: (FileFormat a, MonadIO m) => FilePath -> a -> m ()
79	writeFile filepath a = liftIO $ do	×
80	withBinaryFile filepath WriteMode $ \h -> do	×
81	hSetBuffering h (BlockBuffering Nothing)	×
82	#ifdef WITH_ZLIB
83	if CI.mk (takeExtension filepath) == ".gz" then do	×
84	BS.hPut h $ GZip.compress $ toLazyByteString $ render a	×
85	else do	×
86	hPutBuilder h (render a)	×
87	#else
88	hPutBuilder h (render a)
89	#endif

msakai / toysolver / 496

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous