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