packages feed

sr-extra 1.80 → 1.85

raw patch · 14 files changed

+137/−123 lines, 14 filesdep ~basedep ~mtldep ~template-haskell

Dependency ranges changed: base, mtl, template-haskell

Files

Extra/EnvPath.hs view
@@ -12,7 +12,11 @@ import Control.Lens (Lens', makeLenses, over) import Extra.Pretty (PP(PP)) import Text.PrettyPrint.HughesPJClass (text)+#if 0 import Distribution.Pretty (Pretty(pretty))+#else+import Text.PrettyPrint.HughesPJClass (Pretty(pPrint))+#endif  -- |The root directory of an OS image. data EnvRoot = EnvRoot { _rootPath :: FilePath } deriving (Ord, Eq, Read, Show)@@ -35,7 +39,7 @@ rootEnvPath s = EnvPath { _envRoot = EnvRoot "", _envPath = s }  instance Pretty (PP EnvRoot) where-    pretty (PP x) = text (_rootPath x)+    pPrint (PP x) = text (_rootPath x)  -- | Class used to access an EnvRoot in a value, typically in a reader -- monad.
Extra/Errors.hs view
@@ -38,11 +38,22 @@   , mapMember   , runNullExceptT   , runNullExcept+  , liftUIO+  , runOneOf -- I think this is the best one+  , runOneOf'+  , runOneOf''+  , Errors+  , Errors'   , test+  , IOException+  , module Control.Monad.Except+  , module Extra.Except+  , module UnexceptionalIO.Trans   ) where +import Control.Exception (fromException, IOException, toException) import Control.Lens (Prism', prism', review)-import Control.Monad.Except (Except, ExceptT, MonadError, runExcept, runExceptT, throwError)+import Control.Monad.Except (Except, ExceptT, MonadError, runExcept, runExceptT, throwError, withExceptT) --import Extra.Except (mapError) import Data.Type.Bool --import Data.Type.Equality@@ -51,7 +62,9 @@ import qualified Data.Serialize as S (Serialize(get, put), getWord8, Put, PutM, Get) import Data.Typeable (Typeable, typeOf) import Data.Proxy-import Extra.Except (tryError)+import Extra.Except (NonIOException(..), tryError)+import GHC.Stack (HasCallStack)+import UnexceptionalIO.Trans (fromIO, SomeNonPseudoException, Unexceptional)  type family IsMember x ys where   IsMember x '[] = 'False@@ -72,6 +85,7 @@   Empty :: OneOf s   Val   :: e -> OneOf (e ': s)   NoVal :: OneOf s -> OneOf (e ': s)+  deriving Typeable  instance Show (OneOf '[]) where   show Empty = "{}"@@ -96,6 +110,7 @@   get :: S.Get (OneOf (e ': s))   get = S.getWord8 >>= \case     0 -> NoVal <$> S.get+    1 -> Val <$> S.get     _ -> error "impossible"  instance SafeCopy (OneOf '[]) where@@ -138,7 +153,7 @@   get (Val _e) = Nothing   get Empty = error "impossible" -oneOf :: ({-IsMember e xs ~ 'True,-} Get e xs, Set e xs) => Prism' (OneOf xs) e+oneOf :: (Get e es, Set e es) => Prism' (OneOf es) e oneOf = prism' set get  type family DeleteList e xs where@@ -162,10 +177,10 @@    delete p (NoVal o) = NoVal (delete p o)    delete _p Empty = Empty -throwMember :: (Member e es, MonadError (OneOf es) m) => e -> m a+throwMember :: forall e es m a. (Member e es, MonadError (OneOf es) m) => e -> m a throwMember = throwError . review oneOf -liftMember :: (Member e es, MonadError (OneOf es) m) => Either e a -> m a+liftMember :: forall e es m a. (Member e es, MonadError (OneOf es) m) => Either e a -> m a liftMember = either throwMember return  -- | Run an action with @e@ added to the current error set @es@.@@ -175,16 +190,16 @@ --   catchMember withExceptT (fileIO @(FileError ': e) (Right <$> query st (LookValue key))) (return . Left) -- @@ catchMember ::-  forall e es es' m n a.-  (Member e es, es' ~ DeleteList e es,-   MonadError (OneOf es) m, MonadError (OneOf es') n)-  => (forall b. (OneOf es -> OneOf es') -> m b -> n b)+  forall esplus e es m n a.+  (Member e esplus, es ~ DeleteList e esplus,+   MonadError (OneOf esplus) m, MonadError (OneOf es) n)+  => (forall b. (OneOf esplus -> OneOf es) -> m b -> n b)   -> m a -> (e -> n a) -> n a catchMember helper ma f =   -- The idea here is that we use tryError to bring a copy of e into   -- the return value, then we can just delete e from error monad.   helper (delete @e Proxy) (tryError ma) >>= either handle return-  where handle :: OneOf es -> n a+  where handle :: OneOf esplus -> n a         handle es = maybe (throwError (delete @e Proxy es)) f (get es :: Maybe e)  -- | Simplified catchMember where the monad doesn't change.@@ -201,6 +216,42 @@  runNullExcept :: Except (OneOf '[]) a -> a runNullExcept m = (\(Right a) -> a) (runExcept m)++liftUIO ::+  (Unexceptional m, Member NonIOException e, Member IOException e, MonadError (OneOf e) m)+  => IO a+  -> m a+liftUIO io =+  runExceptT (fromIO io) >>= either (either throwMember throwMember . splitException) return+  where+    splitException :: SomeNonPseudoException -> Either NonIOException IOException+    splitException e = maybe (Left (NonIOException e)) Right (fromException (toException e) :: Maybe IOException)++-- | Catch any FileError thrown and put it in the return value.+runOneOf'' ::+  forall (esplus :: [*]) e (es :: [*]) m a.+  (es ~ DeleteList e esplus, Member e esplus, Monad m)+  => ExceptT (OneOf esplus) m a+  -> ExceptT (OneOf es) m (Either e a)+runOneOf'' action = catchMember withExceptT (Right <$> action) (return . Left)++runOneOf' ::+  forall (esplus :: [*]) e (es :: [*]) m a r.+  (es ~ DeleteList e esplus, Member e esplus, MonadError (OneOf es) m)+  => ExceptT (OneOf esplus) m a+  -> (Either e a -> m r)+  -> m r+runOneOf' action final = runExceptT (runOneOf'' action) >>= either throwError final++runOneOf ::+  forall (esplus :: [*]) e (es :: [*]) m a.+  (es ~ DeleteList e esplus, Member e esplus, MonadError (OneOf es) m)+  => ExceptT (OneOf esplus) m a+  -> m (Either e a)+runOneOf action = runOneOf' action return++type Errors e = (Show (OneOf e), Typeable e, HasCallStack)+type Errors' e = (Show (OneOf e), Typeable e)  -- ** Example
Extra/Except.hs view
@@ -29,7 +29,7 @@     , MonadUIO     , lyftIO #if !__GHCJS__-    , logIOError+    -- , logIOError #endif     , module Control.Monad.Except     ) where@@ -41,10 +41,11 @@ import Control.Monad.Except import Control.Monad.Trans (MonadTrans(lift), liftIO) import Control.Monad.Except (ExceptT, runExceptT)+import Data.Monoid ((<>)) import Data.Serialize import Data.Typeable (typeOf) #if !__GHCJS__-import Extra.Log (logException, Priority(ERROR))+--import Extra.Log (logException, Priority(ERROR)) #endif import Foreign.C.Types (CInt(..)) import GHC.Generics (Generic)@@ -137,8 +138,8 @@ instance HasErrorCall ErrorCall where fromErrorCall = id  #if !__GHCJS__-logIOError :: (MonadIO m, MonadError e m) => m a -> m a-logIOError = handleError (\e -> liftIO ($logException ERROR (pure e)) >> throwError e)+--logIOError :: (MonadIO m, MonadError e m) => m a -> m a+--logIOError = handleError (\e -> liftIO ($logException ERROR (pure e)) >> throwError e) #endif  instance MonadCatch UIO where
Extra/Generics/Show.hs view
@@ -33,6 +33,7 @@ import Data.Foldable (foldl') import Data.Functor.Classes (Show1(..)) import Data.Functor.Identity (Identity(Identity))+import Data.Monoid ((<>)) import Data.Proxy (Proxy(Proxy)) import Generic.Data (gconIndex) import GHC.Generics as G
Extra/IO.hs view
@@ -21,13 +21,13 @@ import Data.Text as Text (length, take, Text) import Data.Text.IO as Text (readFile, writeFile) import Data.Time (getCurrentTime, diffUTCTime, getCurrentTime, NominalDiffTime)-import Extra.Log (alog)+--import Extra.Log (alog) import Extra.Text (diffText) import System.Directory (getCurrentDirectory, removeFile, renameFile) import System.FilePath.Find as Find     ((==?), (&&?), always, extension, fileType, FileType(RegularFile), find) import System.IO.Error (isDoesNotExistError)-import System.Log.Logger ({-logM,-} Priority(DEBUG, ERROR))+import System.Log.Logger (logM, Priority(DEBUG, ERROR))  testAndWriteDotNew :: FilePath -> Text -> IO () testAndWriteDotNew dest new = testAndWrite writeDotNew dest new@@ -46,17 +46,17 @@ testAndWrite :: (FilePath -> Text -> Text -> IO ()) -> FilePath -> Text -> IO () testAndWrite changeAction dest new = do   here <- getCurrentDirectory-  alog DEBUG ("testAndWriteFile " <> show dest <> " " <> show (shorten 50 new) <> " (cwd=" <> show here <> ")")+  logM "Extra.IO" DEBUG ("testAndWriteFile " <> show dest <> " " <> show (shorten 50 new) <> " (cwd=" <> show here <> ")")   removeFileMaybe (dest <> ".new")   try (Text.readFile dest >>= \old ->        when (old /= new) (changeAction dest old new)) >>=     either (\(e :: IOException) ->               case isDoesNotExistError e of                 True -> do-                  alog DEBUG "testAndWriteFile - no existing version"+                  logM "Extra.IO" DEBUG "testAndWriteFile - no existing version"                   Text.writeFile dest new                 False -> do-                  alog ERROR ("testAndWriteFile " <> show dest <> " - IOException " ++ show e)+                  logM "Extra.IO" ERROR ("testAndWriteFile " <> show dest <> " - IOException " ++ show e)                   throw e)            return @@ -69,7 +69,7 @@ -- | If the new file does not match the old, write it to file.new and error. writeDotNew :: FilePath -> Text -> Text -> IO () writeDotNew dest old new = do-  alog DEBUG ("testAndWriteFile - mismatch, writing " <> show (dest <> ".new"))+  logM "Extra.IO" DEBUG ("testAndWriteFile - mismatch, writing " <> show (dest <> ".new"))   Text.writeFile (dest <> ".new") new   error ("Generated " <> dest <> ".new does not match existing " <> dest <> ":\n" <>          diffText (dest, old) (dest <> ".new", new) <>
− Extra/Log.hs 
@@ -1,75 +0,0 @@-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE CPP, TemplateHaskell #-}-{-# OPTIONS -Wall #-}--module Extra.Log-  ( alog-  , Priority(..)-#if !__GHCJS__-  , logException-  , logQ-#endif-  ) where--import Control.Lens(ix, preview, to)-import Control.Monad.Except (MonadError(catchError, throwError))-import Control.Monad.Trans (liftIO, MonadIO)-import Data.Bool (bool)-import Data.List (intercalate)-import Data.Maybe (fromMaybe, mapMaybe)-import Data.Time (getCurrentTime, UTCTime)-import Data.Time.Format (formatTime, defaultTimeLocale)-import GHC.Stack (CallStack, callStack, getCallStack, HasCallStack, SrcLoc(..))-#if !__GHCJS__-import Language.Haskell.TH (ExpQ, Exp, Loc(..), location, pprint, Q)-import qualified Language.Haskell.TH.Lift as TH (Lift(lift))-import Language.Haskell.TH.Instances ()-#endif-import System.Log.Logger (Priority(..), logM, rootLoggerName)--alog :: (MonadIO m, HasCallStack) => Priority -> String -> m ()-alog priority msg = liftIO $ do-  time <- getCurrentTime-  logM (modul callStack) priority $-    logString time priority msg--logString  :: HasCallStack => UTCTime -> Priority -> String -> String-logString time priority msg =-#if defined(darwin_HOST_OS)-  take 2002 $-#else-  take 60000 $-#endif-    msg---- | Format the location of the nth level up in a call stack-modul :: CallStack -> String-modul stack =-  case dropWhile (\(_, SrcLoc {..}) -> srcLocModule == "Extra.Log") (getCallStack stack) of-    [] -> "???"-    [(_alog, SrcLoc {..})] -> srcLocModule <> ":" <> show srcLocStartLine-    ((_, SrcLoc {..}) : (fn, _) : _) -> srcLocModule <> "." <> fn <> ":" <> show srcLocStartLine--#if !__GHCJS__--- | Create an expression of type (MonadIO m => Priority -> m a -> m--- a) that we can apply to an expression so that it catches, logs, and--- rethrows any exception.-logException :: ExpQ-logException =-    [| \priority action ->-         action `catchError` (\e -> do-                                liftIO (logM (loc_module $__LOC__)-                                             priority-                                             ("Logging exception: " <> (pprint $__LOC__) <> " -> " ++ show e))-                                throwError e) |]--__LOC__ :: Q Exp-__LOC__ = TH.lift =<< location--logQ :: ExpQ-logQ = do-  loc <- location-  [|\priority message ->-       alog $(TH.lift (show (loc_module loc))) priority-         ($(TH.lift (show (loc_module loc) <> ":" <> show (fst (loc_start loc)))) <> " - " <> message)|]-#endif
Extra/Orphans.hs view
@@ -9,6 +9,7 @@  import Data.Graph.Inductive as G import Data.List (intercalate)+import Data.Monoid ((<>)) import Data.Proxy (Proxy(Proxy)) import Data.SafeCopy (base, contain,                       SafeCopy(errorTypeName, getCopy, kind, putCopy, version))@@ -50,8 +51,7 @@ deriving instance Generic URIAuth #endif --- $(deriveLift ''UserId)-instance Lift UserId where lift (UserId x0) = [|UserId $(lift x0)|]+$(deriveLift ''UserId)  $(deriveLift ''G.Gr) $(deriveLift ''G.NodeMap)
Extra/Orphans3.hs view
@@ -7,6 +7,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PackageImports #-}+{-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-}@@ -21,8 +22,12 @@ import Data.SafeCopy (SafeCopy(..)) import Extra.Serialize (Serialize) import Extra.Orphans ()+#if MIN_VERSION_template_haskell(2,16,0)+import GHC.Word+#endif import Language.Haskell.TH import Language.Haskell.TH.Instances ()+import Language.Haskell.TH.Lift import Language.Haskell.TH.PprLib (Doc, hcat, ptext) import Language.Haskell.TH.Syntax import Prelude hiding (foldl1)@@ -52,7 +57,7 @@ deriving instance Serialize (Proxy a)  #if !__GHCJS__-instance Lift (Proxy a) where lift Proxy = [|Proxy|]+$(deriveLift ''Proxy)  instance Arbitrary NameSpace where     arbitrary = elements [VarName, DataName, TcClsName]@@ -103,6 +108,7 @@ -- s = $(location >>= \Loc{loc_module=m, loc_start=(sl,sc), loc_end=(el,ec)} -> lift (m <> ":" <> show sl)) #endif +#if 0 deriving instance Serialize AnnTarget deriving instance Serialize Bang deriving instance Serialize Body@@ -243,8 +249,11 @@ instance SafeCopy TySynEqn where version = 1 instance SafeCopy TyVarBndr where version = 1 -#if MIN_VERSION_template_haskell(2,15,0)+#if MIN_VERSION_template_haskell(2,16,0) deriving instance Serialize Bytes instance SafeCopy Bytes where version = 1+#if 0 deriving instance NFData Bytes+#endif+#endif #endif
Extra/Pretty.hs view
@@ -28,7 +28,11 @@ import Data.Generics (everywhere, mkT) import Data.Set as Set (Set, toList) import Data.Text (Text, unpack, pack)+#if 0 import Distribution.Pretty (Pretty(pretty), prettyShow)+#else+import Text.PrettyPrint.HughesPJClass (Pretty(pPrint), prettyShow)+#endif import Language.Haskell.TH import Language.Haskell.TH.PprLib as TH (Doc, hcat, hsep, ptext, to_HPJ_Doc) import Language.Haskell.TH.Syntax@@ -42,19 +46,19 @@ newtype PP a = PP {unPP :: a} deriving (Functor)  instance Pretty (PP Text) where-    pretty = text . unpack . unPP+    pPrint = text . unpack . unPP  instance Pretty (PP String) where-    pretty = text . unPP+    pPrint = text . unPP  instance Pretty (PP a) => Pretty (PP (Maybe a)) where-    pretty = maybe empty ppPrint . unPP+    pPrint = maybe empty ppPrint . unPP  prettyText :: Pretty a => a -> Text prettyText = pack . prettyShow  ppPrint :: Pretty (PP a) => a -> HPJ.Doc-ppPrint = pretty . PP+ppPrint = pPrint . PP  ppShow :: Pretty (PP a) => a -> String ppShow = prettyShow . PP
Extra/Process.hs view
@@ -37,7 +37,9 @@ import Control.Monad.Trans (liftIO, MonadIO) import qualified Data.ByteString.Lazy.Char8 as L import Data.ListLike (break, head, hPutStr, null, singleton, tail)+#if !MIN_VERSION_base(4,11,0) import Data.Semigroup (Semigroup((<>)))+#endif import Data.String (IsString(fromString)) import Data.Text (unpack) import Data.Text.Encoding (decodeUtf8)@@ -73,9 +75,9 @@     | RunOptions [RunOptions a m]  instance Semigroup (RunOptions a m) where-    RunOptions a <> RunOptions b = RunOptions (a <> b)-    RunOptions a <> b = RunOptions (a <> [b])-    a <> RunOptions b = RunOptions ([a] <> b)+    RunOptions a <> RunOptions b = RunOptions (a ++ b)+    RunOptions a <> b = RunOptions (a ++ [b])+    a <> RunOptions b = RunOptions ([a] ++ b)     a <> b = RunOptions [a, b]  showCommand :: MonadIO m => String -> CreateProcess -> m ()@@ -85,7 +87,7 @@ showCommandAndResult prefix p (code, _, _) =     liftIO $ ePutStrLn (prefix ++ showCreateProcessForUser p ++ " -> " ++ show code) -putIndented :: forall a c m. (Eq c, ListLikeProcessIO a c, IsString a, MonadIO m) => [Chunk a] -> m [Chunk a]+putIndented :: forall a c m. (Eq c, ListLikeProcessIO a c, IsString a, MonadIO m, Semigroup a) => [Chunk a] -> m [Chunk a] putIndented chunks =     liftIO $ mapM_ echo (indentChunks "     1> " "     2> " chunks) >> return chunks     where@@ -120,12 +122,12 @@ --runVE p input = try $ runV p input  runV ::-    (Eq c, IsString a, ListLikeProcessIO a c, HasLoc e, MonadIO m, MonadError e m)+    (Eq c, IsString a, ListLikeProcessIO a c, HasLoc e, MonadIO m, MonadError e m, Semigroup a)     => CreateProcess -> a -> m (ExitCode, a, a) runV p input = run (StartMessage showCommand <> OverOutput putIndented <> FinishMessage showCommandAndResult) p input  runVE ::-    (Eq c, IsString a, ListLikeProcessIO a c, MonadCatch m, HasLoc e, Exception e, MonadError e m, MonadIO m)+    (Eq c, IsString a, ListLikeProcessIO a c, MonadCatch m, HasLoc e, Exception e, MonadError e m, MonadIO m, Semigroup a)     => CreateProcess -> a -> m (Either e (ExitCode, a, a)) runVE p i = try $ runV p i @@ -154,7 +156,7 @@                                        , " stdout: " ++ unpack (decodeUtf8 (L.toStrict out)) ]  -- | Pure function to indent the text of a chunk list.-indentChunks :: forall a c. (ListLikeProcessIO a c, Eq c, IsString a) => String -> String -> [Chunk a] -> [Chunk a]+indentChunks :: forall a c. (ListLikeProcessIO a c, Eq c, IsString a, Semigroup a) => String -> String -> [Chunk a] -> [Chunk a] indentChunks outp errp chunks =     evalState (Prelude.concat <$> mapM (indentChunk nl (fromString outp) (fromString errp)) chunks) BOL     where@@ -168,7 +170,7 @@ -- stderr.  The state monad keeps track of whether we are at the -- beginning of a line - when we are and more text comes we insert one -- of the prefixes.-indentChunk :: forall a c m. (Monad m, ListLikeProcessIO a c, Eq c) => c -> a -> a -> Chunk a -> StateT BOL m [Chunk a]+indentChunk :: forall a c m. (Monad m, ListLikeProcessIO a c, Eq c, Semigroup a) => c -> a -> a -> Chunk a -> StateT BOL m [Chunk a] indentChunk nl outp errp chunk =     case chunk of       Stdout x -> doText Stdout outp x@@ -237,13 +239,13 @@   return $ p {env = Just env'}  runV2 ::-    (MonadIO m, MonadCatch m, Eq c, IsString a, ListLikeProcessIO a c)+    (MonadIO m, MonadCatch m, Eq c, IsString a, ListLikeProcessIO a c, Semigroup a)     => [Loc] -> CreateProcess -> a -> m (ExitCode, a, a) runV2 locs p input =     run2 locs (StartMessage (showCommand' locs) <> OverOutput putIndented <> FinishMessage showCommandAndResult) p input  runVE2 ::-    forall a c e m. (Eq c, IsString a, ListLikeProcessIO a c, MonadIO m, MonadCatch m, Exception e)+    forall a c e m. (Eq c, IsString a, ListLikeProcessIO a c, MonadIO m, MonadCatch m, Exception e, Semigroup a)     => [Loc] -> CreateProcess -> a -> m (Either e (ExitCode, a, a)) runVE2 locs p input = do     try (runV2 locs p input)@@ -292,7 +294,7 @@ -- stray copies of the stuff above that I moved here, with MonadApt constraints  runV3 ::-    (Eq c, IsString a, ListLikeProcessIO a c, HasEnvRoot r, MonadReader r m, MonadIO m, MonadCatch m)+    (Eq c, IsString a, ListLikeProcessIO a c, HasEnvRoot r, MonadReader r m, MonadIO m, MonadCatch m, Semigroup a)     => [Loc] -> CreateProcess -> a -> m (ExitCode, a, a) runV3 locs p input =     run2 locs (StartMessage showCommand3' <> OverOutput putIndented <> FinishMessage showCommandAndResult) p input
Extra/QuickCheck.hs view
@@ -4,6 +4,7 @@  import Control.Exception import Test.QuickCheck+import Data.Semigroup  instance Exception Result
Extra/SafeCopy.hs view
@@ -16,8 +16,10 @@     , DecodeError(..)     , encodeSafe     , decodeAllSafe+#if 0     , decodeMSafe     , decodeMSafe'+#endif     , decodePrismSafe     , encodeGetterSafe     ) where@@ -29,9 +31,12 @@ import Data.ByteString as B (ByteString, null) import Data.Data (Proxy(Proxy), Typeable) import Data.SafeCopy (base, SafeCopy, safeGet, safePut)+#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup (Semigroup((<>)))+#endif import Data.Serialize hiding (decode, encode) import Data.UUID.Orphans ()-import Extra.Errors (Member, OneOf, throwMember)+--import Extra.Errors (Member, OneOf, throwMember) import Extra.Orphans () import Extra.Serialize (DecodeError(..), fakeTypeRep) @@ -46,6 +51,7 @@     Right (a, more) | B.null more -> Right a     Right (_, more) -> Left ("decode " <> show b <> " failed to consume " <> show more) +#if 0 -- | Monadic version of decode. decodeMSafe ::   forall a e m. (SafeCopy a, Typeable a, Member DecodeError e, MonadError (OneOf e) m)@@ -72,6 +78,7 @@            Right a -> return a     handle :: ErrorCall -> m a     handle (ErrorCall s) = throwMember (DecodeError bs (fakeTypeRep (Proxy @a)) s)+#endif  -- | Serialize/deserialize prism. decodePrismSafe :: forall a. (SafeCopy a) => Prism' ByteString a
Extra/Serialize.hs view
@@ -20,8 +20,10 @@     , deriveSerializeViaSafeCopy     , decodeAll     , decode'+#if 0     , decodeM     , decodeM'+#endif     , FakeTypeRep(..)     , fakeTypeRep     , decodePrism@@ -39,6 +41,9 @@ #endif import Data.Data (Proxy(Proxy)) import Data.SafeCopy (SafeCopy(..), safeGet, safePut)+#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup (Semigroup((<>)))+#endif import Data.Serialize import Data.Text as T hiding (concat, intercalate) import Data.Text.Lazy as LT hiding (concat, intercalate)@@ -49,11 +54,11 @@ import Data.UUID.Orphans () import Data.UUID (UUID) import Data.UUID.Orphans ()-import Extra.Errors (Member, OneOf, throwMember)+-- import Extra.Errors (Member, OneOf, throwMember) import Extra.Orphans () import Extra.Time (Zulu(..)) import GHC.Generics (Generic)-import Language.Haskell.TH (Dec, Loc, TypeQ, Q)+import Language.Haskell.TH (Dec, Loc(..), TypeQ, Q) import Network.URI (URI(..), URIAuth(..)) import System.IO.Unsafe (unsafePerformIO) @@ -133,6 +138,7 @@ deriving instance Serialize URIAuth deriving instance Serialize Zulu +#if 0 -- | Monadic version of decode. decodeM :: forall a e m. (Serialize a, Typeable a, Member DecodeError e, MonadError (OneOf e) m)   => ByteString@@ -158,6 +164,7 @@            Right a -> return a     handle :: ErrorCall -> m a     handle (ErrorCall s) = throwMember $ DecodeError bs (fakeTypeRep (Proxy @a)) ("ErrorCall: " <> s)+#endif  -- | Version of decode that catches any thrown ErrorCall and modifies -- its message.
sr-extra.cabal view
@@ -1,5 +1,5 @@ Name:           sr-extra-Version:        1.80+Version:        1.85 License:        BSD3 License-File:   COPYING Author:         David Fox@@ -17,6 +17,7 @@ Homepage:       https://github.com/seereason/sr-extra Build-Type:     Simple Cabal-Version:  >= 1.10+Tested-With: GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.5, GHC==8.8.4, GHC==8.10.2  flag network-uri   Description: Get Network.URI from the network-uri package rather than the@@ -46,6 +47,7 @@     directory,     exceptions,     fgl,+    filemanip,     filepath,     generic-data,     hslogger,@@ -88,7 +90,6 @@     Extra.Either,     Extra.EnvPath,     Extra.ErrorControl,-    Extra.Errors,     Extra.ErrorSet,     Extra.Except,     Extra.Exit,@@ -99,8 +100,8 @@     Extra.IOThread     Extra.List,     Extra.HughesPJ,+    Extra.IO,     Extra.LocalStorageEncode,-    Extra.Log,     Extra.Misc,     Extra.Monad.Supply,     Extra.Net,@@ -118,17 +119,18 @@     Extra.URI,     Extra.URIQuery,     Extra.Verbosity+  if impl (ghc >= 8.6)+    Exposed-modules:+      Extra.Errors   if !impl(ghcjs)     Build-Depends:       show-please,-      filemanip,       HUnit,       process,       process-extras     Exposed-Modules:       Extra.GPGSign,       Extra.Lock,-      Extra.IO,       Extra.Process,       Extra.SSH,       Test.QUnit,