<commit_before>{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
-- | Check interpreter
module Control.Biegunka.Check (check) where

import           Control.Concurrent.Async (async, waitCatch)
import           Control.Exception (bracket)
import           Control.Lens hiding (Action)
import           Control.Monad
import           Control.Monad.Free (Free, iter)
import           System.FilePath (splitFileName, splitDirectories, makeRelative)
import           System.Directory.Layout (Layout)
import qualified System.Directory.Layout as Layout
import           System.IO (Handle, hGetLine, hClose, hSetBuffering, BufferMode(..))
import           System.Exit (ExitCode(..))
import qualified System.Posix as Posix
import           Test.Hspec.Formatters (progress)
import           Test.Hspec.Runner (hspecWith, defaultConfig, Config(..), ColorMode(..), summaryFailures)
import           Text.PrettyPrint.ANSI.Leijen (text)

import           Control.Biegunka.Biegunka (Interpreter, interpret)
import           Control.Biegunka.Language
import qualified Control.Biegunka.Log as Log
import           Control.Biegunka.Script
import           Control.Biegunka.Settings (logger)

check :: Interpreter
check = interpret $ \os terms k -> do
  (infd, outfd) <- Posix.createPipe
  withFd infd $ \inh -> do
    a <- async . forever $
      hGetLine inh >>=
        Log.write (view logger os) .  Log.plain . text . (++ "\n")
    s <- withFd outfd $ \outh -> do
      hSetBuffering outh LineBuffering
      hspecWith (defaultConfig
        { configFormatter = progress, configColorMode = ColorAlways, configHandle = Left outh }) $
        Layout.spec (view root os) (termsLayout (view root os) terms)
    waitCatch a
    case summaryFailures s of
      0 -> k
      _ -> return (ExitFailure 1)

withFd :: Posix.Fd -> (Handle -> IO a) -> IO a
withFd fd = bracket (Posix.fdToHandle fd) hClose

termsLayout :: FilePath -> Free (Term Annotate s) () -> Layout ()
termsLayout p = iter go . fmap return where
  go (TS (AS { asUser }) (Source { spath }) innards spec) = do
    Layout.emptydir (rel spath)
      & Layout.user .~ asUser
    termsLayout p innards
    spec
  go (TA (AA { aaUser }) action spec) = do
    case action of
      Link file target ->
        case split (rel target) of
          ~(ds, f) ->
            Layout.dirs ds $
              Layout.symlink f file
                & Layout.user .~ aaUser
                & Layout.exists .~ True
      Copy file target _ ->
        case split (rel target) of
          ~(ds, f) ->
            Layout.dirs ds $
              Layout.file f
                & Layout.contents ?~ Layout.copyOf file
                & Layout.user .~ aaUser
      Template _ target _ ->
        case split (rel target) of
          ~(ds, f) ->
            Layout.dirs ds $<commit_msg>Return the number of failures as the exit code<commit_after>{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
-- | Check interpreter
module Control.Biegunka.Check (check) where

import           Control.Concurrent.Async (async, waitCatch)
import           Control.Exception (bracket)
import           Control.Lens hiding (Action)
import           Control.Monad
import           Control.Monad.Free (Free, iter)
import           System.FilePath (splitFileName, splitDirectories, makeRelative)
import           System.Directory.Layout (Layout)
import qualified System.Directory.Layout as Layout
import           System.IO (Handle, hGetLine, hClose, hSetBuffering, BufferMode(..))
import           System.Exit (ExitCode(..))
import qualified System.Posix as Posix
import           Test.Hspec.Formatters (progress)
import           Test.Hspec.Runner (hspecWith, defaultConfig, Config(..), ColorMode(..), summaryFailures)
import           Text.PrettyPrint.ANSI.Leijen (text)

import           Control.Biegunka.Biegunka (Interpreter, interpret)
import           Control.Biegunka.Language
import qualified Control.Biegunka.Log as Log
import           Control.Biegunka.Script
import           Control.Biegunka.Settings (logger)

check :: Interpreter
check = interpret $ \os terms k -> do
  (infd, outfd) <- Posix.createPipe
  withFd infd $ \inh -> do
    a <- async . forever $
      hGetLine inh >>=
        Log.write (view logger os) .  Log.plain . text . (++ "\n")
    s <- withFd outfd $ \outh -> do
      hSetBuffering outh LineBuffering
      hspecWith (defaultConfig
        { configFormatter = progress, configColorMode = ColorAlways, configHandle = Left outh }) $
        Layout.spec (view root os) (termsLayout (view root os) terms)
    waitCatch a
    case summaryFailures s of
      0 -> k
      n -> return (ExitFailure n)

withFd :: Posix.Fd -> (Handle -> IO a) -> IO a
withFd fd = bracket (Posix.fdToHandle fd) hClose

termsLayout :: FilePath -> Free (Term Annotate s) () -> Layout ()
termsLayout p = iter go . fmap return where
  go (TS (AS { asUser }) (Source { spath }) innards spec) = do
    Layout.emptydir (rel spath)
      & Layout.user .~ asUser
    termsLayout p innards
    spec
  go (TA (AA { aaUser }) action spec) = do
    case action of
      Link file target ->
        case split (rel target) of
          ~(ds, f) ->
            Layout.dirs ds $
              Layout.symlink f file
                & Layout.user .~ aaUser
                & Layout.exists .~ True
      Copy file target _ ->
        case split (rel target) of
          ~(ds, f) ->
            Layout.dirs ds $
              Layout.file f
                & Layout.contents ?~ Layout.copyOf file
                & Layout.user .~ aaUser
      Template _ target _ ->
        case split (rel target) of
          ~(ds, f) ->
            Layout.dirs ds $
{'fraction_non_alphanumeric': 0.10086710316758096, 'fraction_numerical': 0.0005308794903556893, 'mean_word_length': 2.1593068753493574, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 39, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '494237', 'n_tokens_mistral': 1686, 'n_tokens_neox': 1641, 'n_words': 515}