RFCT Remove unused packages

Cleanup imports too and unused type constraints

Also, add MonadFail to NGLessIO as a future proofing strategy

NGLess/Data/FastQ.hs

@@ -273,12 +273,12 @@ fqStatsC = do
         findMinQValue' :: VU.Vector Int -> Int
         findMinQValue' qs = fromMaybe 256 (VU.findIndex (/= 0) qs)
 
-interleaveFQs :: (Monad m, MonadError NGError m, MonadResource m, MonadUnliftIO m, MonadThrow m) => [(FastQFilePath, FastQFilePath)] -> [FastQFilePath] -> C.ConduitT () B.ByteString m ()
+interleaveFQs :: (MonadError NGError m, MonadResource m, MonadUnliftIO m, MonadThrow m) => [(FastQFilePath, FastQFilePath)] -> [FastQFilePath] -> C.ConduitT () B.ByteString m ()
 interleaveFQs pairs singletons = do
             sequence_ [interleavePair f0 f1 | (FastQFilePath _ f0, FastQFilePath _ f1) <- pairs]
             sequence_ [conduitPossiblyCompressedFile f | FastQFilePath _ f <- singletons]
     where
-        interleavePair :: (Monad m, MonadError NGError m, MonadResource m, MonadUnliftIO m, MonadThrow m) => FilePath -> FilePath -> C.ConduitT () B.ByteString m ()
+        interleavePair :: (MonadError NGError m, MonadResource m, MonadUnliftIO m, MonadThrow m) => FilePath -> FilePath -> C.ConduitT () B.ByteString m ()
         interleavePair f0 f1 =
                 ((conduitPossiblyCompressedFile f0 .| linesC .| CL.chunksOf 4) `zipSources` (conduitPossiblyCompressedFile f1 .| linesC .| CL.chunksOf 4))
                 .| C.awaitForever (\(r0,r1) -> C.yield (ul r0) >> C.yield (ul r1))

NGLess/Data/Sam.hs

@@ -37,7 +37,6 @@ import           Data.Conduit ((.|))
 import qualified Data.Vector as V
 import qualified Data.Vector.Mutable as VM
 import           Data.Strict.Tuple (Pair(..))
-import           Control.Monad.Primitive
 import Data.Bits (testBit)
 import Data.List (intersperse)
 import Control.Error (note)
@@ -252,7 +251,7 @@ readSamGroupsC = CC.concat
 --
 -- When respectPairs is False, then the two mates of the same fragment will be
 -- considered grouped in different blocks
-readSamGroupsC' :: forall m . (MonadError NGError m, PrimMonad m, MonadIO m) => Int -> Bool -> C.ConduitT (V.Vector ByteLine) (V.Vector [SamLine]) m ()
+readSamGroupsC' :: forall m . (MonadError NGError m, MonadIO m) => Int -> Bool -> C.ConduitT (V.Vector ByteLine) (V.Vector [SamLine]) m ()
 readSamGroupsC' mapthreads respectPairs = do
         CC.dropWhileE (isSamHeaderString . unwrapByteLine)
         CC.filter (not . V.null)

NGLess/Interpret.hs

@@ -182,12 +182,13 @@ findFunction :: FuncName -> InterpretationEnvIO (NGLessObject -> KwArgsValues ->
 findFunction fname@(FuncName fname') = do
         mods <- gets ieModules
         case filter hasF mods of
-            [m] -> do
-                let Just func = find ((== fname) . funcName) (modFunctions m)
-                    wrap = if funcAllowsAutoComprehension func
-                                then autoComprehendNB
-                                else id
-                return $ wrap $ (runFunction m) fname'
+            [m] -> case find ((== fname) . funcName) (modFunctions m) of
+                    Just func -> do
+                        let wrap = if funcAllowsAutoComprehension func
+                                        then autoComprehendNB
+                                        else id
+                        return $ wrap $ (runFunction m) fname'
+                    _ ->  throwShouldNotOccur . T.unpack $ T.concat ["Function '", fname', "' not found (not builtin and not in any loaded module), even though it should have."]
             [] -> throwShouldNotOccur . T.unpack $ T.concat ["Function '", fname', "' not found (not builtin and not in any loaded module)"]
             ms -> throwShouldNotOccur . T.unpack $ T.concat (["Function '", T.pack $ show fname, "' found in multiple modules! ("] ++ [T.concat [modname, ":"] | modname <- modName . modInfo <$> ms])
     where
@@ -638,7 +639,9 @@ interpretBlock1 vs (Assignment (Variable n) val) = do
 interpretBlock1 vs Discard = return (BlockResult BlockDiscarded vs)
 interpretBlock1 vs Continue = return (BlockResult BlockContinued vs)
 interpretBlock1 vs (Condition c ifT ifF) = do
-    NGOBool v' <- interpretBlockExpr vs c
+    v' <- interpretBlockExpr vs c >>= \case
+                    NGOBool c' -> return c'
+                    _ -> throwShouldNotOccur "Wrong type for condition (Interpret.hs:interpretBlock1)"
     interpretBlock1 vs (if v' then ifT else ifF)
 interpretBlock1 vs (Sequence expr) = interpretBlock vs expr -- interpret [expr]
 interpretBlock1 vs x = unreachable ("interpretBlock1: This should not have happened " ++ show vs ++ " " ++ show x)
@@ -648,14 +651,18 @@ interpretBlockExpr vs val = local (\(NGLInterpretEnv mods (VariableMapGlobal sm)
 
 interpretPreProcessExpr :: Expression -> InterpretationROEnv NGLessObject
 interpretPreProcessExpr (FunctionCall (FuncName "substrim") var args _) = do
-    NGOShortRead r <- interpretExpr var
+    r <- interpretExpr var >>= \case
+                        NGOShortRead r -> return r
+                        _ -> throwShouldNotOccur "Wrong type in Interpret.hs:interpretExpr"
     args' <- forM args $ \(Variable v, e) -> do
         e' <- interpretExpr e
         return (v, e')
     mq <- fromInteger <$> lookupIntegerOrScriptErrorDef (return 0) "substrim argument" "min_quality" args'
     return . NGOShortRead $ substrim mq r
 interpretPreProcessExpr (FunctionCall (FuncName "endstrim") var args _) = do
-    NGOShortRead r <- interpretExpr var
+    r <- interpretExpr var >>= \case
+                        NGOShortRead r -> return r
+                        _ -> throwShouldNotOccur "Wrong type in Interpret.hs:interpretExpr"
     args' <- forM args $ \(Variable v, e) -> do
         e' <- interpretExpr e
         return (v, e')

NGLess/Interpretation/Select.hs

@@ -81,10 +81,10 @@ matchConditions doReinject conds sg = reinjectSequences doReinject (matchConditi
         toStrictBS = BL.toStrict . BB.toLazyByteString
 
         addSequence s = case find hasSequence (fst <$> sg) of
-                            Just s' -> do
+                            Just s'@SamLine{} -> do
                                         cigar' <- _fixCigar (samCigar s) (B.length $ samSeq s')
                                         return s { samSeq = samSeq s', samQual = samQual s', samCigar = cigar' }
-                            Nothing -> return s
+                            _ -> return s
 
 _fixCigar :: B.ByteString -> Int -> Either NGError B.ByteString
 _fixCigar prev n = do

NGLess/Interpretation/Write.hs

@@ -33,7 +33,7 @@ import           Control.Monad.IO.Unlift (MonadUnliftIO)
 import           Control.Monad (zipWithM_)
 import           Control.Monad.Except
 import           Control.Monad.Catch (MonadMask)
-import           Control.Monad.IO.Class (liftIO, MonadIO)
+import           Control.Monad.IO.Class (liftIO)
 import           System.IO (Handle, stdout)
 import           Data.List (isInfixOf)
 
@@ -70,7 +70,7 @@ data WriteOptions = WriteOptions
                 , woHash :: T.Text
                 } deriving (Eq, Show)
 
-withOutputFile' :: (MonadUnliftIO m, MonadIO m, MonadMask m) => FilePath -> (Handle -> m a) -> m a
+withOutputFile' :: (MonadUnliftIO m, MonadMask m) => FilePath -> (Handle -> m a) -> m a
 withOutputFile' "/dev/stdout" = \inner -> inner stdout
 withOutputFile' fname = withOutputFile fname
 

NGLess/NGLess/NGError.hs

@@ -17,6 +17,7 @@ import           Control.DeepSeq
 import           Control.Monad.Except
 import           Control.Monad.Trans.Resource
 import           Control.Monad.Primitive
+import           Control.Monad.Fail (MonadFail(..))
 import           Control.Monad.Catch
 import           Control.Monad.IO.Unlift
 import           Control.Exception
@@ -66,6 +67,9 @@ instance MonadUnliftIO NGLessIO where
         u <- askUnliftIO
         return $ UnliftIO (\(NGLessIO act) -> unliftIO u act)
 
+instance MonadFail NGLessIO where
+    fail err = throwShouldNotOccur err
+
 runNGLess :: (MonadError NGError m) => Either NGError a -> m a
 runNGLess (Left err) = throwError err
 runNGLess (Right v) = return v

NGLess/Utils/Conduit.hs

@@ -52,7 +52,7 @@ concatrevline line [] = ByteLine $ lineWindowsTerminated line
 concatrevline line toks = ByteLine . lineWindowsTerminated $ B.concat (reverse (line:toks))
 {-# INLINE concatrevline #-}
 
-linesC:: (Monad m, MonadError NGError m) => C.ConduitT B.ByteString ByteLine m ()
+linesC:: (MonadError NGError m) => C.ConduitT B.ByteString ByteLine m ()
 linesC = continue 0 []
     where
         continue n toks
@@ -77,7 +77,7 @@ lineWindowsTerminated line = if not (B.null line) && B.index line (B.length line
 {-# INLINE lineWindowsTerminated #-}
 
 -- | Equivalent to 'linesC .| CC.conduitVector nlines'
-linesVC :: (MonadIO m, Monad m, MonadError NGError m) => Int -> C.ConduitT B.ByteString (V.Vector ByteLine) m ()
+linesVC :: (MonadIO m, MonadError NGError m) => Int -> C.ConduitT B.ByteString (V.Vector ByteLine) m ()
 linesVC nlines = do
             vec <- liftIO $ VM.new nlines
             continue vec 0 0 []

package.yaml

@@ -29,7 +29,6 @@ dependencies:
   - conduit >= 1.3
   - conduit-algorithms >=0.0.3.0
   - conduit-extra >=1.1.12
-  - conduit-combinators
   - configurator
   - containers
   - convertible
@@ -52,7 +51,6 @@ dependencies:
   - IntervalMap >=0.5
   - inline-c
   - inline-c-cpp
-  - monad-control
   - mtl >=2.2
   - MissingH >=1.3
   - network
@@ -71,9 +69,7 @@ dependencies:
   - text >=1.2
   - time >=1.5
   - transformers
-  - transformers-base
   - unix-compat
-  - unliftio
   - unliftio-core
   - vector >=0.11
   - vector-algorithms
@@ -91,6 +87,7 @@ when:
 
 ghc-options:
   - -Wall
+  - -Wcompat
   - -fwarn-tabs
   - -fno-warn-missing-signatures
   - -threaded