1 {-# LANGUAGE TupleSections #-} 2 module Databrary.Ingest.Action 3 ( getIngestStatus 4 , runIngest 5 , abortIngest 6 , clearIngest 7 ) where 8 9 import Control.Arrow (left) 10 import Control.Concurrent (killThread) 11 import Control.Concurrent.MVar (readMVar, swapMVar, withMVar, modifyMVar, modifyMVar_) 12 import Control.Monad (join, void) 13 import Data.Int (Int32) 14 import qualified Data.Text as T 15 16 import Databrary.Has (view, focusIO) 17 import Databrary.Action.Types 18 import Databrary.Action.Run 19 import Databrary.Ingest.Service 20 21 getIngestStatus :: Ingest -> IO IngestStatus 22 getIngestStatus = readMVar . ingestStatus 23 24 runIngest :: Handler (Either [T.Text] [Int32]) -> Handler Bool 25 runIngest r = focusIO $ \c -> let v = ingestStatus (view c) in 26 modifyMVar v $ \s -> 27 case s of 28 IngestActive _ -> return (s, False) 29 _ -> (, True) . IngestActive <$> forkAction r c 30 (void . swapMVar v . either IngestFailed IngestCompleted . join . left (return . T.pack . show)) 31 32 abortIngest :: Ingest -> IO () 33 abortIngest Ingest{ ingestStatus = v } = withMVar v abt where 34 abt (IngestActive t) = killThread t 35 abt _ = return () 36 37 clearIngest :: Ingest -> IO () 38 clearIngest Ingest{ ingestStatus = v } = modifyMVar_ v clr where 39 clr s@(IngestActive _) = return s 40 clr _ = return IngestInactive