msakai / toysolver / 724

Committed 01 May 2025 12:26AM UTC coverage: 71.64% (-0.2%) from 71.828%

Build # 724

Build Type

push

github

Committed by

web-flow

Commit Message

Merge pull request #183 from msakai/feature/get-base-extension

Rename getBaseExt to getBaseExtension

Run Details

0 of 2 new or added lines in 1 file covered. (0.0%)

58 existing lines in 12 files now uncovered.

11049 of 15423 relevant lines covered (71.64%)

0.72 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

  -- * Utility functions
  , getBaseExtension
  ) 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.Char
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

-- | Get base extension of a filename
--
-- Supported compression format extensions (e.g. @.gz@) are removed, and extensions such as @.cnf@ are returned.
--
-- @since 0.10.0
getBaseExtension :: FilePath -> String
getBaseExtension name | (base, ext) <- splitExtension name =
  case map toLower ext of
#ifdef WITH_ZLIB
    ".gz" -> getBaseExtension base
#endif
    s -> s

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
26	-- * Utility functions
27	, getBaseExtension
28	) where
29
30	import Prelude hiding (readFile, writeFile)
31	import Control.Exception
32	import Control.Monad.IO.Class
33	import qualified Data.ByteString.Lazy.Char8 as BS
34	import Data.ByteString.Builder hiding (writeFile)
35	import Data.Char
36	import Data.Typeable
37	import System.IO hiding (readFile, writeFile)
38
39	#ifdef WITH_ZLIB
40	import qualified Codec.Compression.GZip as GZip
41	import qualified Data.CaseInsensitive as CI
42	import System.FilePath
43	#endif
44
45	-- \| A type class that abstracts file formats
46	class FileFormat a where
47	-- \| Parse a lazy byte string, and either returns error message or a parsed value
48	parse :: BS.ByteString -> Either String a
49
50	-- \| Encode a value into 'Builder'
51	render :: a -> Builder
52
53	-- \| 'ParseError' represents a parse error and it wraps a error message.
54	data ParseError = ParseError String
55	deriving (Show, Typeable)	×
56
57	instance Exception ParseError	×
58
59	-- \| Parse a file but returns an error message when parsing fails.
60	parseFile :: (FileFormat a, MonadIO m) => FilePath -> m (Either String a)
61	parseFile filename = liftIO $ do	×
62	s <- BS.readFile filename	×
63	#ifdef WITH_ZLIB
64	let s2 = if CI.mk (takeExtension filename) == ".gz" then	×
65	GZip.decompress s	×
66	else
67	s	×
68	#else
69	let s2 = s
70	#endif
71	return $ parse s2	×
72
73	-- \| Parse a file. Similar to 'parseFile' but this function throws 'ParseError' when parsing fails.
74	readFile :: (FileFormat a, MonadIO m) => FilePath -> m a
75	readFile filename = liftIO $ do	×
76	ret <- parseFile filename	×
77	case ret of	×
78	Left msg -> throwIO $ ParseError msg	×
79	Right a -> return a	×
80
81	-- \| Write a value into a file.
82	writeFile :: (FileFormat a, MonadIO m) => FilePath -> a -> m ()
83	writeFile filepath a = liftIO $ do	×
84	withBinaryFile filepath WriteMode $ \h -> do	×
85	hSetBuffering h (BlockBuffering Nothing)	×
86	#ifdef WITH_ZLIB
87	if CI.mk (takeExtension filepath) == ".gz" then do	×
88	BS.hPut h $ GZip.compress $ toLazyByteString $ render a	×
89	else do	×
90	hPutBuilder h (render a)	×
91	#else
92	hPutBuilder h (render a)
93	#endif
94
95	-- \| Get base extension of a filename
96	--
97	-- Supported compression format extensions (e.g. @.gz@) are removed, and extensions such as @.cnf@ are returned.
98	--
99	-- @since 0.10.0
100	getBaseExtension :: FilePath -> String
NEW 101	getBaseExtension name \| (base, ext) <- splitExtension name =	×
UNCOV 102	case map toLower ext of	×
103	#ifdef WITH_ZLIB
NEW 104	".gz" -> getBaseExtension base	×
105	#endif
106	s -> s	×

msakai / toysolver / 724

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