<commit_before>module Shake where

import Development.Shake hiding (getDirectoryContents)
import Development.Shake.FilePath
import Control.Applicative hiding ((*>))
import Control.Monad.IO.Class
import qualified Language.KURE as KURE
import Language.KURE hiding (apply)

import Control.Concurrent.STM

import KURE

data ShakeVar a = ShakeVar (TVar (Maybe a)) String

newShakeVar :: String -> IO (ShakeVar a)
newShakeVar nm = do
        v <- atomically $ newTVar $ Nothing
        return $ ShakeVar v nm

infix 1 !>

(!>) :: (Show a) => ShakeVar a -> Action a -> Rules ()
(!>) (ShakeVar _ nm) m = (== nm) ?> \ out -> do
        r <- m
        writeFileChanged out $ show r

readShakeVar :: (Read a) => ShakeVar a -> Action a
readShakeVar (ShakeVar v nm) = do
        need [nm]
        txt <- readFile' $ nm
        return $ read txt

writeShakeVar :: (Show a) => ShakeVar a -> a -> Action ()
writeShakeVar (ShakeVar _ nm) = do
        writeFileChanged nm . show

-------------------------------------------------------

newtype FPGM a = FPGM { runFPGM :: Action (Either String a) }

applyFPGM' :: Translate Context FPGM a b -> a -> Action b
applyFPGM' t a = do
        res <- runFPGM $ KURE.apply t (Context []) a
        case res of
          Left msg -> error $ "applyFPGM " ++ msg
          Right a -> return a

liftActionFPGM :: Action a -> FPGM a
liftActionFPGM = FPGM . fmap Right

type T a b = Translate Context FPGM a b
type R a   = T a a

instance Monad FPGM where
        return a = FPGM (return (Right a))
        m1 >>= k = FPGM $ do
                r <- runFPGM m1
                case r of
                  Left msg -> return (Left msg)
                  Right a -> runFPGM (k a)
        fail = FPGM . return . Left

instance Functor FPGM where
        fmap f m = pure f <*> m

instance Applicative FPGM where
        pure a = return a
        af <*> aa = af >>= \ f -> aa >>= \ a -> return (f a)

instance MonadCatch FPGM where
        catchM m1 handle = FPGM $ do
                r <- runFPGM m1
                case r of
                  Left msg -> runFPGM $ handle msg
                  Right a -> return (Right a)

instance MonadIO FPGM where
        liftIO m = FPGM (Right <$> liftIO m)<commit_msg>Reworking the FPGM Monad, to sue resumption.<commit_after>{-# LANGUAGE ScopedTypeVariables, GADTs #-}
module Shake where

import Development.Shake hiding (getDirectoryContents)
import Development.Shake.FilePath
import Control.Applicative hiding ((*>))
import Control.Monad.IO.Class
import qualified Language.KURE as KURE
import Language.KURE hiding (apply)

import Control.Concurrent
import Control.Concurrent.STM
import Control.Exception
import KURE

data ShakeVar a = ShakeVar (TVar (Maybe a)) String

newShakeVar :: String -> IO (ShakeVar a)
newShakeVar nm = do
        v <- atomically $ newTVar $ Nothing
        return $ ShakeVar v nm

infix 1 !>

(!>) :: (Show a) => ShakeVar a -> Action a -> Rules ()
(!>) (ShakeVar _ nm) m = (== nm) ?> \ out -> do
        r <- m
        writeFileChanged out $ show r

readShakeVar :: (Read a) => ShakeVar a -> Action a
readShakeVar (ShakeVar v nm) = do
        need [nm]
        txt <- readFile' $ nm
        return $ read txt

writeShakeVar :: (Show a) => ShakeVar a -> a -> Action ()
writeShakeVar (ShakeVar _ nm) = do
        writeFileChanged nm . show

-------------------------------------------------------

--newtype FPGM a = FPGM { runFPGM :: Action (Either String a) }

newtype FPGM a = FPGM { runFPGM :: IO (FPGMResult a) }

data FPGMResult a
        = FPGMResult a
        | FPGMFail String
        | forall r . FPGMAction (Action r) (r -> FPGM a)

applyFPGM' :: forall a b . Translate Context FPGM a b -> a -> Action b
applyFPGM' t a = do

        let loop (FPGMResult a) = return a
            loop (FPGMFail msg) =  fail $ "applyFPGM " ++ msg
            loop (FPGMAction act rest) = do
                              res <- act
                              run (rest res)

            run m = do res <- traced "apply-yah" $ runFPGM m
                       loop res

        run $ KURE.apply t (Context []) a

liftActionFPGM :: Action a -> FPGM a
liftActionFPGM m = FPGM $ return $ FPGMAction  m return

type T a b = Translate Context FPGM a b
type R a   = T a a

instance Monad FPGM where

        return = FPGM . return . FPGMResult

        m1 >>= k = FPGM $ do
                r <- runFPGM m1
                let f (FPGMResult a) = runFPGM (k a)
                    f (FPGMFail msg) = return (FPGMFail msg)
                    f (FPGMAction act rest) = return $ FPGMAction act (\ a -> rest a >>= k)
                f r

        fail = FPGM . return . FPGMFail

instance Functor FPGM where
        fmap f m = pure f <*> m

instance Applicative FPGM where
        pure a = return a
        af <*> aa = af >>= \ f -> aa >>= \ a -> return (f a)


instance MonadCatch FPGM where
        catchM m1 handle = FPGM $ do
                r <- runFPGM m1
                let f (FPGMResult a) = return (FPGMResult a)
                    f (FPGMFail msg) = runFPGM (handle msg)
                    f (FPGMAction act rest) = return (FPGMAction act rest)
                f r
instance MonadIO FPGM where
        liftIO m = FPGM (FPGMResult <$> m)
{'fraction_non_alphanumeric': 0.11669865642994241, 'fraction_numerical': 0.0019193857965451055, 'mean_word_length': 1.833605220228385, 'pattern_counts': {'":': 0, '<': 22, '<?xml version=': 0, '>': 71, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 6, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6210357', 'n_tokens_mistral': 1716, 'n_tokens_neox': 1641, 'n_words': 613}