Skip to content
Snippets Groups Projects
Commit 213d27ea authored by Peter Becich's avatar Peter Becich Committed by BinderDavid
Browse files

remove more things needed by GHC < 8.6

parent 0ef3c8ba
No related branches found
No related tags found
No related merge requests found
Pipeline #63271 passed
{-# LANGUAGE CPP, Safe #-}
{-# LANGUAGE Safe #-}
---------------------------------------------------------------
-- Colin Runciman and Andy Gill, June 2006
---------------------------------------------------------------
......@@ -21,11 +21,7 @@ import Data.List (intercalate)
import Data.Maybe (catMaybes, fromMaybe)
import Data.Time (UTCTime)
import Data.Tree
#if MIN_VERSION_base(4,6,0)
import Text.Read (readMaybe)
#else
import Data.Char (isSpace)
#endif
import System.FilePath
......@@ -36,13 +32,6 @@ import System.FilePath
import Trace.Hpc.Util (HpcPos, insideHpcPos, Hash, HpcHash(..), catchIO)
import Trace.Hpc.Tix
#if !MIN_VERSION_base(4,6,0)
readMaybe :: Read a => String -> Maybe a
readMaybe s = case reads s of
[(x, s')] | all isSpace s' -> Just x
_ -> Nothing
#endif
-- | 'Mix' is the information about a modules static properties, like
-- location of Tix's in a file.
--
......
{-# LANGUAGE CPP, Safe, DeriveGeneric, StandaloneDeriving #-}
{-# LANGUAGE Safe, DeriveGeneric, StandaloneDeriving #-}
------------------------------------------------------------
-- Andy Gill and Colin Runciman, June 2006
------------------------------------------------------------
......
{-# LANGUAGE Safe, DeriveGeneric, StandaloneDeriving #-}
-----------------------------------------
-- Andy Gill and Colin Runciman, June 2006
------------------------------------------
......
......@@ -26,7 +26,6 @@ source-repository head
Library
default-language: Haskell98
other-extensions: CPP
exposed-modules:
Trace.Hpc.Util
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment