From 4bca6e91f149bba2853ae202bbfe35817b0aef85 Mon Sep 17 00:00:00 2001 From: Vladislav Sabanov Date: Sat, 12 Aug 2023 16:18:49 -0300 Subject: [PATCH 01/15] Update stack --- stack.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/stack.yaml b/stack.yaml index 90ed806..6f20a80 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-20.17 +resolver: lts-20.26 packages: - . From 16105d7dcafdb904c2119c0356651f3e1350a5fb Mon Sep 17 00:00:00 2001 From: Vladislav Sabanov Date: Sat, 12 Aug 2023 23:53:20 -0300 Subject: [PATCH 02/15] WIP. Update to effectful all except App --- hibet.cabal | 29 ++++----- src/App.hs | 127 +++++++++++++++++++++++-------------- src/Cli.hs | 55 +++++++++------- src/Effects/Console.hs | 64 +++++++++++-------- src/Effects/File.hs | 103 ++++++++++++++++-------------- src/Effects/PrettyPrint.hs | 57 ++++++++++++----- src/Env.hs | 60 ++++++++++++++---- src/Translator.hs | 72 ++++++++++++--------- src/Type.hs | 2 + stack.yaml | 7 +- 10 files changed, 353 insertions(+), 223 deletions(-) diff --git a/hibet.cabal b/hibet.cabal index 7be6f09..cc0f7fe 100644 --- a/hibet.cabal +++ b/hibet.cabal @@ -24,20 +24,15 @@ extra-source-files: tested-with: , GHC==8.10.7 , GHC==9.0.2 - , GHC==9.2.7 + , GHC==9.2.8 source-repository head type: git location: https://github.com/willbasky/Hibet.git -common common-rdp - build-depends: - record-dot-preprocessor - , record-hasfield - - ghc-options: - -fplugin=RecordDotPreprocessor - +common common-dot + default-extensions: + OverloadedRecordDot common common-options build-depends: base >= 4.11 && < 5 @@ -86,9 +81,9 @@ common common-options library import: common-options - , common-rdp + , common-dot ghc-options: - -fplugin=Polysemy.Plugin + -fplugin=Effectful.Plugin hs-source-dirs: src exposed-modules: App @@ -119,6 +114,12 @@ library , containers , deepseq , directory + , effectful-th + , effectful + , effectful-core + , effectful-plugin + , log-effectful + , resourcet-effectful , extra , filepath , gitrev @@ -132,9 +133,6 @@ library , parallel , path , path-io - , polysemy - , polysemy-conc - , polysemy-plugin , prettyprinter , prettyprinter-ansi-terminal , radixtree ^>=0.6.0.0 @@ -199,7 +197,7 @@ test-suite hibet-labels test-suite hibet-env import: common-options - , common-rdp + , common-dot type: exitcode-stdio-1.0 hs-source-dirs: test/env main-is: Main.hs @@ -212,7 +210,6 @@ test-suite hibet-env , bytestring , hspec , containers - , polysemy , text , unordered-containers -- , directory diff --git a/src/App.hs b/src/App.hs index d1c8c65..173c0e5 100644 --- a/src/App.hs +++ b/src/App.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ConstraintKinds #-} module App ( app @@ -8,68 +9,88 @@ import Cli (parser, runCommand) import Effects.Console import Effects.File import Effects.PrettyPrint -import Env (Env, makeEnv) +import Env (Env, makeEnv, putEnvMVar) import Type (HibetError (..)) import Utility (debugEnabledEnvVar) - +import Data.Text.IO as TIO import Data.Function ((&)) -import IncipitCore (Async, asyncToIOFinal) -import Polysemy (Embed, Final, Members, Sem, embedToFinal, runFinal) -import Polysemy.Conc (Race, Sync, interpretRace, interpretSync, withAsync_) -import Polysemy.Error (Error, runError) -import Polysemy.Resource (Resource, runResource) -import Polysemy.Trace (Trace, ignoreTrace, traceToStdout) +import IncipitCore (Async, asyncToIOFinal, SomeException) +import System.IO + +import Effectful +import Effectful.Error.Static +import Effectful.Concurrent +import Effectful.Reader.Dynamic +import Effectful.Concurrent.MVar.Strict +import Effectful.Reader.Dynamic +import Effectful.Resource +import Effectful.Log +import Control.Exception (finally) + +-- import Polysemy (Embed, Final, Members, Sem, embedToFinal, runFinal) +-- import Polysemy.Conc (Race, Sync, interpretRace, interpretSync, withAsync_) +-- import Polysemy.Error (Error, runError) +-- import Polysemy.Resource (Resource, runResource) +-- import Polysemy.Trace (Trace, ignoreTrace, traceToStdout) app :: IO () app = do + print "" isDebug <- debugEnabledEnvVar handleHibetError =<< interpretHibet hibet isDebug -type HibetEffects = - [ - FileIO - , Error HibetError - , Resource - , Console - , PrettyPrint - , Trace - , Sync Env - , Race - , Async - , Embed IO - , Final IO - ] +type HibetEffects es = + ( + Resource :> es + , Error HibetError :> es + , Error SomeException :> es + , FileSystem :> es + , Console :> es + , Reader (MVar Env) :> es + , Concurrent :> es + , PrettyPrint :> es + , Log :> es + -- , Race + -- , Async + -- , Embed IO + -- , Final IO + ) -interpretHibet :: Sem HibetEffects () +interpretHibet :: HibetEffects es => Eff es () -> Bool -- isDebug - -> IO (Either HibetError ()) -interpretHibet program isDebug = program - & runFile - & runError @HibetError - & runResource - & runConsole - & runPrettyPrint - & (if isDebug then traceToStdout else ignoreTrace) - & interpretSync @Env - & interpretRace - & asyncToIOFinal - & embedToFinal - & runFinal + -> IO (Either (CallStack, HibetError) ()) +interpretHibet program isDebug = withStdOutLogger $ \logger -> + program + & runResource + & runError @HibetError + & runFileSystemIO + & runConsole + & runPrettyPrint + & runConcurrent + & runLog "hibet" logger defaultLogLevel + $ runReader + -- & (if isDebug then traceToStdout else ignoreTrace) + -- & interpretSync @Env + -- & interpretRace + -- & asyncToIOFinal + -- & embedToFinal + & runEff -hibet :: Members HibetEffects r => Sem r () +hibet :: HibetEffects es => Eff es () hibet = do - withAsync_ prepareEnv $ do + -- withAsync_ prepareEnv $ do + prepareEnv com <- execParser parser runCommand com -prepareEnv :: Members - [ FileIO - , Error HibetError - , Trace - , Sync Env - , Embed IO - ] r => Sem r () +prepareEnv :: + ( FileSystem :> es + , Error HibetError :> es + , Log :> es + , Reader (MVar Env) :> es + , IOE :> es + ) => Eff es () prepareEnv = do !env <- makeEnv putEnvMVar env @@ -78,5 +99,19 @@ handleHibetError :: Either HibetError a -> IO () handleHibetError = \case Right _ -> pure () Left err -> do - putStrLn "Hibet application failed with exception:" + TIO.putStrLn "Hibet application failed with exception:" print err + +withStdOutLogger :: (Logger -> IO r) -> IO r +withStdOutLogger act = do + logger <- mkLogger "stdout" $ \msg -> do + TIO.putStrLn $ showLogMessage Nothing msg + hFlush stdout + withLogger logger act + +withLogger :: Logger -> (Logger -> IO r) -> IO r +withLogger logger act = act logger `finally` cleanup + where + cleanup = waitForLogger logger >> shutdownLogger logger +-- Prevent GHC from inlining this function so its callers are +{-# NOINLINE withLogger #-} diff --git a/src/Cli.hs b/src/Cli.hs index 7eb4b05..a7bc664 100644 --- a/src/Cli.hs +++ b/src/Cli.hs @@ -8,12 +8,12 @@ module Cli import Effects.Console import Effects.PrettyPrint -import Env (Env) +import Env (Env(..), modifyEnv, readEnv) import Label (LabelFull (..), Labels (..), Title(unTitle)) import Paths_hibet (version) import Pretty import Translator (translator) -import Type (HibetError (..)) +-- import Type (HibetError (..)) import Utility (showT) import Dictionary (selectDict) @@ -29,14 +29,15 @@ import Options.Applicative (Parser, ParserInfo, auto, command, fullDesc, help, h infoHeader, infoOption, long, metavar, option, progDesc, short, subparser) import Options.Applicative.Help.Chunk (stringChunk) -import Polysemy (Members, Member, Sem) -import Polysemy.Conc (Sync) -import qualified Polysemy.Conc.Effect.Sync as Sync -import Polysemy.Error (Error) -import Polysemy.Resource (Resource) import Prelude hiding (lookup) -import Polysemy.Trace (Trace) +import Effectful ( type (:>), Eff, IOE ) +import Effectful.Resource ( Resource ) +import Effectful.Log ( Log ) +import Effectful.Reader.Dynamic (Reader) +import Effectful.Concurrent.MVar.Strict (MVar, Concurrent) + +-- import Polysemy.Trace (Trace) --------------------------------------------------------------------------- -- CLI @@ -54,15 +55,16 @@ data Command data Opt = Names | Meta (Maybe Int) -- | Run 'hibet' with cli command -runCommand :: Members - [ Sync Env - , Trace - , Resource - , PrettyPrint - , Console - , Error HibetError - ] r - => Command -> Sem r () +runCommand :: + ( IOE :> es + , Reader (MVar Env) :> es + , Concurrent :> es + , Log :> es + , Resource :> es + , PrettyPrint :> es + , Console :> es + ) + => Command -> Eff es () runCommand com = do case com of Shell selectedDicts -> do @@ -74,17 +76,22 @@ runCommand com = do env <- readEnv printDebug env.radixWylie -updateEnv :: Member (Sync Env) r +updateEnv :: + ( Reader (MVar Env) :> es + , Concurrent :> es + ) => [Int] - -> Sem r () + -> Eff es () updateEnv selectedDicts = do - env <- Sync.takeBlock - let selectedEnv = env{dictionaryMeta + modifyEnv $ \env -> + pure $ env{dictionaryMeta = selectDict selectedDicts env.dictionaryMeta} - Sync.putBlock selectedEnv -runShow :: Members [Sync Env, PrettyPrint] r - => Opt -> Sem r () +runShow :: + ( Reader (MVar Env) :> es + , Concurrent :> es + , PrettyPrint :> es) + => Opt -> Eff es () runShow opt = do env <- readEnv let Labels labels = env.labels diff --git a/src/Effects/Console.hs b/src/Effects/Console.hs index 12ea69b..44e99aa 100644 --- a/src/Effects/Console.hs +++ b/src/Effects/Console.hs @@ -2,46 +2,56 @@ module Effects.Console where import Options.Applicative (ParserInfo) import qualified Options.Applicative as Opt -import Polysemy (Embed, Member, Sem) -import qualified Polysemy as P -import Polysemy.Conc (Sync) -import qualified Polysemy.Conc.Effect.Sync as Sync -import qualified System.Console.Haskeline as Console +import Control.Exception (SomeException) +import qualified System.Console.Haskeline as Haskeline import System.Console.Haskeline.History (History) import System.Console.Haskeline.IO (InputState) -import qualified System.Console.Haskeline.IO as Console +import qualified System.Console.Haskeline.IO as Haskeline import qualified System.Exit as Exit +import Type (HibetError(..)) +import Utility ( showT ) +import Effectful.TH ( makeEffect ) +import Effectful ( MonadIO(liftIO), type (:>), Effect, Eff, IOE ) +import Effectful.Error.Static + ( CallStack, prettyCallStack, Error, catchError, throwError ) +import Effectful.Dispatch.Dynamic ( interpret ) -data Console m a where - InitializeInput :: Console m InputState +data Console :: Effect where GetInput :: InputState -> String -> Console m (Maybe String) - CancelInput :: InputState -> Console m () CloseInput :: InputState -> Console m () GetHistory :: InputState -> Console m History ExitSuccess :: Console m () ExecParser :: ParserInfo a -> Console m a -P.makeSem ''Console +makeEffect ''Console -runConsole :: Member (Embed IO) r - => Sem (Console : r) a - -> Sem r a -runConsole = P.interpret $ \case - InitializeInput -> P.embed $ Console.initializeInput Console.defaultSettings +runConsole :: + ( IOE :> es + , Error HibetError :> es + , Error SomeException :> es + ) + => Eff (Console : es) a + -> Eff es a +runConsole = interpret $ \_ -> \case GetInput state str -> - P.embed $ Console.queryInput state $ Console.getInputLine str - CancelInput state -> P.embed $ Console.cancelInput state - CloseInput state -> P.embed $ Console.closeInput state - GetHistory state -> P.embed $ Console.queryInput state Console.getHistory - ExitSuccess -> P.embed Exit.exitSuccess - ExecParser info -> P.embed $ Opt.execParser info + adapt $ Haskeline.queryInput state $ Haskeline.getInputLine str + CloseInput state -> adapt $ Haskeline.closeInput state + GetHistory state -> adapt $ Haskeline.queryInput state Haskeline.getHistory + ExitSuccess -> adapt Exit.exitSuccess + ExecParser info -> adapt $ Opt.execParser info -- Helpers -readEnv :: Member (Sync a) r => Sem r a -readEnv = Sync.block - -putEnvMVar :: Member (Sync a) r => a -> Sem r () -putEnvMVar = Sync.putBlock - +adapt :: + ( IOE :> es + , Error HibetError :> es + , Error SomeException :> es + ) + => IO a -> Eff es a +adapt m = catchError (liftIO m) $ + \(stack :: CallStack) (e :: SomeException) -> throwError + $ UnknownError + $ showT e + <> " \nwith stack:\n" + <> showT (prettyCallStack stack) diff --git a/src/Effects/File.hs b/src/Effects/File.hs index 3e10386..1247c82 100644 --- a/src/Effects/File.hs +++ b/src/Effects/File.hs @@ -3,56 +3,65 @@ module Effects.File where import Type (HibetError (..)) import Utility (showT) -import Control.Exception (SomeException, fromException) +import Control.Exception (SomeException, IOException, fromException) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL import Path (Abs, Dir, File, Path, PathException) import qualified Path import Path.IO (listDir) import Paths_hibet (getDataFileName) -import Polysemy (Embed, Member, Members, Sem) -import qualified Polysemy as P -import Polysemy.Error (Error, note, throw) - - -data FileIO m a where - ReadFile :: FilePath -> FileIO m BS.ByteString - ReadFileLazy :: FilePath -> FileIO m BSL.ByteString - GetPath :: FilePath -> FileIO m FilePath - ListDirectory :: Path b Dir -> FileIO m ([Path Abs Dir], [Path Abs File]) - ParseAbsDir :: FilePath -> FileIO r (Path Abs Dir) - -P.makeSem ''FileIO - -runFile :: Members [Embed IO, Error HibetError] r => - Sem (FileIO : r) a -> Sem r a -runFile = P.interpret $ \case - ReadFile path -> P.embed $ BS.readFile path - ReadFileLazy path -> P.embed $ BSL.readFile path - GetPath path -> P.embed $ getDataFileName path - ListDirectory path -> P.embed $ listDir @IO path - ParseAbsDir path -> parseAbsDirS path - - --- Helpers - -irrefutablePathException :: (Member (Error HibetError) r) - => Either SomeException a - -> Sem r a -irrefutablePathException x = case x of - Left e -> do - err <- note (UnknownError $ showT e) $ fromException @PathException e - throw $ PathError err - Right a -> pure a - -parseAbsDirS :: - Member (Error HibetError) r => - FilePath -> - Sem r (Path Abs Dir) -parseAbsDirS x = irrefutablePathException $ Path.parseAbsDir x - -parseAbsFileS :: - Member (Error HibetError) r => - FilePath -> - Sem r (Path Abs File) -parseAbsFileS x = irrefutablePathException $ Path.parseAbsFile x + +import Effectful.TH ( makeEffect ) +import Effectful + ( MonadIO(liftIO), + type (:>), + Effect, + Dispatch(Dynamic), + DispatchOf, + Eff, + IOE ) +import Effectful.Error.Static + ( CallStack, prettyCallStack, Error, catchError, throwError ) +import Effectful.Dispatch.Dynamic ( interpret ) + +data FileSystem :: Effect where + ReadFileBS :: FilePath -> FileSystem m BS.ByteString + ReadFileLazyBS :: FilePath -> FileSystem m BSL.ByteString + GetPath :: FilePath -> FileSystem m FilePath + ListDirectory :: Path b Dir -> FileSystem m ([Path Abs Dir], [Path Abs File]) + ParseAbsDir :: FilePath -> FileSystem r (Path Abs Dir) + +type instance DispatchOf FileSystem = 'Dynamic + +makeEffect ''FileSystem + +runFileSystemIO :: + ( IOE :> es + , Error HibetError :> es + , Error SomeException :> es + ) + => Eff (FileSystem : es) a + -> Eff es a +runFileSystemIO = interpret $ \_ -> \case + ReadFileBS path -> adapt $ BS.readFile path + ReadFileLazyBS path -> adapt $ BSL.readFile path + GetPath path -> adapt $ getDataFileName path + ListDirectory path -> adapt $ listDir @IO path + ParseAbsDir path -> adapt $ Path.parseAbsDir path + +adapt :: + ( IOE :> es + , Error HibetError :> es + , Error SomeException :> es + ) + => IO a -> Eff es a +adapt m = catchError (liftIO m) $ + \(stack :: CallStack) (e :: SomeException) -> + case fromException @IOException e of + Just ioErr -> throwError $ FileError ioErr (showT $ prettyCallStack stack) + Nothing -> case fromException @PathException e of + Just pathErr -> throwError $ PathError pathErr + Nothing -> throwError $ UnknownError $ showT e + + + diff --git a/src/Effects/PrettyPrint.hs b/src/Effects/PrettyPrint.hs index 9fe5a35..a4bc81c 100644 --- a/src/Effects/PrettyPrint.hs +++ b/src/Effects/PrettyPrint.hs @@ -1,13 +1,14 @@ module Effects.PrettyPrint where import Pretty +import Type (HibetError(..)) +import Utility ( showT ) import Control.Monad (when) +import Control.Exception (SomeException) import Data.Maybe (isNothing) import Data.Text (Text) import qualified Data.Text as T -import Polysemy (Embed, Member, Sem) -import qualified Polysemy as P import Prettyprinter (Doc, LayoutOptions (..), PageWidth (..), defaultLayoutOptions, layoutSmart, pretty) import Prettyprinter.Render.Terminal (AnsiStyle, putDoc, renderStrict) @@ -16,24 +17,36 @@ import System.Environment (lookupEnv, setEnv) import System.Pager (printOrPage) import Data.Foldable (traverse_) +import Effectful.TH ( makeEffect ) +import Effectful ( MonadIO(liftIO), type (:>), Effect, Eff, IOE ) +import Effectful.Error.Static + ( CallStack, prettyCallStack, Error, catchError, throwError ) +import Effectful.Dispatch.Dynamic ( interpret, localSeqUnliftIO ) + data Line = NewLine | CurrentLine -data PrettyPrint m a where +data PrettyPrint :: Effect where PutColorDoc :: Colorize -> Line -> Text -> PrettyPrint m () Pprint :: Doc AnsiStyle -> PrettyPrint m () PrintDebug :: Show a => a -> PrettyPrint m () -P.makeSem ''PrettyPrint +makeEffect ''PrettyPrint -runPrettyPrint :: Member (Embed IO) r => Sem (PrettyPrint : r) a -> Sem r a -runPrettyPrint = P.interpret $ \case - PutColorDoc col isNewLine txt -> P.embed $ do - let txtLn = case isNewLine of - NewLine -> txt `T.snoc` '\n' - CurrentLine -> txt - putDoc $ col $ pretty txtLn +runPrettyPrint :: + ( IOE :> es + , Error HibetError :> es + , Error SomeException :> es + ) + => Eff (PrettyPrint : es) a + -> Eff es a +runPrettyPrint = interpret $ \env -> \case + PutColorDoc col isNewLine txt -> adapt $ do + let txtLn = case isNewLine of + NewLine -> txt `T.snoc` '\n' + CurrentLine -> txt + putDoc $ col $ pretty txtLn - Pprint doc -> P.embed $ do + Pprint doc -> localSeqUnliftIO env $ \_ -> do -- enable colors in `less` lessConf <- lookupEnv "LESS" when (isNothing lessConf) $ setEnv "LESS" "-R" @@ -41,10 +54,22 @@ runPrettyPrint = P.interpret $ \case let layoutOptions = defaultLayoutOptions {layoutPageWidth = AvailablePerLine width' 1} printOrPage . (`T.snoc` '\n') . renderStrict $ layoutSmart layoutOptions doc - PrintDebug str -> P.embed $ print str - + PrintDebug str -> adapt $ print str -putColorList :: Member PrettyPrint r +putColorList :: (PrettyPrint:> es) => [(Colorize, Text)] - -> Sem r () + -> Eff es () putColorList = traverse_ (\(c,d) -> putColorDoc c CurrentLine d) + +adapt :: + ( IOE :> es + , Error HibetError :> es + , Error SomeException :> es + ) + => IO a -> Eff es a +adapt m = catchError (liftIO m) $ + \(stack :: CallStack) (e :: SomeException) -> throwError + $ UnknownError + $ showT e + <> " \nwith stack:\n" + <> showT (prettyCallStack stack) diff --git a/src/Env.hs b/src/Env.hs index d394772..ec2e7d4 100644 --- a/src/Env.hs +++ b/src/Env.hs @@ -4,11 +4,14 @@ module Env ( makeEnv , Env(..) + , readEnv + , putEnvMVar + , modifyEnv ) where import Dictionary (DictionaryMeta, makeDictionary, toDictionaryMeta) -import Effects.File (FileIO) +import Effects.File (FileSystem) import qualified Effects.File as File import Label (Labels (..), getLabels) import Parse (TibetWylieMap, WylieTibetMap, mkTibetanRadex, mkWylieRadex, splitSyllables) @@ -23,12 +26,15 @@ import qualified Data.Text.Lazy.Encoding as TLE import Data.Tuple (swap) import GHC.Generics (Generic) import Path (Abs, File, Path, fromAbsFile) -import Polysemy (Members, Sem) -import Polysemy.Error (Error, fromEither, throw) -import Polysemy.Trace (Trace) + +import Effectful ( type (:>), Eff ) +import Effectful.Error.Static ( Error, throwError ) +import Effectful.Concurrent (Concurrent) +import Effectful.Reader.Dynamic (Reader) +import Effectful.Concurrent.MVar.Strict (MVar, modifyMVar_, readMVar, putMVar) +import Effectful.Reader.Dynamic (ask) -- fo debug --- import Polysemy.Trace (trace) -- import qualified Data.Bimap as Bi -- import Parse (WylieSyllable(WylieSyllable)) @@ -46,13 +52,17 @@ data Env = Env deriving anyclass (NFData) -makeEnv :: Members [FileIO, Error HibetError, Trace] r => Sem r Env +makeEnv :: + ( FileSystem :> es + , Error HibetError :> es + ) + => Eff es Env makeEnv = do sylsPath <- File.getPath "stuff/tibetan-syllables" -- trace sylsPath - syls <- TE.decodeUtf8 <$> File.readFile sylsPath - labels@(Labels ls) <- getLabels <$> (File.readFile =<< File.getPath "stuff/titles.toml") + syls <- TE.decodeUtf8 <$> File.readFileBS sylsPath + labels@(Labels ls) <- getLabels <$> (File.readFileBS =<< File.getPath "stuff/titles.toml") dir <- File.getPath "dicts/" absDir <- File.parseAbsDir dir @@ -76,19 +86,40 @@ makeEnv = do , labels = labels } -getFilesTexts :: Members - [ FileIO - , Error HibetError] r - => [Path Abs File] -> Sem r [(FilePath, TL.Text)] +getFilesTexts :: + ( FileSystem :> es + , Error HibetError :> es + ) + => [Path Abs File] + -> Eff es [(FilePath, TL.Text)] getFilesTexts fp = do let paths = map fromAbsFile fp - let contents = map (fmap TLE.decodeUtf8 . File.readFileLazy) paths + let contents = map (fmap TLE.decodeUtf8 . File.readFileLazyBS) paths txts <- sequenceA contents if length paths == length txts then pure $ zip paths txts - else throw $ UnknownError "Not all dictionary files was read successfully" + else throwError $ UnknownError "Not all dictionary files was read successfully" +fromEither :: (Error HibetError :> es) + => Either HibetError a + -> Eff es a +fromEither (Left err) = throwError err +fromEither (Right res) = pure res +readEnv :: (Reader (MVar Env) :> es, Concurrent :> es) => Eff es Env +readEnv = do + env <- ask + readMVar env + +modifyEnv :: (Reader (MVar Env) :> es, Concurrent :> es) => (Env -> Eff es Env) -> Eff es () +modifyEnv f = do + env <- ask + modifyMVar_ env f + +putEnvMVar :: (Reader (MVar a) :> es, Concurrent :> es) => a -> Eff es () +putEnvMVar value = do + env <- ask + putMVar env value -- getFilesTextsPar fs = mapM (\f -> do -- let path = fromAbsFile f @@ -108,3 +139,4 @@ getFilesTexts fp = do -- parTraverseC strat f = withStrategy (parTraversable strat) . traverse f -- traverse :: Applicative f => (a -> f b) -> t a -> f (t b) -- mapM :: Monad m => (a -> m b) -> t a -> m (t b) + diff --git a/src/Translator.hs b/src/Translator.hs index a59a99d..dfb0e92 100644 --- a/src/Translator.hs +++ b/src/Translator.hs @@ -1,13 +1,14 @@ + + module Translator ( translator ) where import Dictionary (Answer, searchTranslation, sortOutput) -import Effects.Console (Console, cancelInput, closeInput, exitSuccess, getHistory, getInput, - initializeInput, readEnv) +import Effects.Console (Console, closeInput, exitSuccess, getHistory, getInput) import Effects.PrettyPrint (Line (NewLine), PrettyPrint, pprint, putColorDoc) -import Env (Env) +import Env (Env(..), readEnv) import Parse (ScriptType (Tibet, Wylie), fromScripts, parseEither, parseTibetanInput, parseWylieInput, tibetanWord, toTibetan, toWylie, wylieWord) import Pretty (blue, red, viewTranslations, withHeaderSpaces, yellow) @@ -21,29 +22,34 @@ import Data.Maybe (mapMaybe) import Data.Text (Text) import qualified Data.Text as T import qualified Debug.Trace as Debug -import Polysemy (Members, Sem) -import Polysemy.Conc (Sync) -import Polysemy.Error (Error) -import Polysemy.Resource (Resource, bracketOnError) -import Polysemy.Trace (Trace, trace) import Prettyprinter (Doc) import Prettyprinter.Render.Terminal (AnsiStyle) import System.Console.Haskeline.History (History, historyLines) import System.Console.Haskeline.IO (InputState) +import qualified System.Console.Haskeline.IO as Haskeline +import qualified System.Console.Haskeline as Haskeline + +import Effectful ( type (:>), Eff, IOE ) +import Effectful.Resource ( allocate, release, Resource ) +import Effectful.Log ( logInfo_, Log ) +import Effectful.Reader.Dynamic (Reader) +import Effectful.Concurrent.MVar.Strict (MVar, Concurrent) + -- | Load environment and start loop dialog -translator :: Members - [ PrettyPrint - , Trace - , Resource - , Console - , Error HibetError - , Sync Env - ] r - => Sem r () +translator :: + ( IOE :> es + , PrettyPrint :> es + , Log :> es + , Resource :> es + , Console :> es + , Reader (MVar Env) :> es + , Concurrent :> es + ) + => Eff es () translator = bracketOnError - initializeInput - cancelInput -- This will only be called if an exception such as a SigINT is received. + (Haskeline.initializeInput Haskeline.defaultSettings) + Haskeline.cancelInput -- This will only be called if an exception such as a SigINT is received. $ \inputState -> do putColorDoc blue NewLine "Please, input any word with tibetan script or wylie transcription!\nWhat is your request? " loopDialog inputState @@ -51,15 +57,15 @@ translator = bracketOnError -- Looped dialog with user -loopDialog :: Members - [ PrettyPrint - , Trace - , Console - , Error HibetError - , Sync Env - ] r +loopDialog :: + ( PrettyPrint :> es + , Log :> es + , Console :> es + , Reader (MVar Env) :> es + , Concurrent :> es + ) => InputState - -> Sem r () + -> Eff es () loopDialog inputState = forever $ do mQuery <- getInput inputState "> " case T.strip . T.pack <$> mQuery of @@ -74,13 +80,12 @@ loopDialog inputState = forever $ do env <- readEnv case getAnswer input env of Left err -> do - trace $ show err + logInfo_ $ showT err putColorDoc red NewLine "Nothing found" Right (query, answer) -> if null answer then putColorDoc red NewLine "Nothing found" else pprint $ mkOutput query answer - getAnswer :: Text -> Env -> Either HibetError (Text, [Answer]) getAnswer query env = do -- 1. Detect script of input @@ -146,3 +151,12 @@ mkOutput query answers = withHeaderSpaces yellow query $ viewTranslations $ sortOutput answers + +bracketOnError :: (IOE :> es, Resource :> es) + => IO a + -> (a -> IO ()) + -> (a -> Eff es ()) -> Eff es () +bracketOnError alloc free inside = do + (releaseKey, resource) <- allocate alloc free + inside resource + release releaseKey diff --git a/src/Type.hs b/src/Type.hs index fe2957b..80ec6fb 100644 --- a/src/Type.hs +++ b/src/Type.hs @@ -8,10 +8,12 @@ import Data.Text (Text) import Data.Void (Void) import Path (PathException) import Text.Megaparsec.Error (ParseErrorBundle) +import Control.Exception (IOException) data HibetError = PathError PathException + | FileError IOException Text | MegaError (ParseErrorBundle Text Void) | NotFound | NotSyllable Text diff --git a/stack.yaml b/stack.yaml index 6f20a80..adea5b7 100644 --- a/stack.yaml +++ b/stack.yaml @@ -4,10 +4,6 @@ packages: - . extra-deps: -- polysemy-1.9.0.0 -- polysemy-conc-0.12.1.0 -- polysemy-resume-0.7.0.0 -- polysemy-time-0.6.0.0 - incipit-base-0.5.1.0 - incipit-core-0.5.1.0 @@ -15,6 +11,9 @@ extra-deps: - tomland-1.3.3.2 - validation-selective-0.1.0.2 +- log-effectful-1.0.0.0 +- log-base-0.12.0.0 +- resourcet-effectful-1.0.0.0 ghc-options: "$locals": -fhide-source-paths From 4d70ebc405af11778973b4fc85c6ead6c3d2ef3d Mon Sep 17 00:00:00 2001 From: Vladislav Sabanov Date: Sun, 13 Aug 2023 12:39:43 -0300 Subject: [PATCH 03/15] Update app --- CHANGELOG.md | 5 ++ hibet.cabal | 12 +++- src/App.hs | 112 ++++++++++++++++++------------------- src/Effects/Common.hs | 15 +++++ src/Effects/Console.hs | 27 ++------- src/Effects/File.hs | 29 ++-------- src/Effects/PrettyPrint.hs | 22 +------- src/Translator.hs | 4 +- src/Type.hs | 8 +-- stack.yaml | 3 - 10 files changed, 99 insertions(+), 138 deletions(-) create mode 100644 src/Effects/Common.hs diff --git a/CHANGELOG.md b/CHANGELOG.md index 5062ff0..d4f997a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,11 @@ and this project adheres to [Haskell Package Versioning Policy](https://pvp.haskell.org/). +## [1.3.8] - 2023-08-13 + +* Land on `effectful` effect system. Remove polysemy +* Bump stack version to lts-20.26 and GHC-9.2.8 + ## [1.3.7] - 2023-04-06 * Bump stack version to lts-20.17 and GHC-9.2.7 diff --git a/hibet.cabal b/hibet.cabal index cc0f7fe..f8b4cf3 100644 --- a/hibet.cabal +++ b/hibet.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: hibet -version: 1.3.7 +version: 1.3.8 description: tibetan-english translator synopsis: translator homepage: https://github.com/willbasky/Hibet @@ -88,6 +88,7 @@ library exposed-modules: App Cli + Effects.Common Effects.File Effects.Console Effects.PrettyPrint @@ -125,7 +126,6 @@ library , gitrev , haskeline , hashable - , incipit-core , megaparsec , neat-interpolation , optparse-applicative @@ -152,7 +152,6 @@ executable hibet -- ^ for threadscope -threaded -rtsopts - -with-rtsopts=-N -Wincomplete-uni-patterns -Wincomplete-record-updates -Wcompat @@ -161,6 +160,13 @@ executable hibet -fhide-source-paths -Wmissing-export-lists -Wpartial-fields + + -with-rtsopts=-N16 + -with-rtsopts=-qn8 + -with-rtsopts=-A64m + -with-rtsopts=-AL256m + -with-rtsopts=-I0 + -with-rtsopts=-T build-depends: hibet diff --git a/src/App.hs b/src/App.hs index 173c0e5..3ec7bb9 100644 --- a/src/App.hs +++ b/src/App.hs @@ -6,101 +6,95 @@ module App ) where import Cli (parser, runCommand) -import Effects.Console -import Effects.File -import Effects.PrettyPrint import Env (Env, makeEnv, putEnvMVar) import Type (HibetError (..)) -import Utility (debugEnabledEnvVar) import Data.Text.IO as TIO import Data.Function ((&)) -import IncipitCore (Async, asyncToIOFinal, SomeException) -import System.IO +import System.IO ( hFlush, stdout, putStrLn ) -import Effectful +import Effects.Console ( Console, execParser, runConsole ) +import Effects.File ( FileSystem, runFileSystemIO ) +import Effects.PrettyPrint ( PrettyPrint, runPrettyPrint ) +import Effectful ( runEff, type (:>), Eff, IOE ) import Effectful.Error.Static -import Effectful.Concurrent -import Effectful.Reader.Dynamic -import Effectful.Concurrent.MVar.Strict -import Effectful.Reader.Dynamic -import Effectful.Resource + ( CallStack, prettyCallStack, Error, runError ) +import Effectful.Concurrent ( runConcurrent, Concurrent ) +import Effectful.Concurrent.Async (withAsync) +import Effectful.Concurrent.MVar.Strict ( MVar, newEmptyMVar ) +import Effectful.Reader.Dynamic ( runReader, Reader ) +import Effectful.Resource ( runResource, Resource ) import Effectful.Log + ( defaultLogLevel, + showLogMessage, + shutdownLogger, + waitForLogger, + mkLogger, + runLog, + Logger, + Log ) import Control.Exception (finally) --- import Polysemy (Embed, Final, Members, Sem, embedToFinal, runFinal) --- import Polysemy.Conc (Race, Sync, interpretRace, interpretSync, withAsync_) --- import Polysemy.Error (Error, runError) --- import Polysemy.Resource (Resource, runResource) --- import Polysemy.Trace (Trace, ignoreTrace, traceToStdout) app :: IO () app = do - print "" - isDebug <- debugEnabledEnvVar - handleHibetError =<< interpretHibet hibet isDebug + errs <- withStdOutLogger $ \logger -> interpretHibet hibet logger + handleHibetError errs -type HibetEffects es = - ( - Resource :> es - , Error HibetError :> es - , Error SomeException :> es - , FileSystem :> es - , Console :> es - , Reader (MVar Env) :> es - , Concurrent :> es - , PrettyPrint :> es - , Log :> es - -- , Race - -- , Async - -- , Embed IO - -- , Final IO - ) +type HibetEffects = + '[ + Concurrent + , Resource + , Console + , FileSystem + , PrettyPrint + , Error HibetError + , Log + , IOE + ] -interpretHibet :: HibetEffects es => Eff es () - -> Bool -- isDebug - -> IO (Either (CallStack, HibetError) ()) -interpretHibet program isDebug = withStdOutLogger $ \logger -> + +interpretHibet :: Eff HibetEffects a + -> Logger + -> IO (Either (CallStack, HibetError) a) +interpretHibet program logger = program + & runConcurrent & runResource - & runError @HibetError - & runFileSystemIO & runConsole + & runFileSystemIO & runPrettyPrint - & runConcurrent + & runError @HibetError & runLog "hibet" logger defaultLogLevel - $ runReader - -- & (if isDebug then traceToStdout else ignoreTrace) - -- & interpretSync @Env - -- & interpretRace - -- & asyncToIOFinal - -- & embedToFinal & runEff -hibet :: HibetEffects es => Eff es () +hibet :: Eff HibetEffects () hibet = do - -- withAsync_ prepareEnv $ do - prepareEnv - com <- execParser parser - runCommand com + mv <- newEmptyMVar + runReader mv $ withAsync prepareEnv $ \_ -> do + com <- execParser parser + runCommand com prepareEnv :: ( FileSystem :> es , Error HibetError :> es - , Log :> es , Reader (MVar Env) :> es - , IOE :> es + , Concurrent :> es ) => Eff es () prepareEnv = do !env <- makeEnv putEnvMVar env -handleHibetError :: Either HibetError a -> IO () +handleHibetError :: + Either (CallStack, HibetError) a + -> IO () handleHibetError = \case Right _ -> pure () - Left err -> do + Left (stack, err) -> do TIO.putStrLn "Hibet application failed with exception:" print err + TIO.putStrLn "The stack is:" + System.IO.putStrLn $ prettyCallStack stack withStdOutLogger :: (Logger -> IO r) -> IO r withStdOutLogger act = do @@ -114,4 +108,4 @@ withLogger logger act = act logger `finally` cleanup where cleanup = waitForLogger logger >> shutdownLogger logger -- Prevent GHC from inlining this function so its callers are -{-# NOINLINE withLogger #-} +-- {-# NOINLINE withLogger #-} diff --git a/src/Effects/Common.hs b/src/Effects/Common.hs new file mode 100644 index 0000000..39f4ab5 --- /dev/null +++ b/src/Effects/Common.hs @@ -0,0 +1,15 @@ +module Effects.Common where + +import Type (HibetError(..)) +import Utility ( showT ) + +import Effectful ( MonadIO(liftIO), type (:>), Eff, IOE ) +import Effectful.Error.Static ( Error, catchError, throwError ) + +adapt :: + ( IOE :> es + , Error HibetError :> es + ) + => IO a -> Eff es a +adapt m = catchError (liftIO m) $ + \stack err -> throwError $ EffectError (showT err) stack diff --git a/src/Effects/Console.hs b/src/Effects/Console.hs index 44e99aa..32bbe1b 100644 --- a/src/Effects/Console.hs +++ b/src/Effects/Console.hs @@ -1,20 +1,19 @@ module Effects.Console where +import Type (HibetError(..)) +import Effects.Common (adapt) + import Options.Applicative (ParserInfo) import qualified Options.Applicative as Opt -import Control.Exception (SomeException) import qualified System.Console.Haskeline as Haskeline import System.Console.Haskeline.History (History) import System.Console.Haskeline.IO (InputState) import qualified System.Console.Haskeline.IO as Haskeline import qualified System.Exit as Exit -import Type (HibetError(..)) -import Utility ( showT ) import Effectful.TH ( makeEffect ) -import Effectful ( MonadIO(liftIO), type (:>), Effect, Eff, IOE ) -import Effectful.Error.Static - ( CallStack, prettyCallStack, Error, catchError, throwError ) +import Effectful ( type (:>), Effect, Eff, IOE ) +import Effectful.Error.Static ( Error ) import Effectful.Dispatch.Dynamic ( interpret ) data Console :: Effect where @@ -29,7 +28,6 @@ makeEffect ''Console runConsole :: ( IOE :> es , Error HibetError :> es - , Error SomeException :> es ) => Eff (Console : es) a -> Eff es a @@ -40,18 +38,3 @@ runConsole = interpret $ \_ -> \case GetHistory state -> adapt $ Haskeline.queryInput state Haskeline.getHistory ExitSuccess -> adapt Exit.exitSuccess ExecParser info -> adapt $ Opt.execParser info - --- Helpers - -adapt :: - ( IOE :> es - , Error HibetError :> es - , Error SomeException :> es - ) - => IO a -> Eff es a -adapt m = catchError (liftIO m) $ - \(stack :: CallStack) (e :: SomeException) -> throwError - $ UnknownError - $ showT e - <> " \nwith stack:\n" - <> showT (prettyCallStack stack) diff --git a/src/Effects/File.hs b/src/Effects/File.hs index 1247c82..7cc7718 100644 --- a/src/Effects/File.hs +++ b/src/Effects/File.hs @@ -1,27 +1,24 @@ module Effects.File where import Type (HibetError (..)) -import Utility (showT) +import Effects.Common (adapt) -import Control.Exception (SomeException, IOException, fromException) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL -import Path (Abs, Dir, File, Path, PathException) +import Path (Abs, Dir, File, Path) import qualified Path import Path.IO (listDir) import Paths_hibet (getDataFileName) import Effectful.TH ( makeEffect ) import Effectful - ( MonadIO(liftIO), - type (:>), + ( type (:>), Effect, Dispatch(Dynamic), DispatchOf, Eff, IOE ) -import Effectful.Error.Static - ( CallStack, prettyCallStack, Error, catchError, throwError ) +import Effectful.Error.Static ( Error ) import Effectful.Dispatch.Dynamic ( interpret ) data FileSystem :: Effect where @@ -38,7 +35,6 @@ makeEffect ''FileSystem runFileSystemIO :: ( IOE :> es , Error HibetError :> es - , Error SomeException :> es ) => Eff (FileSystem : es) a -> Eff es a @@ -48,20 +44,3 @@ runFileSystemIO = interpret $ \_ -> \case GetPath path -> adapt $ getDataFileName path ListDirectory path -> adapt $ listDir @IO path ParseAbsDir path -> adapt $ Path.parseAbsDir path - -adapt :: - ( IOE :> es - , Error HibetError :> es - , Error SomeException :> es - ) - => IO a -> Eff es a -adapt m = catchError (liftIO m) $ - \(stack :: CallStack) (e :: SomeException) -> - case fromException @IOException e of - Just ioErr -> throwError $ FileError ioErr (showT $ prettyCallStack stack) - Nothing -> case fromException @PathException e of - Just pathErr -> throwError $ PathError pathErr - Nothing -> throwError $ UnknownError $ showT e - - - diff --git a/src/Effects/PrettyPrint.hs b/src/Effects/PrettyPrint.hs index a4bc81c..26018cf 100644 --- a/src/Effects/PrettyPrint.hs +++ b/src/Effects/PrettyPrint.hs @@ -2,10 +2,9 @@ module Effects.PrettyPrint where import Pretty import Type (HibetError(..)) -import Utility ( showT ) +import Effects.Common (adapt) import Control.Monad (when) -import Control.Exception (SomeException) import Data.Maybe (isNothing) import Data.Text (Text) import qualified Data.Text as T @@ -18,9 +17,8 @@ import System.Pager (printOrPage) import Data.Foldable (traverse_) import Effectful.TH ( makeEffect ) -import Effectful ( MonadIO(liftIO), type (:>), Effect, Eff, IOE ) -import Effectful.Error.Static - ( CallStack, prettyCallStack, Error, catchError, throwError ) +import Effectful ( type (:>), Effect, Eff, IOE ) +import Effectful.Error.Static ( Error ) import Effectful.Dispatch.Dynamic ( interpret, localSeqUnliftIO ) data Line = NewLine | CurrentLine @@ -35,7 +33,6 @@ makeEffect ''PrettyPrint runPrettyPrint :: ( IOE :> es , Error HibetError :> es - , Error SomeException :> es ) => Eff (PrettyPrint : es) a -> Eff es a @@ -60,16 +57,3 @@ putColorList :: (PrettyPrint:> es) => [(Colorize, Text)] -> Eff es () putColorList = traverse_ (\(c,d) -> putColorDoc c CurrentLine d) - -adapt :: - ( IOE :> es - , Error HibetError :> es - , Error SomeException :> es - ) - => IO a -> Eff es a -adapt m = catchError (liftIO m) $ - \(stack :: CallStack) (e :: SomeException) -> throwError - $ UnknownError - $ showT e - <> " \nwith stack:\n" - <> showT (prettyCallStack stack) diff --git a/src/Translator.hs b/src/Translator.hs index dfb0e92..ed27b23 100644 --- a/src/Translator.hs +++ b/src/Translator.hs @@ -51,7 +51,7 @@ translator = bracketOnError (Haskeline.initializeInput Haskeline.defaultSettings) Haskeline.cancelInput -- This will only be called if an exception such as a SigINT is received. $ \inputState -> do - putColorDoc blue NewLine "Please, input any word with tibetan script or wylie transcription!\nWhat is your request? " + putColorDoc blue NewLine "Input a word in the tibetan script or wylie transcription:" loopDialog inputState closeInput inputState @@ -71,7 +71,7 @@ loopDialog inputState = forever $ do case T.strip . T.pack <$> mQuery of Nothing -> pure () Just ":q" -> do - putColorDoc yellow NewLine "Bye-bye!" + putColorDoc yellow NewLine "ཞེས་བསྟན་འཛིན་བཟང་པོ། Bye!" exitSuccess Just ":h" -> do history <- fromHistory <$> getHistory inputState diff --git a/src/Type.hs b/src/Type.hs index 80ec6fb..017beeb 100644 --- a/src/Type.hs +++ b/src/Type.hs @@ -6,16 +6,14 @@ module Type import Data.Text (Text) import Data.Void (Void) -import Path (PathException) import Text.Megaparsec.Error (ParseErrorBundle) -import Control.Exception (IOException) +import GHC.Stack ( CallStack ) data HibetError - = PathError PathException - | FileError IOException Text + = EffectError Text CallStack | MegaError (ParseErrorBundle Text Void) | NotFound | NotSyllable Text | UnknownError Text - deriving stock (Eq, Show) + deriving stock Show diff --git a/stack.yaml b/stack.yaml index adea5b7..389c5e5 100644 --- a/stack.yaml +++ b/stack.yaml @@ -4,9 +4,6 @@ packages: - . extra-deps: -- incipit-base-0.5.1.0 -- incipit-core-0.5.1.0 - - radixtree-0.6.0.0 - tomland-1.3.3.2 From 6dbb03b01ed6f369e35ae870849e13a34558a552 Mon Sep 17 00:00:00 2001 From: Vladislav Sabanov Date: Sun, 13 Aug 2023 13:52:07 -0300 Subject: [PATCH 04/15] Update configs --- .github/workflows/haskell-ci.yml | 18 ++++++++++-------- hie.yaml | 31 +++++++++++++++++++++++++++++++ 2 files changed, 41 insertions(+), 8 deletions(-) create mode 100644 hie.yaml diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index f9a8f8d..4c042dc 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.16 +# version: 0.17.20230811 # -# REGENDATA ("0.16",["github","cabal.project"]) +# REGENDATA ("0.17.20230811",["github","cabal.project"]) # name: Haskell-CI on: @@ -28,9 +28,9 @@ jobs: strategy: matrix: include: - - compiler: ghc-9.2.7 + - compiler: ghc-9.2.8 compilerKind: ghc - compilerVersion: 9.2.7 + compilerVersion: 9.2.8 setup-method: ghcup allow-failure: false - compiler: ghc-9.0.2 @@ -50,7 +50,7 @@ jobs: apt-get update apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.19.2/x86_64-linux-ghcup-0.1.19.2 > "$HOME/.ghcup/bin/ghcup" + curl -sL https://downloads.haskell.org/ghcup/0.1.19.5/x86_64-linux-ghcup-0.1.19.5 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) @@ -65,10 +65,12 @@ jobs: echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" HCDIR=/opt/$HCKIND/$HCVER - HC=$HOME/.ghcup/bin/$HCKIND-$HCVER + HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER") + HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#') + HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#') echo "HC=$HC" >> "$GITHUB_ENV" - echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV" - echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV" + echo "HCPKG=$HCPKG" >> "$GITHUB_ENV" + echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV" echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" diff --git a/hie.yaml b/hie.yaml new file mode 100644 index 0000000..6514da4 --- /dev/null +++ b/hie.yaml @@ -0,0 +1,31 @@ +cradle: + stack: + - path: "./src" + component: "hibet:lib" + + - path: "./app/Main.hs" + component: "hibet:exe:hibet" + + - path: "./test/pretty" + component: "hibet:test:hibet-pretty" + + - path: "./test/labels" + component: "hibet:test:hibet-labels" + + - path: "./test/env" + component: "hibet:test:hibet-env" + + - path: "./test/parse" + component: "hibet:test:hibet-parse" + + - path: "./benchmark/Main.hs" + component: "hibet:bench:hibet-benchmark" + + - path: "./benchmark/Paths_hibet.hs" + component: "hibet:bench:hibet-benchmark" + + - path: "./benchmark/Lines.hs" + component: "hibet:bench:hibet-benchmark" + + - path: "./benchmark/Common.hs" + component: "hibet:bench:hibet-benchmark" From ccd3b694aad5e9312216066d40f22bc639aac28b Mon Sep 17 00:00:00 2001 From: Vladislav Sabanov Date: Sat, 19 Aug 2023 20:55:41 -0300 Subject: [PATCH 05/15] Some refactoring --- .gitignore | 2 ++ hibet.cabal | 6 +++++- src/App.hs | 24 ++++++++++++------------ src/Dictionary.hs | 3 ++- src/Effects/PrettyPrint.hs | 3 ++- src/Env.hs | 2 ++ 6 files changed, 25 insertions(+), 15 deletions(-) diff --git a/.gitignore b/.gitignore index 00ff0b6..1ae62e5 100644 --- a/.gitignore +++ b/.gitignore @@ -54,6 +54,7 @@ TAGS # other .DS_Store .gitignore +*.html # custom thinking.txt @@ -67,3 +68,4 @@ PKGBUILD hibet/ pkg/ .hie/ + diff --git a/hibet.cabal b/hibet.cabal index f8b4cf3..74ff4dc 100644 --- a/hibet.cabal +++ b/hibet.cabal @@ -52,6 +52,10 @@ common common-options -hiedir=.hie -Wunused-packages -- -ddump-if-trace + -- -O2 + -- -eventlog + -- -finfo-table-map + -- -fdistinct-constructor-tables default-language: Haskell2010 @@ -164,7 +168,7 @@ executable hibet -with-rtsopts=-N16 -with-rtsopts=-qn8 -with-rtsopts=-A64m - -with-rtsopts=-AL256m + -with-rtsopts=-AL128m -with-rtsopts=-I0 -with-rtsopts=-T build-depends: diff --git a/src/App.hs b/src/App.hs index 3ec7bb9..a4d59ca 100644 --- a/src/App.hs +++ b/src/App.hs @@ -6,9 +6,9 @@ module App ) where import Cli (parser, runCommand) -import Env (Env, makeEnv, putEnvMVar) +import Env (Env, makeEnv) import Type (HibetError (..)) -import Data.Text.IO as TIO +import qualified Data.Text.IO as TIO import Data.Function ((&)) import System.IO ( hFlush, stdout, putStrLn ) @@ -20,8 +20,8 @@ import Effectful.Error.Static ( CallStack, prettyCallStack, Error, runError ) import Effectful.Concurrent ( runConcurrent, Concurrent ) import Effectful.Concurrent.Async (withAsync) -import Effectful.Concurrent.MVar.Strict ( MVar, newEmptyMVar ) -import Effectful.Reader.Dynamic ( runReader, Reader ) +import Effectful.Concurrent.MVar.Strict ( MVar, newEmptyMVar, putMVar ) +import Effectful.Reader.Dynamic ( runReader ) import Effectful.Resource ( runResource, Resource ) import Effectful.Log ( defaultLogLevel, @@ -35,10 +35,10 @@ import Effectful.Log import Control.Exception (finally) - app :: IO () app = do - errs <- withStdOutLogger $ \logger -> interpretHibet hibet logger + errs <- withStdOutLogger $ \logger -> do + interpretHibet hibet logger handleHibetError errs type HibetEffects = @@ -70,20 +70,20 @@ interpretHibet program logger = hibet :: Eff HibetEffects () hibet = do - mv <- newEmptyMVar - runReader mv $ withAsync prepareEnv $ \_ -> do + mv <- newEmptyMVar + withAsync (prepareEnv mv) $ \_ -> + runReader mv $ do com <- execParser parser runCommand com prepareEnv :: ( FileSystem :> es , Error HibetError :> es - , Reader (MVar Env) :> es , Concurrent :> es - ) => Eff es () -prepareEnv = do + ) => MVar Env -> Eff es () +prepareEnv mv = do !env <- makeEnv - putEnvMVar env + putMVar mv env handleHibetError :: Either (CallStack, HibetError) a diff --git a/src/Dictionary.hs b/src/Dictionary.hs index 040252a..06dc5f4 100644 --- a/src/Dictionary.hs +++ b/src/Dictionary.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE BangPatterns #-} module Dictionary @@ -76,7 +77,7 @@ selectDict selected dicts = case selected of toDictionaryMeta :: [LabelFull] -> FilePath -> Dictionary -> DictionaryMeta toDictionaryMeta labels filepath dict = DictionaryMeta dict title number where - (title, number) = findTitle $ T.pack $ takeBaseName filepath + (!title, !number) = findTitle $ T.pack $ takeBaseName filepath -- Match filpath with labels findTitle :: Text -> (Title, Int) findTitle path = maybe (Title "Invalid title",0) (\lf -> (lf.label, lf.lfId)) diff --git a/src/Effects/PrettyPrint.hs b/src/Effects/PrettyPrint.hs index 26018cf..5ee68bb 100644 --- a/src/Effects/PrettyPrint.hs +++ b/src/Effects/PrettyPrint.hs @@ -15,6 +15,7 @@ import qualified System.Console.Terminal.Size as Terminal import System.Environment (lookupEnv, setEnv) import System.Pager (printOrPage) import Data.Foldable (traverse_) +import qualified Data.ByteString.Char8 as BSC8 import Effectful.TH ( makeEffect ) import Effectful ( type (:>), Effect, Eff, IOE ) @@ -51,7 +52,7 @@ runPrettyPrint = interpret $ \env -> \case let layoutOptions = defaultLayoutOptions {layoutPageWidth = AvailablePerLine width' 1} printOrPage . (`T.snoc` '\n') . renderStrict $ layoutSmart layoutOptions doc - PrintDebug str -> adapt $ print str + PrintDebug str -> adapt $ BSC8.putStrLn $ BSC8.pack $ show str putColorList :: (PrettyPrint:> es) => [(Colorize, Text)] diff --git a/src/Env.hs b/src/Env.hs index ec2e7d4..b0b0cb4 100644 --- a/src/Env.hs +++ b/src/Env.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE BangPatterns #-} module Env ( makeEnv @@ -71,6 +72,7 @@ makeEnv = do let dictsMeta = parMap (rparWith rdeepseq) (\(f,t) -> toDictionaryMeta ls f $ makeDictionary $ TL.toStrict t) filesAndTexts + sylList <- fromEither $ splitSyllables syls pure $ runEval $ do wtMap <- rparWith rdeepseq $ HM.fromList sylList From d973484ca73936de53b550091ba8f6f524d3928b Mon Sep 17 00:00:00 2001 From: Vladislav Sabanov Date: Sat, 19 Aug 2023 21:14:15 -0300 Subject: [PATCH 06/15] Remove log --- src/Cli.hs | 4 ++-- src/Translator.hs | 9 ++++----- 2 files changed, 6 insertions(+), 7 deletions(-) diff --git a/src/Cli.hs b/src/Cli.hs index a7bc664..1a966fc 100644 --- a/src/Cli.hs +++ b/src/Cli.hs @@ -33,7 +33,7 @@ import Prelude hiding (lookup) import Effectful ( type (:>), Eff, IOE ) import Effectful.Resource ( Resource ) -import Effectful.Log ( Log ) +-- import Effectful.Log ( Log ) import Effectful.Reader.Dynamic (Reader) import Effectful.Concurrent.MVar.Strict (MVar, Concurrent) @@ -59,7 +59,7 @@ runCommand :: ( IOE :> es , Reader (MVar Env) :> es , Concurrent :> es - , Log :> es + -- , Log :> es , Resource :> es , PrettyPrint :> es , Console :> es diff --git a/src/Translator.hs b/src/Translator.hs index ed27b23..c8d0e70 100644 --- a/src/Translator.hs +++ b/src/Translator.hs @@ -31,7 +31,7 @@ import qualified System.Console.Haskeline as Haskeline import Effectful ( type (:>), Eff, IOE ) import Effectful.Resource ( allocate, release, Resource ) -import Effectful.Log ( logInfo_, Log ) +-- import Effectful.Log ( logInfo_, Log ) import Effectful.Reader.Dynamic (Reader) import Effectful.Concurrent.MVar.Strict (MVar, Concurrent) @@ -40,7 +40,7 @@ import Effectful.Concurrent.MVar.Strict (MVar, Concurrent) translator :: ( IOE :> es , PrettyPrint :> es - , Log :> es + -- , Log :> es , Resource :> es , Console :> es , Reader (MVar Env) :> es @@ -59,7 +59,6 @@ translator = bracketOnError -- Looped dialog with user loopDialog :: ( PrettyPrint :> es - , Log :> es , Console :> es , Reader (MVar Env) :> es , Concurrent :> es @@ -79,8 +78,8 @@ loopDialog inputState = forever $ do Just input -> do env <- readEnv case getAnswer input env of - Left err -> do - logInfo_ $ showT err + Left _ -> do + -- logInfo_ $ showT err putColorDoc red NewLine "Nothing found" Right (query, answer) -> if null answer then putColorDoc red NewLine "Nothing found" From f2a4e416bd78ab16d869e48e8e3329c5b14e3775 Mon Sep 17 00:00:00 2001 From: Vladislav <> Date: Sat, 9 Dec 2023 17:58:11 -0300 Subject: [PATCH 07/15] Use strict foldlWithKey' --- src/Dictionary.hs | 6 +++--- src/Env.hs | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Dictionary.hs b/src/Dictionary.hs index 06dc5f4..a21d505 100644 --- a/src/Dictionary.hs +++ b/src/Dictionary.hs @@ -88,9 +88,9 @@ searchTranslation :: Text -> DictionaryMeta -> Maybe Answer searchTranslation query dm = if null ts then Nothing else Just $ Answer ts dm.number dm.title where - ts = HMS.foldrWithKey search [] dm.dictionary - search :: Text -> [Target] -> [Target] -> [Target] - search q v acc = if q == query then v <> acc else acc + ts = HMS.foldlWithKey' search [] dm.dictionary + search :: [Target] -> Text -> [Target] -> [Target] + search acc q v = if q == query then v <> acc else acc sortOutput :: [Answer] -> [Answer] sortOutput = sortBy (\a1 a2-> compare a1.dictNumber a2.dictNumber) diff --git a/src/Env.hs b/src/Env.hs index b0b0cb4..1e497be 100644 --- a/src/Env.hs +++ b/src/Env.hs @@ -100,7 +100,7 @@ getFilesTexts fp = do txts <- sequenceA contents if length paths == length txts then pure $ zip paths txts - else throwError $ UnknownError "Not all dictionary files was read successfully" + else throwError $ UnknownError "Some dictionary files fails to be read" fromEither :: (Error HibetError :> es) => Either HibetError a From daf5d73bc6d100adaea0cb75678f4e87be7f16e6 Mon Sep 17 00:00:00 2001 From: Vladislav <> Date: Thu, 14 Dec 2023 16:44:58 -0300 Subject: [PATCH 08/15] Update extra deps --- stack.yaml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/stack.yaml b/stack.yaml index 389c5e5..b34da93 100644 --- a/stack.yaml +++ b/stack.yaml @@ -9,8 +9,8 @@ extra-deps: - tomland-1.3.3.2 - validation-selective-0.1.0.2 - log-effectful-1.0.0.0 -- log-base-0.12.0.0 -- resourcet-effectful-1.0.0.0 +- log-base-0.12.0.1 +- resourcet-effectful-1.0.1.0 ghc-options: "$locals": -fhide-source-paths From 13b055836b1c173bf2143c054da7dd2d2ebac42a Mon Sep 17 00:00:00 2001 From: Vladislav Sabanov Date: Mon, 21 Oct 2024 16:13:32 -0300 Subject: [PATCH 09/15] Land on ghc-8.4.8. Fix tests --- hibet.cabal | 3 +- src/Effects/Common.hs | 4 +- src/Type.hs | 5 +- stack.yaml | 6 +- test/env/Main.hs | 375 ++++++++++++++++++++---------------------- test/labels/Main.hs | 1 - test/parse/Main.hs | 4 - test/pretty/Main.hs | 8 - 8 files changed, 187 insertions(+), 219 deletions(-) diff --git a/hibet.cabal b/hibet.cabal index 74ff4dc..e78a469 100644 --- a/hibet.cabal +++ b/hibet.cabal @@ -25,6 +25,7 @@ tested-with: , GHC==8.10.7 , GHC==9.0.2 , GHC==9.2.8 + , GHC==9.4.8 source-repository head type: git @@ -222,7 +223,7 @@ test-suite hibet-env , containers , text , unordered-containers - -- , directory + , effectful-core other-modules: Paths_hibet Paths diff --git a/src/Effects/Common.hs b/src/Effects/Common.hs index 39f4ab5..8091dc0 100644 --- a/src/Effects/Common.hs +++ b/src/Effects/Common.hs @@ -4,7 +4,7 @@ import Type (HibetError(..)) import Utility ( showT ) import Effectful ( MonadIO(liftIO), type (:>), Eff, IOE ) -import Effectful.Error.Static ( Error, catchError, throwError ) +import Effectful.Error.Static ( Error, catchError, throwError, prettyCallStack ) adapt :: ( IOE :> es @@ -12,4 +12,4 @@ adapt :: ) => IO a -> Eff es a adapt m = catchError (liftIO m) $ - \stack err -> throwError $ EffectError (showT err) stack + \stack err -> throwError $ EffectError (showT err) (showT $ prettyCallStack stack) diff --git a/src/Type.hs b/src/Type.hs index 017beeb..d28f4c0 100644 --- a/src/Type.hs +++ b/src/Type.hs @@ -7,13 +7,12 @@ module Type import Data.Text (Text) import Data.Void (Void) import Text.Megaparsec.Error (ParseErrorBundle) -import GHC.Stack ( CallStack ) data HibetError - = EffectError Text CallStack + = EffectError Text Text | MegaError (ParseErrorBundle Text Void) | NotFound | NotSyllable Text | UnknownError Text - deriving stock Show + deriving stock (Eq, Show) diff --git a/stack.yaml b/stack.yaml index b34da93..f790f14 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-20.26 +resolver: lts-21.25 packages: - . @@ -7,15 +7,15 @@ extra-deps: - radixtree-0.6.0.0 - tomland-1.3.3.2 -- validation-selective-0.1.0.2 +- validation-selective-0.2.0.0 - log-effectful-1.0.0.0 -- log-base-0.12.0.1 - resourcet-effectful-1.0.1.0 ghc-options: "$locals": -fhide-source-paths system-ghc: true +notify-if-nix-on-path: false # build: # library-profiling: true diff --git a/test/env/Main.hs b/test/env/Main.hs index ff1b274..7467d12 100644 --- a/test/env/Main.hs +++ b/test/env/Main.hs @@ -1,14 +1,18 @@ module Main where import Dictionary -import Effects.File (FileIO (..)) +import Effectful (Eff, IOE, runEff) +import Effectful.Error.Static + ( Error + , runErrorNoCallStack + ) +import Effects.File (FileSystem (..)) import qualified Effects.File as EF -import Env (makeEnv) +import Env (Env (..), makeEnv) import Label (LabelFull (..), Labels (..), Title (..)) -import Parse (ScriptType (..), Script(Script), WylieTibetMap, splitSyllables) -import Paths (dictDir, dictPath1, dictPath2, sylPath, titlePath) +import Parse (Script (Script), ScriptType (..), WylieTibetMap, splitSyllables) +import Paths (dictPath1, dictPath2, sylPath, titlePath) import Type (HibetError (..)) -import Utility (mkAbsolute, pack) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL @@ -17,224 +21,201 @@ import qualified Data.HashMap.Strict as HM import Data.List (sort) import Data.Maybe (mapMaybe) import qualified Data.Set as Set --- import qualified Data.Text as T import qualified Data.Text.Encoding as TE --- import Path.IO (listDir) -import Polysemy (Embed, Members, Sem) -import qualified Polysemy as P -import Polysemy.Error (Error, runError, throw) -import Polysemy.Trace (Trace, runTraceList) import Test.Hspec (Spec, describe, expectationFailure, hspec, it, shouldBe) --- import System.Directory --- import System.IO --- import qualified Debug.Trace as Trace - main :: IO () main = hspec $ do - mockMakeEnvSpec - syllables - translate + mockMakeEnvSpec + syllables + translate -mockMakeEnvSpec ::Spec +mockMakeEnvSpec :: Spec mockMakeEnvSpec = - describe "FileIO: " $ do - it "GetPath syllables" $ do - res <- snd <$> runFileMock (EF.getPath "stuff/tibetan-syllables") - res `shouldBe` Right sylPath - it "GetPath titles" $ do - res <- snd <$> runFileMock (EF.getPath "stuff/titles.toml") - res `shouldBe` Right titlePath - it "GetPath dicts" $ do - res <- snd <$> runFileMock (EF.getPath "dicts/") - res `shouldBe` Right dictDir - - it "Read file syllables" $ do - res <- snd <$> runFileMock (EF.readFile sylPath) - res `shouldBe` Right syllablesRaw - it "Read file titles" $ do - res <- snd <$> runFileMock (EF.readFile titlePath) - res `shouldBe` Right toml - it "Read file lazy dict 1" $ do - res <- snd <$> runFileMock (EF.readFileLazy dictPath1) - res `shouldBe` Right dict1 - it "Read file lazy dict 2" $ do - res <- snd <$> runFileMock (EF.readFileLazy dictPath2) - res `shouldBe` Right dict2 - - it "Make env. Meta" $ do - res <- snd <$> runFileMock makeEnv - case res of - Left err -> expectationFailure $ show err - Right env -> env.dictionaryMeta `shouldBe` [meta1,meta2] - it "Make env. Labels" $ do - res <- snd <$> runFileMock makeEnv - case res of - Left err -> expectationFailure $ show err - Right env -> env.labels `shouldBe` labels - it "Make env. WylieTibetMap" $ do - res <- snd <$> runFileMock makeEnv - case res of - Left err -> expectationFailure $ show err - Right env -> env.wylieTibetMap `shouldBe` wylieTibetHM + describe "FileIO: " $ do + it "Read file syllables" $ do + res <- runFileMock (EF.readFileBS sylPath) + res `shouldBe` Right syllablesRaw + it "Read file titles" $ do + res <- runFileMock (EF.readFileBS titlePath) + res `shouldBe` Right toml + it "Read file lazy dict 1" $ do + res <- runFileMock (EF.readFileLazyBS dictPath1) + res `shouldBe` Right dict1 + it "Read file lazy dict 2" $ do + res <- runFileMock (EF.readFileLazyBS dictPath2) + res `shouldBe` Right dict2 syllables :: Spec syllables = - describe "Syllables" $ do - it "Split syllables" $ do - case splitSyllables $ TE.decodeUtf8 syllablesRaw of - Left err -> expectationFailure $ show err - Right res -> sort res `shouldBe` sort wylieTibetSyl - it "Map and list of syllables" $ do - res <- snd <$> runFileMock makeEnv - case res of - Left err -> expectationFailure $ show err - Right env -> sort (HM.toList env.wylieTibetMap) `shouldBe` sort wylieTibetSyl + describe "Syllables" $ do + it "Split syllables" $ do + case splitSyllables $ TE.decodeUtf8 syllablesRaw of + Left err -> expectationFailure $ show err + Right res -> sort res `shouldBe` sort wylieTibetSyl translate :: Spec translate = - describe "Translate Wylie request" $ do - it "Search me" $ do - res <- snd <$> runFileMock makeEnv - case res of - Left err -> expectationFailure $ show err - Right env -> do - let query = "me" - let reply = mapMaybe (searchTranslation query) env.dictionaryMeta - reply `shouldBe` [Answer {targets = [Target "fire, flame, ember, Anaka, [the 50th year, Male Fire Dragon]"], dictNumber = 7, dictTitle = Title "Rangjung Yeshe"}] - it "Search re" $ do - res <- snd <$> runFileMock makeEnv - case res of - Left err -> expectationFailure $ show err - Right env -> do - let reply = mapMaybe (searchTranslation "re") env.dictionaryMeta - -- print rep.ly - reply `shouldBe` [Answer {targets = [Target "each; every; single; hope"], dictNumber = 5, dictTitle = Title "Hopkins"}, Answer {targets = [Target "noun + re + noun - Das: Under \"re\", 4) Occurs as a particle mostly put between two closely connected words for the purpose of giving the compound word a verbal signification; thus {snying rje} signifying compassion, can be split in two with the particle {re} between them and then it means: to take pity upon {snying re rje}; in the same manner {'o brgyal} fatigue becomes {'o re brgyal} = was fatigued. In like manner, we have {nyams re dga'}; {blo re bde}, [to be delighted]; {skyug re log}; {zhe re 'jigs}; {yi re mug}; {don re chung}. MSS: To this list we can add: {zhe re skyid}; {dang re spro}; {sems re skyo}, I'm feeling sad, how sad. [mss]"], dictNumber = 7, dictTitle = Title "Rangjung Yeshe"}] - it "Search re ba" $ do - res <- snd <$> runFileMock makeEnv - case res of - Left err -> expectationFailure $ show err - Right env -> do - let reply = mapMaybe (searchTranslation "re ba") env.dictionaryMeta - -- print rep.ly - reply `shouldBe` [Answer {targets = [Target "hope"], dictNumber = 5, dictTitle = Title "Hopkins"},Answer {targets = [Target "1) {re ba, re ba, re ba} intr. v. . to hope, aims; hopes, expectation. 2) woven cloth/ goat hair"], dictNumber = 7, dictTitle = Title "Rangjung Yeshe"}] - it "Search re ba byed pa" $ do - res <- snd <$> runFileMock makeEnv - case res of - Left err -> expectationFailure $ show err - Right env -> do - let reply = mapMaybe (searchTranslation "re ba byed pa") env.dictionaryMeta - -- print rep.ly - reply `shouldBe` [Answer {targets = [Target "to hope, wish, expect, demand, ask"], dictNumber = 7, dictTitle = Title "Rangjung Yeshe"}] - it "Search re ba med pa" $ do - res <- snd <$> runFileMock makeEnv - case res of - Left err -> expectationFailure $ show err - Right env -> do - let reply = mapMaybe (searchTranslation "re ba med pa") env.dictionaryMeta - -- print rep.ly - reply `shouldBe` [Answer {targets = [Target "hopeless; no hope"], dictNumber = 5, dictTitle = Title "Hopkins"}] - --- convert :: Spec --- convert = --- describe "Translate Wylie request" $ do --- it "Search me" $ do - -runFileMock :: Sem - '[ FileIO - , Error HibetError - , Trace - , Embed IO - ] a - -> IO ([String], Either HibetError a) -runFileMock program = program - & interpretFileMock - & runError @HibetError - & runTraceList - & P.runM - -interpretFileMock :: Members [Embed IO, Error HibetError] r => Sem (FileIO : r) a -> Sem r a -interpretFileMock = P.interpret $ \case - ReadFile path -> P.embed $ BS.readFile path - ReadFileLazy path -> P.embed $ BSL.readFile path - - GetPath path -> case path of - "stuff/tibetan-syllables" -> pure sylPath - "stuff/titles.toml" -> pure titlePath - "dicts/" -> pure dictDir - p -> throw $ UnknownError $ "Unknown get path: " <> pack p - - ListDirectory _ -> do - f1' <- EF.parseAbsFileS $ mkAbsolute dictPath1 - f2' <- EF.parseAbsFileS $ mkAbsolute dictPath2 - pure ([], [f1', f2']) - - ParseAbsDir _ -> EF.parseAbsDirS $ mkAbsolute dictDir - + describe "Translate Wylie request" $ do + it "Search mir" $ do + res <- runFileMock makeEnv + case res of + Left err -> expectationFailure $ show err + Right env -> do + let query = "mir" + let reply = mapMaybe (searchTranslation query) env.dictionaryMeta + reply + `shouldBe` [ Answer + { targets = [Target "as/for/ to a human being"] + , dictNumber = 16 + , dictTitle = Title "Ives Waldo" + } + , Answer + { targets = [Target "termin. case of mi"] + , dictNumber = 15 + , dictTitle = Title "James Valby" + } + , Answer + { targets = + [ Target + "mi ru zhes pa'i ru yig bsdus pa ste/ srin po mir brdzus zhes pa lta bu/ (mir chags) ma'i mngal gyi byis pa/" + ] + , dictNumber = 37 + , dictTitle = Title "dag-yig gsar-bsgrigs" + } + ] + it "Search ri ma" $ do + res <- runFileMock makeEnv + case res of + Left err -> expectationFailure $ show err + Right env -> do + let reply = mapMaybe (searchTranslation "ri ma") env.dictionaryMeta + reply + `shouldBe` [ Answer + { targets = [Target "arid/ non-irrigated land"] + , dictNumber = 16 + , dictTitle = Title "Ives Waldo" + } + ] + it "Search re ba byed pa" $ do + res <- runFileMock makeEnv + case res of + Left err -> expectationFailure $ show err + Right env -> do + let reply = mapMaybe (searchTranslation "re ba byed pa") env.dictionaryMeta + reply + `shouldBe` [ Answer + { targets = [Target "demand, ask, hope, wish, expect"] + , dictNumber = 15 + , dictTitle = Title "James Valby" + } + , Answer + { targets = [Target "to hope, wish, expect, demand, ask"] + , dictNumber = 7 + , dictTitle = Title "Rangjung Yeshe" + } + ] + it "Search re ba med pa" $ do + res <- runFileMock makeEnv + case res of + Left err -> expectationFailure $ show err + Right env -> do + let reply = mapMaybe (searchTranslation "re ba med pa") env.dictionaryMeta + reply + `shouldBe` [ Answer + { targets = [Target "hopeless; no hope"] + , dictNumber = 5 + , dictTitle = Title "Hopkins" + } + , Answer + { targets = [Target "{MSA}nirapekṣa; {MSA}niṣpratikāṅkṣa"] + , dictNumber = 41 + , dictTitle = Title "Hopkins Sanskrit" + } + , Answer + { targets = [Target "hopeless, no hope of --"] + , dictNumber = 16 + , dictTitle = Title "Ives Waldo" + } + , Answer + { targets = [Target "hopeless, despairing"] + , dictNumber = 15 + , dictTitle = Title "James Valby" + } + ] + +runFileMock :: + Eff + '[ FileSystem + , Error HibetError + , -- , Log + IOE + ] + a + -> IO (Either HibetError a) +runFileMock program = + program + & EF.runFileSystemIO + & runErrorNoCallStack @HibetError + -- & runLog "hibet" logger defaultLogLevel + & runEff -- Data for mocking - syllablesRaw :: BS.ByteString -syllablesRaw = "bla|\224\189\150\224\190\179\nbla'am|\224\189\150\224\190\179\224\189\160\224\189\152\nblab|\224\189\150\224\190\179\224\189\150\nblabs|\224\189\150\224\190\179\224\189\150\224\189\166\nblad|\224\189\150\224\190\179\224\189\145\nblag|\224\189\150\224\190\179\224\189\130\nblags|\224\189\150\224\190\179\224\189\130\224\189\166\nbla'i|\224\189\150\224\190\179\224\189\160\224\189\178\nman|\224\189\152\224\189\147\nmaN|\224\189\152\224\189\142\nmAn|\224\189\152\224\189\177\224\189\147\nmAN|\224\189\152\224\189\177\224\189\142\nmana|\224\189\152\224\189\147\nmAna|\224\189\152\224\189\177\224\189\147\nmANa|\224\189\152\224\189\177\224\189\142\nre|\224\189\162\224\189\186\nme|\224\189\152\224\189\186\n" +syllablesRaw = + "bla|\224\189\150\224\190\179\nbla'am|\224\189\150\224\190\179\224\189\160\224\189\152\nblab|\224\189\150\224\190\179\224\189\150\nblabs|\224\189\150\224\190\179\224\189\150\224\189\166\nblad|\224\189\150\224\190\179\224\189\145\nblag|\224\189\150\224\190\179\224\189\130\nblags|\224\189\150\224\190\179\224\189\130\224\189\166\nbla'i|\224\189\150\224\190\179\224\189\160\224\189\178\nman|\224\189\152\224\189\147\nmaN|\224\189\152\224\189\142\nmAn|\224\189\152\224\189\177\224\189\147\nmAN|\224\189\152\224\189\177\224\189\142\nmana|\224\189\152\224\189\147\nmAna|\224\189\152\224\189\177\224\189\147\nmANa|\224\189\152\224\189\177\224\189\142\nre|\224\189\162\224\189\186\nme|\224\189\152\224\189\186\n" toml :: BS.ByteString -toml = "[[titles]]\n path = \"Hopkins-2015-T|E\"\n id = 5\n label = \"Hopkins\"\n about = \"The Uma Institute for Tibetan Studies Tibetan-Sanskrit-English Dictionary (Version: June 2015)|Jeffrey Hopkins, Editor.|Paul Hackett, Contributor and Technical Editor.| Contributors: Nathaniel Garson, William Magee, Andres Montano, John Powers, Craig Preston, Joe Wilson, Jongbok Yi|A PDF version of this dictionary is available for download at: www.uma-tibet.org\"\n abbreviations = \"Hopkins\"\n public = true\n listCredits = true\n available = true\n source = \"Tibetan\"\n target = [\"English\"]\n year = 2015\n\n[[titles]]\n path = \"RangjungYeshe-T|E\"\n id = 7\n label = \"Rangjung Yeshe\"\n about = \"Rangjung Yeshe Dictionary|Rangjung Yeshe Tibetan-English Dharma Dictionary 3.0 by Erik Pema Kunsang (2003)|online version: http://rywiki.tsadra.org\"\n abbreviations = \"RangjungYeshe\"\n public = true\n listCredits = true\n available = true\n source = \"Tibetan\"\n target = [\"English\"]\n" +toml = + "[[titles]]\n path = \"Hopkins-2015-T|E\"\n id = 5\n label = \"Hopkins\"\n about = \"The Uma Institute for Tibetan Studies Tibetan-Sanskrit-English Dictionary (Version: June 2015)|Jeffrey Hopkins, Editor.|Paul Hackett, Contributor and Technical Editor.| Contributors: Nathaniel Garson, William Magee, Andres Montano, John Powers, Craig Preston, Joe Wilson, Jongbok Yi|A PDF version of this dictionary is available for download at: www.uma-tibet.org\"\n abbreviations = \"Hopkins\"\n public = true\n listCredits = true\n available = true\n source = \"Tibetan\"\n target = [\"English\"]\n year = 2015\n\n[[titles]]\n path = \"RangjungYeshe-T|E\"\n id = 7\n label = \"Rangjung Yeshe\"\n about = \"Rangjung Yeshe Dictionary|Rangjung Yeshe Tibetan-English Dharma Dictionary 3.0 by Erik Pema Kunsang (2003)|online version: http://rywiki.tsadra.org\"\n abbreviations = \"RangjungYeshe\"\n public = true\n listCredits = true\n available = true\n source = \"Tibetan\"\n target = [\"English\"]\n" dict1 :: BSL.ByteString dict1 = "re|each; every; single; hope\nre ba|hope\nre ba med pa|hopeless; no hope\n" dict2 :: BSL.ByteString -dict2 = "re ba|1) {re ba, re ba, re ba} intr. v. . to hope, aims; hopes, expectation. 2) woven cloth/ goat hair\nre ba byed pa|to hope, wish, expect, demand, ask\nre ba chad|give up hope\nme|fire, flame, ember, Anaka, [the 50th year, Male Fire Dragon]\nre|noun + re + noun - Das: Under \"re\", 4) Occurs as a particle mostly put between two closely connected words for the purpose of giving the compound word a verbal signification; thus {snying rje} signifying compassion, can be split in two with the particle {re} between them and then it means: to take pity upon {snying re rje}; in the same manner {'o brgyal} fatigue becomes {'o re brgyal} = was fatigued. In like manner, we have {nyams re dga'}; {blo re bde}, [to be delighted]; {skyug re log}; {zhe re 'jigs}; {yi re mug}; {don re chung}. MSS: To this list we can add: {zhe re skyid}; {dang re spro}; {sems re skyo}, I'm feeling sad, how sad. [mss]\n" - -meta1 :: DictionaryMeta -meta1 = DictionaryMeta {dictionary = HM.fromList [("re ba",[Target "hope"]),("re ba med pa",[Target "hopeless; no hope"]),("re",[Target "each; every; single; hope"])], title = Title "Hopkins", number = 5} - -meta2 :: DictionaryMeta -meta2 = DictionaryMeta {dictionary = HM.fromList [("re ba",[Target "1) {re ba, re ba, re ba} intr. v. . to hope, aims; hopes, expectation. 2) woven cloth/ goat hair"]),("re",[Target "noun + re + noun - Das: Under \"re\", 4) Occurs as a particle mostly put between two closely connected words for the purpose of giving the compound word a verbal signification; thus {snying rje} signifying compassion, can be split in two with the particle {re} between them and then it means: to take pity upon {snying re rje}; in the same manner {'o brgyal} fatigue becomes {'o re brgyal} = was fatigued. In like manner, we have {nyams re dga'}; {blo re bde}, [to be delighted]; {skyug re log}; {zhe re 'jigs}; {yi re mug}; {don re chung}. MSS: To this list we can add: {zhe re skyid}; {dang re spro}; {sems re skyo}, I'm feeling sad, how sad. [mss]"]),("re ba byed pa",[Target "to hope, wish, expect, demand, ask"]),("me",[Target "fire, flame, ember, Anaka, [the 50th year, Male Fire Dragon]"]),("re ba chad",[Target "give up hope"])], title = Title "Rangjung Yeshe", number = 7} - -labels :: Labels -labels = Labels - {labelTitles = [LabelFull {path = "Hopkins-2015-T|E", lfId = 5, label = Title "Hopkins", about = "The Uma Institute for Tibetan Studies Tibetan-Sanskrit-English Dictionary (Version: June 2015)|Jeffrey Hopkins, Editor.|Paul Hackett, Contributor and Technical Editor.| Contributors: Nathaniel Garson, William Magee, Andres Montano, John Powers, Craig Preston, Joe Wilson, Jongbok Yi|A PDF version of this dictionary is available for download at: www.uma-tibet.org", available = True, source = "Tibetan", target = Set.fromList ["English"], year = Just 2015},LabelFull {path = "RangjungYeshe-T|E", lfId = 7, label = Title "Rangjung Yeshe", about = "Rangjung Yeshe Dictionary|Rangjung Yeshe Tibetan-English Dharma Dictionary 3.0 by Erik Pema Kunsang (2003)|online version: http://rywiki.tsadra.org", available = True, source = "Tibetan", target = Set.fromList ["English"], year = Nothing}]} +dict2 = + "re ba|1) {re ba, re ba, re ba} intr. v. . to hope, aims; hopes, expectation. 2) woven cloth/ goat hair\nre ba byed pa|to hope, wish, expect, demand, ask\nre ba chad|give up hope\nme|fire, flame, ember, Anaka, [the 50th year, Male Fire Dragon]\nre|noun + re + noun - Das: Under \"re\", 4) Occurs as a particle mostly put between two closely connected words for the purpose of giving the compound word a verbal signification; thus {snying rje} signifying compassion, can be split in two with the particle {re} between them and then it means: to take pity upon {snying re rje}; in the same manner {'o brgyal} fatigue becomes {'o re brgyal} = was fatigued. In like manner, we have {nyams re dga'}; {blo re bde}, [to be delighted]; {skyug re log}; {zhe re 'jigs}; {yi re mug}; {don re chung}. MSS: To this list we can add: {zhe re skyid}; {dang re spro}; {sems re skyo}, I'm feeling sad, how sad. [mss]\n" wylieTibetHM :: WylieTibetMap -wylieTibetHM = HM.fromList - [ (Script "bla",Script "\3926\4019") - , (Script "re",Script "\3938\3962") - , (Script "mAn",Script "\3928\3953\3923") - , (Script "maN",Script "\3928\3918") - , (Script "mAN",Script "\3928\3953\3918") - , (Script "man",Script "\3928\3923") - , (Script "me",Script "\3928\3962") - , (Script "blad",Script "\3926\4019\3921") - , (Script "blabs",Script "\3926\4019\3926\3942") - , (Script "blab",Script "\3926\4019\3926") - , (Script "bla'i",Script "\3926\4019\3936\3954") - , (Script "bla'am",Script "\3926\4019\3936\3928") - , (Script "mana",Script "\3928\3923") - , (Script "mAna",Script "\3928\3953\3923") - , (Script "mANa",Script "\3928\3953\3918") - , (Script "blags",Script "\3926\4019\3906\3942") - , (Script "blag",Script "\3926\4019\3906") - ] +wylieTibetHM = + HM.fromList + [ (Script "bla", Script "\3926\4019") + , (Script "re", Script "\3938\3962") + , (Script "mAn", Script "\3928\3953\3923") + , (Script "maN", Script "\3928\3918") + , (Script "mAN", Script "\3928\3953\3918") + , (Script "man", Script "\3928\3923") + , (Script "me", Script "\3928\3962") + , (Script "blad", Script "\3926\4019\3921") + , (Script "blabs", Script "\3926\4019\3926\3942") + , (Script "blab", Script "\3926\4019\3926") + , (Script "bla'i", Script "\3926\4019\3936\3954") + , (Script "bla'am", Script "\3926\4019\3936\3928") + , (Script "mana", Script "\3928\3923") + , (Script "mAna", Script "\3928\3953\3923") + , (Script "mANa", Script "\3928\3953\3918") + , (Script "blags", Script "\3926\4019\3906\3942") + , (Script "blag", Script "\3926\4019\3906") + ] wylieTibetSyl :: [(Script 'Wylie, Script 'Tibet)] wylieTibetSyl = - [ (Script "bla",Script "\3926\4019") - , (Script "re",Script "\3938\3962") - , (Script "mAn",Script "\3928\3953\3923") - , (Script "maN",Script "\3928\3918") - , (Script "mAN",Script "\3928\3953\3918") - , (Script "man",Script "\3928\3923") - , (Script "me",Script "\3928\3962") - , (Script "blad",Script "\3926\4019\3921") - , (Script "blabs",Script "\3926\4019\3926\3942") - , (Script "blab",Script "\3926\4019\3926") - , (Script "bla'i",Script "\3926\4019\3936\3954") - , (Script "bla'am",Script "\3926\4019\3936\3928") - , (Script "mana",Script "\3928\3923") - , (Script "mAna",Script "\3928\3953\3923") - , (Script "mANa",Script "\3928\3953\3918") - , (Script "blags",Script "\3926\4019\3906\3942") - , (Script "blag",Script "\3926\4019\3906") - ] + [ (Script "bla", Script "\3926\4019") + , (Script "re", Script "\3938\3962") + , (Script "mAn", Script "\3928\3953\3923") + , (Script "maN", Script "\3928\3918") + , (Script "mAN", Script "\3928\3953\3918") + , (Script "man", Script "\3928\3923") + , (Script "me", Script "\3928\3962") + , (Script "blad", Script "\3926\4019\3921") + , (Script "blabs", Script "\3926\4019\3926\3942") + , (Script "blab", Script "\3926\4019\3926") + , (Script "bla'i", Script "\3926\4019\3936\3954") + , (Script "bla'am", Script "\3926\4019\3936\3928") + , (Script "mana", Script "\3928\3923") + , (Script "mAna", Script "\3928\3953\3923") + , (Script "mANa", Script "\3928\3953\3918") + , (Script "blags", Script "\3926\4019\3906\3942") + , (Script "blag", Script "\3926\4019\3906") + ] diff --git a/test/labels/Main.hs b/test/labels/Main.hs index 4f24160..37c9eb0 100644 --- a/test/labels/Main.hs +++ b/test/labels/Main.hs @@ -7,7 +7,6 @@ import qualified Data.Set as Set import Test.Hspec (Spec, describe, hspec, it, shouldBe) - main :: IO () main = hspec $ do getLabelsSpec diff --git a/test/parse/Main.hs b/test/parse/Main.hs index e9c8785..4221b5c 100644 --- a/test/parse/Main.hs +++ b/test/parse/Main.hs @@ -6,10 +6,6 @@ import Parse.Type ( parseEither ) import Test.Hspec (Spec, describe, hspec, it, shouldBe) import Data.Either ( isLeft ) --- import Text.Megaparsec (parseTest) --- import qualified Text.Megaparsec.Char as MC - - main :: IO () main = hspec $ do tibetan diff --git a/test/pretty/Main.hs b/test/pretty/Main.hs index a499b7e..3b47b1d 100644 --- a/test/pretty/Main.hs +++ b/test/pretty/Main.hs @@ -9,14 +9,6 @@ import Prettyprinter.Render.Text (renderStrict) import Test.Hspec (Spec, describe, hspec, it, shouldBe) --- import Hedgehog (Gen, PropertyT, forAll, (===)) --- import Hedgehog.Gen (alphaNum, choice, element, frequency, sample, text) --- import qualified Hedgehog.Gen as G --- import Hedgehog.Range (constant) --- import Test.Hspec.Hedgehog (hedgehog) - - - main :: IO () main = hspec $ do viewTranslationsSpec From ef5af98eabc6af794a3c0b2c772f8dd518a0b204 Mon Sep 17 00:00:00 2001 From: Vladislav Sabanov Date: Mon, 21 Oct 2024 16:16:59 -0300 Subject: [PATCH 10/15] Update haskell-ci --- .github/workflows/haskell-ci.yml | 36 ++++++++++++-------------------- hibet.cabal | 5 +---- 2 files changed, 14 insertions(+), 27 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 4c042dc..452608d 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -1,6 +1,6 @@ # This GitHub workflow config has been generated by a script via # -# haskell-ci 'github' 'cabal.project' +# haskell-ci 'github' 'hibet.cabal' # # To regenerate the script (for example after adjusting tested-with) run # @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.17.20230811 +# version: 0.19.20240708 # -# REGENDATA ("0.17.20230811",["github","cabal.project"]) +# REGENDATA ("0.19.20240708",["github","hibet.cabal"]) # name: Haskell-CI on: @@ -23,24 +23,14 @@ jobs: timeout-minutes: 60 container: - image: buildpack-deps:bionic + image: buildpack-deps:jammy continue-on-error: ${{ matrix.allow-failure }} strategy: matrix: include: - - compiler: ghc-9.2.8 + - compiler: ghc-9.4.8 compilerKind: ghc - compilerVersion: 9.2.8 - setup-method: ghcup - allow-failure: false - - compiler: ghc-9.0.2 - compilerKind: ghc - compilerVersion: 9.0.2 - setup-method: ghcup - allow-failure: false - - compiler: ghc-8.10.7 - compilerKind: ghc - compilerVersion: 8.10.7 + compilerVersion: 9.4.8 setup-method: ghcup allow-failure: false fail-fast: false @@ -50,10 +40,10 @@ jobs: apt-get update apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.19.5/x86_64-linux-ghcup-0.1.19.5 > "$HOME/.ghcup/bin/ghcup" + curl -sL https://downloads.haskell.org/ghcup/0.1.30.0/x86_64-linux-ghcup-0.1.30.0 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) - "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) + "$HOME/.ghcup/bin/ghcup" install cabal 3.12.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) env: HCKIND: ${{ matrix.compilerKind }} HCNAME: ${{ matrix.compiler }} @@ -71,7 +61,7 @@ jobs: echo "HC=$HC" >> "$GITHUB_ENV" echo "HCPKG=$HCPKG" >> "$GITHUB_ENV" echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV" - echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" + echo "CABAL=$HOME/.ghcup/bin/cabal-3.12.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" @@ -128,7 +118,7 @@ jobs: chmod a+x $HOME/.cabal/bin/cabal-plan cabal-plan --version - name: checkout - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: path: source - name: initial cabal.project for sdist @@ -156,7 +146,7 @@ jobs: echo " ghc-options: -Werror=missing-methods" >> cabal.project cat >> cabal.project <> cabal.project.local + $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(hibet)$/; }' >> cabal.project.local cat cabal.project cat cabal.project.local - name: dump install plan @@ -164,7 +154,7 @@ jobs: $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all cabal-plan - name: restore cache - uses: actions/cache/restore@v3 + uses: actions/cache/restore@v4 with: key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} path: ~/.cabal/store @@ -194,7 +184,7 @@ jobs: rm -f cabal.project.local $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all - name: save cache - uses: actions/cache/save@v3 + uses: actions/cache/save@v4 if: always() with: key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} diff --git a/hibet.cabal b/hibet.cabal index e78a469..87f3739 100644 --- a/hibet.cabal +++ b/hibet.cabal @@ -22,10 +22,7 @@ extra-source-files: test/env/data/stuff/tibetan-syllables test/env/data/stuff/titles.toml tested-with: - , GHC==8.10.7 - , GHC==9.0.2 - , GHC==9.2.8 - , GHC==9.4.8 + GHC==9.4.8 source-repository head type: git From d03f67a657e4c37c3bd7ff4ebe75f6bad3bde3a9 Mon Sep 17 00:00:00 2001 From: Vladislav Sabanov Date: Mon, 21 Oct 2024 16:21:04 -0300 Subject: [PATCH 11/15] Update changelog and readme --- CHANGELOG.md | 7 ++++--- README.md | 2 +- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index d4f997a..2299d5b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,10 +7,11 @@ and this project adheres to [Haskell Package Versioning Policy](https://pvp.haskell.org/). -## [1.3.8] - 2023-08-13 +## [1.4.0] - 2024-10-21 + +* Bump stack version to lts-21.25 and GHC-9.4.8 +* Change effect system to `effectful` one -* Land on `effectful` effect system. Remove polysemy -* Bump stack version to lts-20.26 and GHC-9.2.8 ## [1.3.7] - 2023-04-06 diff --git a/README.md b/README.md index 405dfca..a54ebbc 100644 --- a/README.md +++ b/README.md @@ -117,4 +117,4 @@ or use arrows of keyboard. ## Contribution -Contribution is welcome! +Contributions are welcoming! From b702556bb2a5cd49240e7757a36918ffc892011e Mon Sep 17 00:00:00 2001 From: Vladislav Sabanov Date: Mon, 21 Oct 2024 17:46:06 -0300 Subject: [PATCH 12/15] Fix cabal build --- cabal-plan.log | 1289 +++++++++++++++++++++++++++++++++++++++++++++ hibet.cabal | 2 +- src/App.hs | 2 +- src/Cli.hs | 2 +- src/Env.hs | 2 +- src/Translator.hs | 2 +- 6 files changed, 1294 insertions(+), 5 deletions(-) create mode 100644 cabal-plan.log diff --git a/cabal-plan.log b/cabal-plan.log new file mode 100644 index 0000000..2bbfe16 --- /dev/null +++ b/cabal-plan.log @@ -0,0 +1,1289 @@ +using '/home/metaxis/source/haskell/hibet' as project root + +Tree +~~~~ + +aeson-pretty-0.8.10 + [aeson-pretty-0.8.10:exe:"aeson-pretty"] + ├─ aeson-2.2.3.0 + │ ├─ OneTuple-0.4.2 + │ │ ├─ base-4.17.2.1 + │ │ │ ├─ ghc-bignum-1.3 + │ │ │ │ └─ ghc-prim-0.9.1 + │ │ │ │ └─ rts-1.0.2 + │ │ │ ├─ ghc-prim-0.9.1 ┄┄ + │ │ │ └─ rts-1.0.2 ┄┄ + │ │ ├─ ghc-prim-0.9.1 ┄┄ + │ │ └─ template-haskell-2.19.0.0 + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ ghc-boot-th-9.4.8 + │ │ │ └─ base-4.17.2.1 ┄┄ + │ │ ├─ ghc-prim-0.9.1 ┄┄ + │ │ └─ pretty-1.1.3.6 + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ deepseq-1.4.8.0 + │ │ │ ├─ array-0.5.4.0 + │ │ │ │ └─ base-4.17.2.1 ┄┄ + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ └─ ghc-prim-0.9.1 ┄┄ + │ │ └─ ghc-prim-0.9.1 ┄┄ + │ ├─ QuickCheck-2.15.0.1 + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ containers-0.6.7 + │ │ │ ├─ array-0.5.4.0 ┄┄ + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ │ └─ template-haskell-2.19.0.0 ┄┄ + │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ ├─ random-1.2.1.2 + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ ├─ bytestring-0.11.5.3 + │ │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ │ │ ├─ ghc-prim-0.9.1 ┄┄ + │ │ │ │ └─ template-haskell-2.19.0.0 ┄┄ + │ │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ │ ├─ mtl-2.2.2 + │ │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ │ └─ transformers-0.5.6.2 + │ │ │ │ └─ base-4.17.2.1 ┄┄ + │ │ │ └─ splitmix-0.1.0.5 + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ └─ deepseq-1.4.8.0 ┄┄ + │ │ ├─ splitmix-0.1.0.5 ┄┄ + │ │ ├─ template-haskell-2.19.0.0 ┄┄ + │ │ └─ transformers-0.5.6.2 ┄┄ + │ ├─ base-4.17.2.1 ┄┄ + │ ├─ bytestring-0.11.5.3 ┄┄ + │ ├─ character-ps-0.1 + │ │ └─ base-4.17.2.1 ┄┄ + │ ├─ containers-0.6.7 ┄┄ + │ ├─ data-fix-0.3.4 + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ └─ hashable-1.4.7.0 + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ bytestring-0.11.5.3 ┄┄ + │ │ ├─ containers-0.6.7 ┄┄ + │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ ├─ filepath-1.4.2.2 + │ │ │ └─ base-4.17.2.1 ┄┄ + │ │ ├─ ghc-bignum-1.3 ┄┄ + │ │ ├─ ghc-prim-0.9.1 ┄┄ + │ │ ├─ os-string-2.0.6 + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ ├─ bytestring-0.11.5.3 ┄┄ + │ │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ │ ├─ exceptions-0.10.5 + │ │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ │ ├─ mtl-2.2.2 ┄┄ + │ │ │ │ ├─ stm-2.5.1.0 + │ │ │ │ │ ├─ array-0.5.4.0 ┄┄ + │ │ │ │ │ └─ base-4.17.2.1 ┄┄ + │ │ │ │ ├─ template-haskell-2.19.0.0 ┄┄ + │ │ │ │ └─ transformers-0.5.6.2 ┄┄ + │ │ │ └─ template-haskell-2.19.0.0 ┄┄ + │ │ └─ text-2.0.2 + │ │ ├─ array-0.5.4.0 ┄┄ + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ binary-0.8.9.1 + │ │ │ ├─ array-0.5.4.0 ┄┄ + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ ├─ bytestring-0.11.5.3 ┄┄ + │ │ │ └─ containers-0.6.7 ┄┄ + │ │ ├─ bytestring-0.11.5.3 ┄┄ + │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ ├─ ghc-prim-0.9.1 ┄┄ + │ │ └─ template-haskell-2.19.0.0 ┄┄ + │ ├─ deepseq-1.4.8.0 ┄┄ + │ ├─ dlist-1.0 + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ └─ deepseq-1.4.8.0 ┄┄ + │ ├─ exceptions-0.10.5 ┄┄ + │ ├─ generically-0.1.1 + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ └─ base-orphans-0.9.2 + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ └─ ghc-prim-0.9.1 ┄┄ + │ ├─ ghc-prim-0.9.1 ┄┄ + │ ├─ hashable-1.4.7.0 ┄┄ + │ ├─ indexed-traversable-0.1.4 + │ │ ├─ array-0.5.4.0 ┄┄ + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ containers-0.6.7 ┄┄ + │ │ ├─ foldable1-classes-compat-0.1 + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ ├─ containers-0.6.7 ┄┄ + │ │ │ ├─ ghc-prim-0.9.1 ┄┄ + │ │ │ ├─ tagged-0.8.8 + │ │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ │ │ ├─ template-haskell-2.19.0.0 ┄┄ + │ │ │ │ └─ transformers-0.5.6.2 ┄┄ + │ │ │ └─ transformers-0.5.6.2 ┄┄ + │ │ └─ transformers-0.5.6.2 ┄┄ + │ ├─ integer-conversion-0.1.1 + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ bytestring-0.11.5.3 ┄┄ + │ │ ├─ primitive-0.9.0.0 + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ │ ├─ template-haskell-2.19.0.0 ┄┄ + │ │ │ └─ transformers-0.5.6.2 ┄┄ + │ │ └─ text-2.0.2 ┄┄ + │ ├─ integer-logarithms-1.0.3.1 + │ │ ├─ array-0.5.4.0 ┄┄ + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ ghc-bignum-1.3 ┄┄ + │ │ └─ ghc-prim-0.9.1 ┄┄ + │ ├─ network-uri-2.6.4.2 + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ ├─ parsec-3.1.16.1 + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ ├─ bytestring-0.11.5.3 ┄┄ + │ │ │ ├─ mtl-2.2.2 ┄┄ + │ │ │ └─ text-2.0.2 ┄┄ + │ │ ├─ template-haskell-2.19.0.0 ┄┄ + │ │ └─ th-compat-0.1.5 + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ └─ template-haskell-2.19.0.0 ┄┄ + │ ├─ primitive-0.9.0.0 ┄┄ + │ ├─ scientific-0.3.8.0 + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ binary-0.8.9.1 ┄┄ + │ │ ├─ bytestring-0.11.5.3 ┄┄ + │ │ ├─ containers-0.6.7 ┄┄ + │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ ├─ hashable-1.4.7.0 ┄┄ + │ │ ├─ integer-logarithms-1.0.3.1 ┄┄ + │ │ ├─ primitive-0.9.0.0 ┄┄ + │ │ ├─ template-haskell-2.19.0.0 ┄┄ + │ │ └─ text-2.0.2 ┄┄ + │ ├─ semialign-1.3.1 + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ containers-0.6.7 ┄┄ + │ │ ├─ hashable-1.4.7.0 ┄┄ + │ │ ├─ indexed-traversable-0.1.4 ┄┄ + │ │ ├─ indexed-traversable-instances-0.1.2 + │ │ │ ├─ OneTuple-0.4.2 ┄┄ + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ ├─ indexed-traversable-0.1.4 ┄┄ + │ │ │ ├─ tagged-0.8.8 ┄┄ + │ │ │ ├─ unordered-containers-0.2.20 + │ │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ │ │ ├─ hashable-1.4.7.0 ┄┄ + │ │ │ │ └─ template-haskell-2.19.0.0 ┄┄ + │ │ │ └─ vector-0.13.1.0 + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ │ ├─ primitive-0.9.0.0 ┄┄ + │ │ │ └─ vector-stream-0.1.0.1 + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ └─ ghc-prim-0.9.1 ┄┄ + │ │ ├─ semigroupoids-6.0.1 + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ ├─ base-orphans-0.9.2 ┄┄ + │ │ │ ├─ bifunctors-5.6.2 + │ │ │ │ ├─ assoc-1.1.1 + │ │ │ │ │ └─ base-4.17.2.1 ┄┄ + │ │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ │ ├─ comonad-5.0.8 + │ │ │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ │ │ ├─ containers-0.6.7 ┄┄ + │ │ │ │ │ ├─ distributive-0.6.2.1 + │ │ │ │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ │ │ │ ├─ base-orphans-0.9.2 ┄┄ + │ │ │ │ │ │ ├─ tagged-0.8.8 ┄┄ + │ │ │ │ │ │ └─ transformers-0.5.6.2 ┄┄ + │ │ │ │ │ ├─ indexed-traversable-0.1.4 ┄┄ + │ │ │ │ │ ├─ tagged-0.8.8 ┄┄ + │ │ │ │ │ ├─ transformers-0.5.6.2 ┄┄ + │ │ │ │ │ └─ transformers-compat-0.7.2 + │ │ │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ │ │ ├─ ghc-prim-0.9.1 ┄┄ + │ │ │ │ │ └─ transformers-0.5.6.2 ┄┄ + │ │ │ │ ├─ containers-0.6.7 ┄┄ + │ │ │ │ ├─ foldable1-classes-compat-0.1 ┄┄ + │ │ │ │ ├─ tagged-0.8.8 ┄┄ + │ │ │ │ ├─ template-haskell-2.19.0.0 ┄┄ + │ │ │ │ ├─ th-abstraction-0.7.0.0 + │ │ │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ │ │ ├─ containers-0.6.7 ┄┄ + │ │ │ │ │ ├─ ghc-prim-0.9.1 ┄┄ + │ │ │ │ │ └─ template-haskell-2.19.0.0 ┄┄ + │ │ │ │ └─ transformers-0.5.6.2 ┄┄ + │ │ │ ├─ comonad-5.0.8 ┄┄ + │ │ │ ├─ containers-0.6.7 ┄┄ + │ │ │ ├─ contravariant-1.5.5 + │ │ │ │ ├─ StateVar-1.2.2 + │ │ │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ │ │ ├─ stm-2.5.1.0 ┄┄ + │ │ │ │ │ └─ transformers-0.5.6.2 ┄┄ + │ │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ │ └─ transformers-0.5.6.2 ┄┄ + │ │ │ ├─ distributive-0.6.2.1 ┄┄ + │ │ │ ├─ foldable1-classes-compat-0.1 ┄┄ + │ │ │ ├─ hashable-1.4.7.0 ┄┄ + │ │ │ ├─ tagged-0.8.8 ┄┄ + │ │ │ ├─ template-haskell-2.19.0.0 ┄┄ + │ │ │ ├─ transformers-0.5.6.2 ┄┄ + │ │ │ ├─ transformers-compat-0.7.2 ┄┄ + │ │ │ └─ unordered-containers-0.2.20 ┄┄ + │ │ ├─ tagged-0.8.8 ┄┄ + │ │ ├─ these-1.2.1 + │ │ │ ├─ assoc-1.1.1 ┄┄ + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ ├─ binary-0.8.9.1 ┄┄ + │ │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ │ ├─ foldable1-classes-compat-0.1 ┄┄ + │ │ │ └─ hashable-1.4.7.0 ┄┄ + │ │ ├─ transformers-0.5.6.2 ┄┄ + │ │ ├─ unordered-containers-0.2.20 ┄┄ + │ │ └─ vector-0.13.1.0 ┄┄ + │ ├─ strict-0.5.1 + │ │ ├─ assoc-1.1.1 ┄┄ + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ binary-0.8.9.1 ┄┄ + │ │ ├─ bytestring-0.11.5.3 ┄┄ + │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ ├─ ghc-prim-0.9.1 ┄┄ + │ │ ├─ hashable-1.4.7.0 ┄┄ + │ │ ├─ text-2.0.2 ┄┄ + │ │ ├─ these-1.2.1 ┄┄ + │ │ └─ transformers-0.5.6.2 ┄┄ + │ ├─ tagged-0.8.8 ┄┄ + │ ├─ template-haskell-2.19.0.0 ┄┄ + │ ├─ text-2.0.2 ┄┄ + │ ├─ text-iso8601-0.1.1 + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ integer-conversion-0.1.1 ┄┄ + │ │ ├─ text-2.0.2 ┄┄ + │ │ ├─ time-1.12.2 + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ └─ deepseq-1.4.8.0 ┄┄ + │ │ └─ time-compat-1.9.7 + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ base-orphans-0.9.2 ┄┄ + │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ ├─ hashable-1.4.7.0 ┄┄ + │ │ └─ time-1.12.2 ┄┄ + │ ├─ text-short-0.1.6 + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ binary-0.8.9.1 ┄┄ + │ │ ├─ bytestring-0.11.5.3 ┄┄ + │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ ├─ ghc-prim-0.9.1 ┄┄ + │ │ ├─ hashable-1.4.7.0 ┄┄ + │ │ ├─ template-haskell-2.19.0.0 ┄┄ + │ │ └─ text-2.0.2 ┄┄ + │ ├─ th-abstraction-0.7.0.0 ┄┄ + │ ├─ these-1.2.1 ┄┄ + │ ├─ time-1.12.2 ┄┄ + │ ├─ time-compat-1.9.7 ┄┄ + │ ├─ unordered-containers-0.2.20 ┄┄ + │ ├─ uuid-types-1.0.6 + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ binary-0.8.9.1 ┄┄ + │ │ ├─ bytestring-0.11.5.3 ┄┄ + │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ ├─ hashable-1.4.7.0 ┄┄ + │ │ ├─ random-1.2.1.2 ┄┄ + │ │ ├─ template-haskell-2.19.0.0 ┄┄ + │ │ └─ text-2.0.2 ┄┄ + │ ├─ vector-0.13.1.0 ┄┄ + │ └─ witherable-0.5 + │ ├─ base-4.17.2.1 ┄┄ + │ ├─ base-orphans-0.9.2 ┄┄ + │ ├─ containers-0.6.7 ┄┄ + │ ├─ hashable-1.4.7.0 ┄┄ + │ ├─ indexed-traversable-0.1.4 ┄┄ + │ ├─ indexed-traversable-instances-0.1.2 ┄┄ + │ ├─ transformers-0.5.6.2 ┄┄ + │ ├─ unordered-containers-0.2.20 ┄┄ + │ └─ vector-0.13.1.0 ┄┄ + ├─ aeson-pretty-0.8.10 + │ ├─ aeson-2.2.3.0 ┄┄ + │ ├─ base-4.17.2.1 ┄┄ + │ ├─ base-compat-0.14.0 + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ ghc-prim-0.9.1 ┄┄ + │ │ └─ unix-2.7.3 + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ bytestring-0.11.5.3 ┄┄ + │ │ └─ time-1.12.2 ┄┄ + │ ├─ bytestring-0.11.5.3 ┄┄ + │ ├─ scientific-0.3.8.0 ┄┄ + │ ├─ text-2.0.2 ┄┄ + │ ├─ unordered-containers-0.2.20 ┄┄ + │ └─ vector-0.13.1.0 ┄┄ + ├─ attoparsec-0.14.4 + │ ├─ array-0.5.4.0 ┄┄ + │ ├─ attoparsec-0.14.4 + │ │ [attoparsec-0.14.4:lib:"attoparsec-internal"] + │ │ ├─ array-0.5.4.0 ┄┄ + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ bytestring-0.11.5.3 ┄┄ + │ │ └─ text-2.0.2 ┄┄ + │ ├─ base-4.17.2.1 ┄┄ + │ ├─ bytestring-0.11.5.3 ┄┄ + │ ├─ containers-0.6.7 ┄┄ + │ ├─ deepseq-1.4.8.0 ┄┄ + │ ├─ ghc-prim-0.9.1 ┄┄ + │ ├─ scientific-0.3.8.0 ┄┄ + │ ├─ text-2.0.2 ┄┄ + │ └─ transformers-0.5.6.2 ┄┄ + ├─ attoparsec-aeson-2.2.2.0 + │ ├─ aeson-2.2.3.0 ┄┄ + │ ├─ attoparsec-0.14.4 ┄┄ + │ ├─ base-4.17.2.1 ┄┄ + │ ├─ bytestring-0.11.5.3 ┄┄ + │ ├─ character-ps-0.1 ┄┄ + │ ├─ integer-conversion-0.1.1 ┄┄ + │ ├─ primitive-0.9.0.0 ┄┄ + │ ├─ scientific-0.3.8.0 ┄┄ + │ ├─ text-2.0.2 ┄┄ + │ └─ vector-0.13.1.0 ┄┄ + ├─ base-4.17.2.1 ┄┄ + ├─ bytestring-0.11.5.3 ┄┄ + └─ cmdargs-0.10.22 + ├─ base-4.17.2.1 ┄┄ + ├─ filepath-1.4.2.2 ┄┄ + ├─ process-1.6.18.0 + │ ├─ base-4.17.2.1 ┄┄ + │ ├─ deepseq-1.4.8.0 ┄┄ + │ ├─ directory-1.3.7.1 + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ filepath-1.4.2.2 ┄┄ + │ │ ├─ time-1.12.2 ┄┄ + │ │ └─ unix-2.7.3 ┄┄ + │ ├─ filepath-1.4.2.2 ┄┄ + │ └─ unix-2.7.3 ┄┄ + ├─ template-haskell-2.19.0.0 ┄┄ + └─ transformers-0.5.6.2 ┄┄ +criterion-1.6.3.0 + [criterion-1.6.3.0:exe:"criterion-report"] + ├─ base-4.17.2.1 ┄┄ + ├─ base-compat-batteries-0.14.0 + │ ├─ OneTuple-0.4.2 ┄┄ + │ ├─ base-4.17.2.1 ┄┄ + │ ├─ base-compat-0.14.0 ┄┄ + │ ├─ foldable1-classes-compat-0.1 ┄┄ + │ └─ ghc-prim-0.9.1 ┄┄ + ├─ criterion-1.6.3.0 + │ ├─ Glob-0.10.2 + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ containers-0.6.7 ┄┄ + │ │ ├─ directory-1.3.7.1 ┄┄ + │ │ ├─ dlist-1.0 ┄┄ + │ │ ├─ filepath-1.4.2.2 ┄┄ + │ │ ├─ transformers-0.5.6.2 ┄┄ + │ │ └─ transformers-compat-0.7.2 ┄┄ + │ ├─ aeson-2.2.3.0 ┄┄ + │ ├─ base-4.17.2.1 ┄┄ + │ ├─ base-compat-batteries-0.14.0 ┄┄ + │ ├─ binary-0.8.9.1 ┄┄ + │ ├─ binary-orphans-1.0.5 + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ └─ binary-0.8.9.1 ┄┄ + │ ├─ bytestring-0.11.5.3 ┄┄ + │ ├─ cassava-0.5.3.2 + │ │ ├─ Only-0.1 + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ └─ deepseq-1.4.8.0 ┄┄ + │ │ ├─ array-0.5.4.0 ┄┄ + │ │ ├─ attoparsec-0.14.4 ┄┄ + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ bytestring-0.11.5.3 ┄┄ + │ │ ├─ containers-0.6.7 ┄┄ + │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ ├─ hashable-1.4.7.0 ┄┄ + │ │ ├─ scientific-0.3.8.0 ┄┄ + │ │ ├─ text-2.0.2 ┄┄ + │ │ ├─ text-short-0.1.6 ┄┄ + │ │ ├─ transformers-0.5.6.2 ┄┄ + │ │ ├─ unordered-containers-0.2.20 ┄┄ + │ │ └─ vector-0.13.1.0 ┄┄ + │ ├─ code-page-0.2.1 + │ │ └─ base-4.17.2.1 ┄┄ + │ ├─ containers-0.6.7 ┄┄ + │ ├─ criterion-measurement-0.2.2.0 + │ │ ├─ aeson-2.2.3.0 ┄┄ + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ base-compat-0.14.0 ┄┄ + │ │ ├─ binary-0.8.9.1 ┄┄ + │ │ ├─ containers-0.6.7 ┄┄ + │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ ├─ ghc-prim-0.9.1 ┄┄ + │ │ └─ vector-0.13.1.0 ┄┄ + │ ├─ deepseq-1.4.8.0 ┄┄ + │ ├─ directory-1.3.7.1 ┄┄ + │ ├─ exceptions-0.10.5 ┄┄ + │ ├─ filepath-1.4.2.2 ┄┄ + │ ├─ js-chart-2.9.4.1 + │ │ └─ base-4.17.2.1 ┄┄ + │ ├─ microstache-1.0.3 + │ │ ├─ aeson-2.2.3.0 ┄┄ + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ containers-0.6.7 ┄┄ + │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ ├─ directory-1.3.7.1 ┄┄ + │ │ ├─ filepath-1.4.2.2 ┄┄ + │ │ ├─ parsec-3.1.16.1 ┄┄ + │ │ ├─ text-2.0.2 ┄┄ + │ │ ├─ transformers-0.5.6.2 ┄┄ + │ │ ├─ unordered-containers-0.2.20 ┄┄ + │ │ └─ vector-0.13.1.0 ┄┄ + │ ├─ mtl-2.2.2 ┄┄ + │ ├─ mwc-random-0.15.1.0 + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ math-functions-0.3.4.4 + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ ├─ data-default-class-0.1.2.2 + │ │ │ │ └─ base-4.17.2.1 ┄┄ + │ │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ │ ├─ primitive-0.9.0.0 ┄┄ + │ │ │ └─ vector-0.13.1.0 ┄┄ + │ │ ├─ primitive-0.9.0.0 ┄┄ + │ │ ├─ random-1.2.1.2 ┄┄ + │ │ ├─ time-1.12.2 ┄┄ + │ │ └─ vector-0.13.1.0 ┄┄ + │ ├─ optparse-applicative-0.18.1.0 + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ prettyprinter-1.7.1 + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ └─ text-2.0.2 ┄┄ + │ │ ├─ prettyprinter-ansi-terminal-1.1.3 + │ │ │ ├─ ansi-terminal-1.1.1 + │ │ │ │ ├─ ansi-terminal-types-1.1 + │ │ │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ │ │ └─ colour-2.3.6 + │ │ │ │ │ └─ base-4.17.2.1 ┄┄ + │ │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ │ └─ colour-2.3.6 ┄┄ + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ ├─ prettyprinter-1.7.1 ┄┄ + │ │ │ └─ text-2.0.2 ┄┄ + │ │ ├─ process-1.6.18.0 ┄┄ + │ │ ├─ text-2.0.2 ┄┄ + │ │ ├─ transformers-0.5.6.2 ┄┄ + │ │ └─ transformers-compat-0.7.2 ┄┄ + │ ├─ parsec-3.1.16.1 ┄┄ + │ ├─ prettyprinter-1.7.1 ┄┄ + │ ├─ prettyprinter-ansi-terminal-1.1.3 ┄┄ + │ ├─ statistics-0.16.2.1 + │ │ ├─ aeson-2.2.3.0 ┄┄ + │ │ ├─ async-2.2.5 + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ ├─ hashable-1.4.7.0 ┄┄ + │ │ │ └─ stm-2.5.1.0 ┄┄ + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ binary-0.8.9.1 ┄┄ + │ │ ├─ data-default-class-0.1.2.2 ┄┄ + │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ ├─ dense-linear-algebra-0.1.0.0 + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ │ ├─ math-functions-0.3.4.4 ┄┄ + │ │ │ ├─ primitive-0.9.0.0 ┄┄ + │ │ │ ├─ vector-0.13.1.0 ┄┄ + │ │ │ ├─ vector-algorithms-0.9.0.2 + │ │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ │ ├─ bitvec-1.1.5.0 + │ │ │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ │ │ ├─ bytestring-0.11.5.3 ┄┄ + │ │ │ │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ │ │ │ ├─ ghc-bignum-1.3 ┄┄ + │ │ │ │ │ ├─ primitive-0.9.0.0 ┄┄ + │ │ │ │ │ └─ vector-0.13.1.0 ┄┄ + │ │ │ │ ├─ bytestring-0.11.5.3 ┄┄ + │ │ │ │ ├─ primitive-0.9.0.0 ┄┄ + │ │ │ │ └─ vector-0.13.1.0 ┄┄ + │ │ │ ├─ vector-binary-instances-0.2.5.2 + │ │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ │ ├─ binary-0.8.9.1 ┄┄ + │ │ │ │ └─ vector-0.13.1.0 ┄┄ + │ │ │ └─ vector-th-unbox-0.2.2 + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ ├─ template-haskell-2.19.0.0 ┄┄ + │ │ │ └─ vector-0.13.1.0 ┄┄ + │ │ ├─ math-functions-0.3.4.4 ┄┄ + │ │ ├─ mwc-random-0.15.1.0 ┄┄ + │ │ ├─ parallel-3.2.2.0 + │ │ │ ├─ array-0.5.4.0 ┄┄ + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ ├─ containers-0.6.7 ┄┄ + │ │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ │ └─ ghc-prim-0.9.1 ┄┄ + │ │ ├─ primitive-0.9.0.0 ┄┄ + │ │ ├─ random-1.2.1.2 ┄┄ + │ │ ├─ vector-0.13.1.0 ┄┄ + │ │ ├─ vector-algorithms-0.9.0.2 ┄┄ + │ │ ├─ vector-binary-instances-0.2.5.2 ┄┄ + │ │ └─ vector-th-unbox-0.2.2 ┄┄ + │ ├─ text-2.0.2 ┄┄ + │ ├─ time-1.12.2 ┄┄ + │ ├─ transformers-0.5.6.2 ┄┄ + │ ├─ transformers-compat-0.7.2 ┄┄ + │ ├─ vector-0.13.1.0 ┄┄ + │ └─ vector-algorithms-0.9.0.2 ┄┄ + └─ optparse-applicative-0.18.1.0 ┄┄ +hibet-1.4.0 + [hibet-1.4.0:exe:"hibet"] + ├─ base-4.17.2.1 ┄┄ + └─ hibet-1.4.0 + ├─ base-4.17.2.1 ┄┄ + ├─ bytestring-0.11.5.3 ┄┄ + ├─ containers-0.6.7 ┄┄ + ├─ deepseq-1.4.8.0 ┄┄ + ├─ directory-1.3.7.1 ┄┄ + ├─ effectful-2.4.0.0 + │ ├─ async-2.2.5 ┄┄ + │ ├─ base-4.17.2.1 ┄┄ + │ ├─ bytestring-0.11.5.3 ┄┄ + │ ├─ directory-1.3.7.1 ┄┄ + │ ├─ effectful-core-2.4.0.0 + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ containers-0.6.7 ┄┄ + │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ ├─ exceptions-0.10.5 ┄┄ + │ │ ├─ monad-control-1.0.3.1 + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ ├─ stm-2.5.1.0 ┄┄ + │ │ │ ├─ transformers-0.5.6.2 ┄┄ + │ │ │ ├─ transformers-base-0.4.6 + │ │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ │ ├─ base-orphans-0.9.2 ┄┄ + │ │ │ │ ├─ stm-2.5.1.0 ┄┄ + │ │ │ │ ├─ transformers-0.5.6.2 ┄┄ + │ │ │ │ └─ transformers-compat-0.7.2 ┄┄ + │ │ │ └─ transformers-compat-0.7.2 ┄┄ + │ │ ├─ primitive-0.9.0.0 ┄┄ + │ │ ├─ safe-exceptions-0.1.7.4 + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ │ ├─ exceptions-0.10.5 ┄┄ + │ │ │ └─ transformers-0.5.6.2 ┄┄ + │ │ ├─ strict-mutable-base-1.1.0.0 + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ └─ deepseq-1.4.8.0 ┄┄ + │ │ ├─ transformers-base-0.4.6 ┄┄ + │ │ └─ unliftio-core-0.2.1.0 + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ └─ transformers-0.5.6.2 ┄┄ + │ ├─ process-1.6.18.0 ┄┄ + │ ├─ stm-2.5.1.0 ┄┄ + │ ├─ strict-mutable-base-1.1.0.0 ┄┄ + │ ├─ time-1.12.2 ┄┄ + │ └─ unliftio-0.2.25.0 + │ ├─ async-2.2.5 ┄┄ + │ ├─ base-4.17.2.1 ┄┄ + │ ├─ bytestring-0.11.5.3 ┄┄ + │ ├─ deepseq-1.4.8.0 ┄┄ + │ ├─ directory-1.3.7.1 ┄┄ + │ ├─ filepath-1.4.2.2 ┄┄ + │ ├─ process-1.6.18.0 ┄┄ + │ ├─ safe-exceptions-0.1.7.4 ┄┄ + │ ├─ stm-2.5.1.0 ┄┄ + │ ├─ time-1.12.2 ┄┄ + │ ├─ transformers-0.5.6.2 ┄┄ + │ ├─ unix-2.7.3 ┄┄ + │ └─ unliftio-core-0.2.1.0 ┄┄ + ├─ effectful-core-2.4.0.0 ┄┄ + ├─ effectful-plugin-1.1.0.4 + │ ├─ base-4.17.2.1 ┄┄ + │ ├─ containers-0.6.7 ┄┄ + │ ├─ effectful-core-2.4.0.0 ┄┄ + │ └─ ghc-9.4.8 + │ ├─ array-0.5.4.0 ┄┄ + │ ├─ base-4.17.2.1 ┄┄ + │ ├─ binary-0.8.9.1 ┄┄ + │ ├─ bytestring-0.11.5.3 ┄┄ + │ ├─ containers-0.6.7 ┄┄ + │ ├─ deepseq-1.4.8.0 ┄┄ + │ ├─ directory-1.3.7.1 ┄┄ + │ ├─ exceptions-0.10.5 ┄┄ + │ ├─ filepath-1.4.2.2 ┄┄ + │ ├─ ghc-boot-9.4.8 + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ binary-0.8.9.1 ┄┄ + │ │ ├─ bytestring-0.11.5.3 ┄┄ + │ │ ├─ containers-0.6.7 ┄┄ + │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ ├─ directory-1.3.7.1 ┄┄ + │ │ ├─ filepath-1.4.2.2 ┄┄ + │ │ ├─ ghc-boot-th-9.4.8 ┄┄ + │ │ └─ unix-2.7.3 ┄┄ + │ ├─ ghc-heap-9.4.8 + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ containers-0.6.7 ┄┄ + │ │ ├─ ghc-prim-0.9.1 ┄┄ + │ │ └─ rts-1.0.2 ┄┄ + │ ├─ ghci-9.4.8 + │ │ ├─ array-0.5.4.0 ┄┄ + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ binary-0.8.9.1 ┄┄ + │ │ ├─ bytestring-0.11.5.3 ┄┄ + │ │ ├─ containers-0.6.7 ┄┄ + │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ ├─ filepath-1.4.2.2 ┄┄ + │ │ ├─ ghc-boot-9.4.8 ┄┄ + │ │ ├─ ghc-heap-9.4.8 ┄┄ + │ │ ├─ ghc-prim-0.9.1 ┄┄ + │ │ ├─ rts-1.0.2 ┄┄ + │ │ ├─ template-haskell-2.19.0.0 ┄┄ + │ │ ├─ transformers-0.5.6.2 ┄┄ + │ │ └─ unix-2.7.3 ┄┄ + │ ├─ hpc-0.6.1.0 + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ containers-0.6.7 ┄┄ + │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ ├─ directory-1.3.7.1 ┄┄ + │ │ ├─ filepath-1.4.2.2 ┄┄ + │ │ └─ time-1.12.2 ┄┄ + │ ├─ process-1.6.18.0 ┄┄ + │ ├─ stm-2.5.1.0 ┄┄ + │ ├─ template-haskell-2.19.0.0 ┄┄ + │ ├─ terminfo-0.4.1.5 + │ │ └─ base-4.17.2.1 ┄┄ + │ ├─ time-1.12.2 ┄┄ + │ ├─ transformers-0.5.6.2 ┄┄ + │ └─ unix-2.7.3 ┄┄ + ├─ effectful-th-1.0.0.3 + │ ├─ base-4.17.2.1 ┄┄ + │ ├─ containers-0.6.7 ┄┄ + │ ├─ effectful-core-2.4.0.0 ┄┄ + │ ├─ exceptions-0.10.5 ┄┄ + │ ├─ template-haskell-2.19.0.0 ┄┄ + │ └─ th-abstraction-0.7.0.0 ┄┄ + ├─ extra-1.8 + │ ├─ base-4.17.2.1 ┄┄ + │ ├─ clock-0.8.4 + │ │ └─ base-4.17.2.1 ┄┄ + │ ├─ directory-1.3.7.1 ┄┄ + │ ├─ filepath-1.4.2.2 ┄┄ + │ ├─ process-1.6.18.0 ┄┄ + │ ├─ time-1.12.2 ┄┄ + │ └─ unix-2.7.3 ┄┄ + ├─ filepath-1.4.2.2 ┄┄ + ├─ gitrev-1.3.1 + │ ├─ base-4.17.2.1 ┄┄ + │ ├─ base-compat-0.14.0 ┄┄ + │ ├─ directory-1.3.7.1 ┄┄ + │ ├─ filepath-1.4.2.2 ┄┄ + │ ├─ process-1.6.18.0 ┄┄ + │ └─ template-haskell-2.19.0.0 ┄┄ + ├─ hashable-1.4.7.0 ┄┄ + ├─ haskeline-0.8.2 + │ ├─ base-4.17.2.1 ┄┄ + │ ├─ bytestring-0.11.5.3 ┄┄ + │ ├─ containers-0.6.7 ┄┄ + │ ├─ directory-1.3.7.1 ┄┄ + │ ├─ exceptions-0.10.5 ┄┄ + │ ├─ filepath-1.4.2.2 ┄┄ + │ ├─ process-1.6.18.0 ┄┄ + │ ├─ stm-2.5.1.0 ┄┄ + │ ├─ terminfo-0.4.1.5 ┄┄ + │ ├─ transformers-0.5.6.2 ┄┄ + │ └─ unix-2.7.3 ┄┄ + ├─ log-effectful-1.0.0.0 + │ ├─ base-4.17.2.1 ┄┄ + │ ├─ effectful-core-2.4.0.0 ┄┄ + │ ├─ log-base-0.12.0.1 + │ │ ├─ aeson-2.2.3.0 ┄┄ + │ │ ├─ aeson-pretty-0.8.10 ┄┄ + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ bytestring-0.11.5.3 ┄┄ + │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ ├─ exceptions-0.10.5 ┄┄ + │ │ ├─ mmorph-1.2.0 + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ ├─ mtl-2.2.2 ┄┄ + │ │ │ ├─ transformers-0.5.6.2 ┄┄ + │ │ │ └─ transformers-compat-0.7.2 ┄┄ + │ │ ├─ monad-control-1.0.3.1 ┄┄ + │ │ ├─ mtl-2.2.2 ┄┄ + │ │ ├─ semigroups-0.20 + │ │ │ └─ base-4.17.2.1 ┄┄ + │ │ ├─ stm-2.5.1.0 ┄┄ + │ │ ├─ text-2.0.2 ┄┄ + │ │ ├─ time-1.12.2 ┄┄ + │ │ ├─ transformers-base-0.4.6 ┄┄ + │ │ ├─ unliftio-core-0.2.1.0 ┄┄ + │ │ └─ unordered-containers-0.2.20 ┄┄ + │ ├─ text-2.0.2 ┄┄ + │ └─ time-1.12.2 ┄┄ + ├─ megaparsec-9.6.1 + │ ├─ base-4.17.2.1 ┄┄ + │ ├─ bytestring-0.11.5.3 ┄┄ + │ ├─ case-insensitive-1.2.1.0 + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ bytestring-0.11.5.3 ┄┄ + │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ ├─ hashable-1.4.7.0 ┄┄ + │ │ └─ text-2.0.2 ┄┄ + │ ├─ containers-0.6.7 ┄┄ + │ ├─ deepseq-1.4.8.0 ┄┄ + │ ├─ mtl-2.2.2 ┄┄ + │ ├─ parser-combinators-1.3.0 + │ │ └─ base-4.17.2.1 ┄┄ + │ ├─ scientific-0.3.8.0 ┄┄ + │ ├─ text-2.0.2 ┄┄ + │ └─ transformers-0.5.6.2 ┄┄ + ├─ neat-interpolation-0.5.1.4 + │ ├─ base-4.17.2.1 ┄┄ + │ ├─ megaparsec-9.6.1 ┄┄ + │ ├─ template-haskell-2.19.0.0 ┄┄ + │ └─ text-2.0.2 ┄┄ + ├─ optparse-applicative-0.18.1.0 ┄┄ + ├─ pager-0.1.1.0 + │ ├─ base-4.17.2.1 ┄┄ + │ ├─ bytestring-0.11.5.3 ┄┄ + │ ├─ conduit-1.3.6 + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ bytestring-0.11.5.3 ┄┄ + │ │ ├─ directory-1.3.7.1 ┄┄ + │ │ ├─ exceptions-0.10.5 ┄┄ + │ │ ├─ filepath-1.4.2.2 ┄┄ + │ │ ├─ mono-traversable-1.0.20.0 + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ ├─ bytestring-0.11.5.3 ┄┄ + │ │ │ ├─ containers-0.6.7 ┄┄ + │ │ │ ├─ hashable-1.4.7.0 ┄┄ + │ │ │ ├─ split-0.2.5 + │ │ │ │ └─ base-4.17.2.1 ┄┄ + │ │ │ ├─ text-2.0.2 ┄┄ + │ │ │ ├─ transformers-0.5.6.2 ┄┄ + │ │ │ ├─ unordered-containers-0.2.20 ┄┄ + │ │ │ ├─ vector-0.13.1.0 ┄┄ + │ │ │ └─ vector-algorithms-0.9.0.2 ┄┄ + │ │ ├─ mtl-2.2.2 ┄┄ + │ │ ├─ primitive-0.9.0.0 ┄┄ + │ │ ├─ resourcet-1.3.0 + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ ├─ containers-0.6.7 ┄┄ + │ │ │ ├─ exceptions-0.10.5 ┄┄ + │ │ │ ├─ mtl-2.2.2 ┄┄ + │ │ │ ├─ primitive-0.9.0.0 ┄┄ + │ │ │ ├─ transformers-0.5.6.2 ┄┄ + │ │ │ └─ unliftio-core-0.2.1.0 ┄┄ + │ │ ├─ text-2.0.2 ┄┄ + │ │ ├─ transformers-0.5.6.2 ┄┄ + │ │ ├─ unix-2.7.3 ┄┄ + │ │ ├─ unliftio-core-0.2.1.0 ┄┄ + │ │ └─ vector-0.13.1.0 ┄┄ + │ ├─ conduit-extra-1.3.6 + │ │ ├─ async-2.2.5 ┄┄ + │ │ ├─ attoparsec-0.14.4 ┄┄ + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ bytestring-0.11.5.3 ┄┄ + │ │ ├─ conduit-1.3.6 ┄┄ + │ │ ├─ directory-1.3.7.1 ┄┄ + │ │ ├─ filepath-1.4.2.2 ┄┄ + │ │ ├─ network-3.2.4.0 + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ ├─ bytestring-0.11.5.3 ┄┄ + │ │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ │ ├─ directory-1.3.7.1 ┄┄ + │ │ │ └─ stm-2.5.1.0 ┄┄ + │ │ ├─ primitive-0.9.0.0 ┄┄ + │ │ ├─ process-1.6.18.0 ┄┄ + │ │ ├─ resourcet-1.3.0 ┄┄ + │ │ ├─ stm-2.5.1.0 ┄┄ + │ │ ├─ streaming-commons-0.2.2.6 + │ │ │ ├─ array-0.5.4.0 ┄┄ + │ │ │ ├─ async-2.2.5 ┄┄ + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ ├─ bytestring-0.11.5.3 ┄┄ + │ │ │ ├─ directory-1.3.7.1 ┄┄ + │ │ │ ├─ network-3.2.4.0 ┄┄ + │ │ │ ├─ process-1.6.18.0 ┄┄ + │ │ │ ├─ random-1.2.1.2 ┄┄ + │ │ │ ├─ stm-2.5.1.0 ┄┄ + │ │ │ ├─ text-2.0.2 ┄┄ + │ │ │ ├─ transformers-0.5.6.2 ┄┄ + │ │ │ ├─ unix-2.7.3 ┄┄ + │ │ │ └─ zlib-0.7.1.0 + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ └─ bytestring-0.11.5.3 ┄┄ + │ │ ├─ text-2.0.2 ┄┄ + │ │ ├─ transformers-0.5.6.2 ┄┄ + │ │ ├─ typed-process-0.2.12.0 + │ │ │ ├─ async-2.2.5 ┄┄ + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ ├─ bytestring-0.11.5.3 ┄┄ + │ │ │ ├─ process-1.6.18.0 ┄┄ + │ │ │ ├─ stm-2.5.1.0 ┄┄ + │ │ │ ├─ transformers-0.5.6.2 ┄┄ + │ │ │ └─ unliftio-core-0.2.1.0 ┄┄ + │ │ └─ unliftio-core-0.2.1.0 ┄┄ + │ ├─ directory-1.3.7.1 ┄┄ + │ ├─ process-1.6.18.0 ┄┄ + │ ├─ resourcet-1.3.0 ┄┄ + │ ├─ safe-0.3.21 + │ │ └─ base-4.17.2.1 ┄┄ + │ ├─ terminfo-0.4.1.5 ┄┄ + │ ├─ text-2.0.2 ┄┄ + │ ├─ transformers-0.5.6.2 ┄┄ + │ └─ unix-2.7.3 ┄┄ + ├─ parallel-3.2.2.0 ┄┄ + ├─ path-0.9.5 + │ ├─ aeson-2.2.3.0 ┄┄ + │ ├─ base-4.17.2.1 ┄┄ + │ ├─ deepseq-1.4.8.0 ┄┄ + │ ├─ exceptions-0.10.5 ┄┄ + │ ├─ filepath-1.4.2.2 ┄┄ + │ ├─ hashable-1.4.7.0 ┄┄ + │ ├─ template-haskell-2.19.0.0 ┄┄ + │ └─ text-2.0.2 ┄┄ + ├─ path-io-1.8.2 + │ ├─ base-4.17.2.1 ┄┄ + │ ├─ containers-0.6.7 ┄┄ + │ ├─ directory-1.3.7.1 ┄┄ + │ ├─ dlist-1.0 ┄┄ + │ ├─ exceptions-0.10.5 ┄┄ + │ ├─ filepath-1.4.2.2 ┄┄ + │ ├─ path-0.9.5 ┄┄ + │ ├─ temporary-1.3 + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ directory-1.3.7.1 ┄┄ + │ │ ├─ exceptions-0.10.5 ┄┄ + │ │ ├─ filepath-1.4.2.2 ┄┄ + │ │ ├─ random-1.2.1.2 ┄┄ + │ │ ├─ transformers-0.5.6.2 ┄┄ + │ │ └─ unix-2.7.3 ┄┄ + │ ├─ time-1.12.2 ┄┄ + │ ├─ transformers-0.5.6.2 ┄┄ + │ └─ unix-compat-0.7.3 + │ ├─ base-4.17.2.1 ┄┄ + │ └─ unix-2.7.3 ┄┄ + ├─ prettyprinter-1.7.1 ┄┄ + ├─ prettyprinter-ansi-terminal-1.1.3 ┄┄ + ├─ radixtree-0.6.0.0 + │ ├─ base-4.17.2.1 ┄┄ + │ ├─ containers-0.6.7 ┄┄ + │ ├─ deepseq-1.4.8.0 ┄┄ + │ ├─ microlens-0.4.13.1 + │ │ └─ base-4.17.2.1 ┄┄ + │ ├─ mtl-2.2.2 ┄┄ + │ ├─ parsers-0.12.11 + │ │ ├─ attoparsec-0.14.4 ┄┄ + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ base-orphans-0.9.2 ┄┄ + │ │ ├─ binary-0.8.9.1 ┄┄ + │ │ ├─ charset-0.3.10 + │ │ │ ├─ array-0.5.4.0 ┄┄ + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ ├─ bytestring-0.11.5.3 ┄┄ + │ │ │ ├─ containers-0.6.7 ┄┄ + │ │ │ └─ unordered-containers-0.2.20 ┄┄ + │ │ ├─ containers-0.6.7 ┄┄ + │ │ ├─ mtl-2.2.2 ┄┄ + │ │ ├─ parsec-3.1.16.1 ┄┄ + │ │ ├─ scientific-0.3.8.0 ┄┄ + │ │ ├─ text-2.0.2 ┄┄ + │ │ ├─ transformers-0.5.6.2 ┄┄ + │ │ └─ unordered-containers-0.2.20 ┄┄ + │ ├─ text-2.0.2 ┄┄ + │ └─ vector-0.13.1.0 ┄┄ + ├─ resourcet-effectful-1.0.1.0 + │ ├─ base-4.17.2.1 ┄┄ + │ ├─ effectful-core-2.4.0.0 ┄┄ + │ └─ resourcet-1.3.0 ┄┄ + ├─ terminal-size-0.3.4 + │ └─ base-4.17.2.1 ┄┄ + ├─ text-2.0.2 ┄┄ + ├─ text-rope-0.3 + │ ├─ base-4.17.2.1 ┄┄ + │ ├─ deepseq-1.4.8.0 ┄┄ + │ ├─ text-2.0.2 ┄┄ + │ └─ vector-0.13.1.0 ┄┄ + ├─ tomland-1.3.3.3 + │ ├─ base-4.17.2.1 ┄┄ + │ ├─ bytestring-0.11.5.3 ┄┄ + │ ├─ containers-0.6.7 ┄┄ + │ ├─ deepseq-1.4.8.0 ┄┄ + │ ├─ hashable-1.4.7.0 ┄┄ + │ ├─ megaparsec-9.6.1 ┄┄ + │ ├─ mtl-2.2.2 ┄┄ + │ ├─ parser-combinators-1.3.0 ┄┄ + │ ├─ text-2.0.2 ┄┄ + │ ├─ time-1.12.2 ┄┄ + │ ├─ unordered-containers-0.2.20 ┄┄ + │ └─ validation-selective-0.2.0.0 + │ ├─ base-4.17.2.1 ┄┄ + │ ├─ deepseq-1.4.8.0 ┄┄ + │ └─ selective-0.7.0.1 + │ ├─ base-4.17.2.1 ┄┄ + │ └─ transformers-0.5.6.2 ┄┄ + └─ unordered-containers-0.2.20 ┄┄ +hibet-1.4.0 + [hibet-1.4.0:bench:"hibet-benchmark"] + ├─ base-4.17.2.1 ┄┄ + ├─ bytestring-0.11.5.3 ┄┄ + ├─ criterion-1.6.3.0 ┄┄ + ├─ file-embed-0.0.16.0 + │ ├─ base-4.17.2.1 ┄┄ + │ ├─ bytestring-0.11.5.3 ┄┄ + │ ├─ directory-1.3.7.1 ┄┄ + │ ├─ filepath-1.4.2.2 ┄┄ + │ └─ template-haskell-2.19.0.0 ┄┄ + ├─ hibet-1.4.0 ┄┄ + ├─ path-0.9.5 ┄┄ + ├─ path-io-1.8.2 ┄┄ + ├─ text-2.0.2 ┄┄ + └─ text-rope-0.3 ┄┄ +hibet-1.4.0 + [hibet-1.4.0:test:"hibet-env"] + ├─ base-4.17.2.1 ┄┄ + ├─ bytestring-0.11.5.3 ┄┄ + ├─ containers-0.6.7 ┄┄ + ├─ effectful-core-2.4.0.0 ┄┄ + ├─ hibet-1.4.0 ┄┄ + ├─ hspec-2.11.9 + │ ├─ QuickCheck-2.15.0.1 ┄┄ + │ ├─ base-4.17.2.1 ┄┄ + │ ├─ hspec-core-2.11.9 + │ │ ├─ HUnit-1.6.2.0 + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ ├─ call-stack-0.4.0 + │ │ │ │ └─ base-4.17.2.1 ┄┄ + │ │ │ └─ deepseq-1.4.8.0 ┄┄ + │ │ ├─ QuickCheck-2.15.0.1 ┄┄ + │ │ ├─ ansi-terminal-1.1.1 ┄┄ + │ │ ├─ array-0.5.4.0 ┄┄ + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ call-stack-0.4.0 ┄┄ + │ │ ├─ deepseq-1.4.8.0 ┄┄ + │ │ ├─ directory-1.3.7.1 ┄┄ + │ │ ├─ filepath-1.4.2.2 ┄┄ + │ │ ├─ haskell-lexer-1.1.1 + │ │ │ └─ base-4.17.2.1 ┄┄ + │ │ ├─ hspec-expectations-0.8.4 + │ │ │ ├─ HUnit-1.6.2.0 ┄┄ + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ └─ call-stack-0.4.0 ┄┄ + │ │ ├─ process-1.6.18.0 ┄┄ + │ │ ├─ quickcheck-io-0.2.0 + │ │ │ ├─ HUnit-1.6.2.0 ┄┄ + │ │ │ ├─ QuickCheck-2.15.0.1 ┄┄ + │ │ │ └─ base-4.17.2.1 ┄┄ + │ │ ├─ random-1.2.1.2 ┄┄ + │ │ ├─ stm-2.5.1.0 ┄┄ + │ │ ├─ tf-random-0.5 + │ │ │ ├─ base-4.17.2.1 ┄┄ + │ │ │ ├─ primitive-0.9.0.0 ┄┄ + │ │ │ ├─ random-1.2.1.2 ┄┄ + │ │ │ └─ time-1.12.2 ┄┄ + │ │ ├─ time-1.12.2 ┄┄ + │ │ └─ transformers-0.5.6.2 ┄┄ + │ ├─ hspec-discover-2.11.9 + │ │ ├─ base-4.17.2.1 ┄┄ + │ │ ├─ directory-1.3.7.1 ┄┄ + │ │ └─ filepath-1.4.2.2 ┄┄ + │ └─ hspec-expectations-0.8.4 ┄┄ + ├─ text-2.0.2 ┄┄ + └─ unordered-containers-0.2.20 ┄┄ +hibet-1.4.0 + [hibet-1.4.0:test:"hibet-labels"] + ├─ base-4.17.2.1 ┄┄ + ├─ bytestring-0.11.5.3 ┄┄ + ├─ containers-0.6.7 ┄┄ + ├─ hibet-1.4.0 ┄┄ + └─ hspec-2.11.9 ┄┄ +hibet-1.4.0 + [hibet-1.4.0:test:"hibet-parse"] + ├─ base-4.17.2.1 ┄┄ + ├─ hibet-1.4.0 ┄┄ + └─ hspec-2.11.9 ┄┄ +hibet-1.4.0 + [hibet-1.4.0:test:"hibet-pretty"] + ├─ base-4.17.2.1 ┄┄ + ├─ hibet-1.4.0 ┄┄ + ├─ hspec-2.11.9 ┄┄ + └─ prettyprinter-1.7.1 ┄┄ +hsc2hs-0.68.10 + [hsc2hs-0.68.10:exe:"hsc2hs"] + ├─ base-4.17.2.1 ┄┄ + ├─ containers-0.6.7 ┄┄ + ├─ directory-1.3.7.1 ┄┄ + ├─ filepath-1.4.2.2 ┄┄ + └─ process-1.6.18.0 ┄┄ +hspec-discover-2.11.9 + [hspec-discover-2.11.9:exe:"hspec-discover"] + ├─ base-4.17.2.1 ┄┄ + ├─ directory-1.3.7.1 ┄┄ + ├─ filepath-1.4.2.2 ┄┄ + └─ hspec-discover-2.11.9 ┄┄ +pager-0.1.1.0 + [pager-0.1.1.0:exe:"hs-pager-test-pager"] + ├─ base-4.17.2.1 ┄┄ + ├─ bytestring-0.11.5.3 ┄┄ + ├─ conduit-extra-1.3.6 ┄┄ + ├─ pager-0.1.1.0 ┄┄ + └─ text-2.0.2 ┄┄ + +Top-sorted +~~~~~~~~~~ + +UnitId "rts-1.0.2" +UnitId "ghc-prim-0.9.1" +UnitId "ghc-bignum-1.3" +UnitId "base-4.17.2.1" +UnitId "array-0.5.4.0" +UnitId "deepseq-1.4.8.0" +UnitId "ghc-boot-th-9.4.8" +UnitId "pretty-1.1.3.6" +UnitId "template-haskell-2.19.0.0" +UnitId "containers-0.6.7" +UnitId "filepath-1.4.2.2" +UnitId "time-1.12.2" +UnitId "bytestring-0.11.5.3" +UnitId "unix-2.7.3" +UnitId "directory-1.3.7.1" +UnitId "dlist-1.0-a33e5a7f21dad55513d80ffb06f20c2ff9a02682175b739ebc182ca2e2ba9508" +UnitId "transformers-0.5.6.2" +UnitId "transformers-compat-0.7.2-07807f6a916fed9cec5ac85ad002b56765f520681b2bbe9a3eb8b85bf077eafe" +UnitId "Glob-0.10.2-0adca46b32ac4956360a311e257658751e5fced3b74560cea74ed0dad8f2068c" +UnitId "call-stack-0.4.0-ef00e2167e83fb3355138aa96af1a70586e142f51a7b8330cf284129747e54a2" +UnitId "HUnit-1.6.2.0-81b4dc237915cc9d8f527716e205cd06628ff22d41ad3bc2ddbc155e19abb115" +UnitId "OneTuple-0.4.2-6e48a5a19ac27c7595d4a46dd031470e496b7f4dfada40e2cdf255c120b8b82e" +UnitId "Only-0.1-588a84422107567fe3e1b9b0c57f651cf082a7604c671377fb32a9ba34597a92" +UnitId "mtl-2.2.2" +UnitId "splitmix-0.1.0.5-4b143f483b5c4b68de945ccc15fa9370952f4fb7bd1e652c89a5928edc61b8e6" +UnitId "random-1.2.1.2-bcc926197c32f4db989238c5ad865acee4ac5050d11236d68e7af0232def6b43" +UnitId "QuickCheck-2.15.0.1-972dc976edb56b14d43453aea439900256117d54d75561c0c6bdb59e1b145b65" +UnitId "stm-2.5.1.0" +UnitId "StateVar-1.2.2-6c6f2d2fb12d62ce79fbf55097def1b8d77de556076d2fc8c77b411230bf4711" +UnitId "character-ps-0.1-06ba824204450a7d75a6b5a69c46c9406f5b6cf26ecfcc7c643c22dac4fe5fb0" +UnitId "exceptions-0.10.5" +UnitId "os-string-2.0.6-cf1b6058be6ec02ee665e6c0f59d1a630aeebaf5a699ebefdd08a0c3202d55f2" +UnitId "binary-0.8.9.1" +UnitId "text-2.0.2" +UnitId "hashable-1.4.7.0-a3f848b51d3df7052cbed116a7f829ada74559e2dd374afc89e06fde8aff204f" +UnitId "data-fix-0.3.4-4265fb7b5977cc6f163f052782769db9e0f98c62defa957f0ca22adfb1ea753c" +UnitId "base-orphans-0.9.2-7d503c32a334b2638e893e36b022c722bf894e3a74efa923c34eecc4f8ded6a0" +UnitId "generically-0.1.1-8f35505db6974335818517e8950dbf70e0dd5d9708f58e5a504ef1664fcf78c3" +UnitId "tagged-0.8.8-624b214960ff455bd482541a3c1e8bb3f35211ff82b756b79d5e450f98504a31" +UnitId "foldable1-classes-compat-0.1-103edd132976bd4a0e84499965ad0a5acf05bf23c9ccbbc5b79481c3014de3a3" +UnitId "indexed-traversable-0.1.4-c813b8aa61317a7149a92b8dc88844032c92406800ce2daf603f143059d27ddf" +UnitId "primitive-0.9.0.0-c17bfbc8573696bac8dd2ab2fd37a6595b395851b9dacccaf9812eafc03386b4" +UnitId "integer-conversion-0.1.1-f8ca56537e919e8545730b167b3626f9466d44cce0716055c3f70fba5e5cd187" +UnitId "integer-logarithms-1.0.3.1-f507db5eefcca9e02639c7fe32e341eabef3f2cd3213abf71e52f4346676a682" +UnitId "parsec-3.1.16.1" +UnitId "th-compat-0.1.5-d430812e254ef1713c60f9abd970ca4eda63a18350cd1d066b09dcebdcafa3ae" +UnitId "network-uri-2.6.4.2-f40d21da8706a6b7452a1c3f0654daf2d3e5bcb709547f666db1ff73b405b19d" +UnitId "scientific-0.3.8.0-9052163982295f3479b2460669123aa22f39e8ea28c9e10399845c425bf1ff26" +UnitId "unordered-containers-0.2.20-efcbf6df023ae02f2e1871036ac5d6975b6e1500121ccc3aa22e285f17b29891" +UnitId "vector-stream-0.1.0.1-f1d79872e7d79a09fd296306cd5dfb6c0221d55fc2f68a9711e495945aca48ad" +UnitId "vector-0.13.1.0-a342e5f0ce133bf9ec0ca8b6a47c80616ae79f7110aeae8394957472013236f5" +UnitId "indexed-traversable-instances-0.1.2-5dded62ed3d931993a8a99b1359449ff5e36dec313770271748d53d312df05c0" +UnitId "assoc-1.1.1-9e811843201b30cbef6987433580f967a3b752c8d46b6589aa9958541d181df2" +UnitId "distributive-0.6.2.1-285005ac57a7911dc3dbaab7b67315951c7b9ac3d7337c7bb81e11b86f7817a0" +UnitId "comonad-5.0.8-c6b48e0dbf30c925f1e792482ea9d4c97729493ccf7e76e3243c0c61df0b42bd" +UnitId "th-abstraction-0.7.0.0-562e7270faddda2f9fbe3f4fd9bb8d9203b7679ccbe13c5f16c40ca8058116a2" +UnitId "bifunctors-5.6.2-a7a06bbdbd7c6b866678e439ae28b310f527629610ff6010cdba7faa553d08e3" +UnitId "contravariant-1.5.5-a20fe5ca314e5b5686dbb79b903d0150095d3c61a4c6738ed1f85388648d9801" +UnitId "semigroupoids-6.0.1-9f3a8e0f08c130261c06673731219bf16f745a01a78e6a2ecc157ba3ef3083ba" +UnitId "these-1.2.1-f4f66c9501ab6821c772aec8f39ce00c2ad1ed025841124a19e4028c18110cc3" +UnitId "semialign-1.3.1-86ca68b007f33eed2072b7f2e270045806e2133aea75ff69a19fa00f3e3cd39c" +UnitId "strict-0.5.1-35dc86c70785609eabfcb6bddfecda432802d1bc80c8c936e09b908174de55b2" +UnitId "time-compat-1.9.7-a1d6136dacb9065c6b24e087e3aba59255c9aeb5d4a1b7fa17dd03e8846b5c0c" +UnitId "text-iso8601-0.1.1-edd04b8b2f7f9d08698584b88223ebaf2f0e562a0eb156b491a9d58b79631cd8" +UnitId "text-short-0.1.6-b39cf6f3ed71a27bf96da9b4631bb71e645591162103083879f8792ef5149344" +UnitId "uuid-types-1.0.6-ee2e5a6c4d0ee00c14aadac46507f84c9e28db947a33470d56c4b35151eba96e" +UnitId "witherable-0.5-bf0c2fe06347134e341b760889037e7c9840808499c0114a0a602dbcb8d12231" +UnitId "aeson-2.2.3.0-f18b1721c51142786e715fe204ab8163388ddacca1b3ba145c77ff93b0ef2923" +UnitId "base-compat-0.14.0-095e05fe1857649a2325f5795a1754e1153ec188b5bcb7efd282b0d4b8676477" +UnitId "aeson-pretty-0.8.10-b6be571c3a9e9e2b10b0921cecedca4ea99e74930adbbc6b939a5b8930e3f626" +UnitId "attoparsec-0.14.4-l-attoparsec-internal-0c8890450f0c579acd356ab408d800df04e2dd0824e4996b6c5bfadcf67947a4" +UnitId "attoparsec-0.14.4-08498dc37dfa13e1fef27d0a99956f89da9d4ed48d090fa2fc36f61f4483c236" +UnitId "attoparsec-aeson-2.2.2.0-f7f38ec1c76875a16f5c69bd480d45d5e9e572d2b746426140e132bc86e6af6c" +UnitId "process-1.6.18.0" +UnitId "cmdargs-0.10.22-58faeb4494cce0a5bccb94b4731d9db6dc0f954d85dec375e3a8ba8222430c46" +UnitId "aeson-pretty-0.8.10-e-aeson-pretty-593c5942194de3fc3a653f2485d5d59ec98367560a9576729a2b37fdd73e822a" +UnitId "colour-2.3.6-101a30bf97e485340c2f8c4965d7a09c45f53ec9a0681956d60a295961f45156" +UnitId "ansi-terminal-types-1.1-6d303a0fcc5112274788c758aaccf72e202bb06412e506879a622118dc4a6efe" +UnitId "ansi-terminal-1.1.1-9a0832138b85587e564b731f3eb8544cfac3f1b09c25035e0c255ff5defabbc9" +UnitId "async-2.2.5-ee1c1688744aac44514d29eb273b4b6ba90bf2122fbbf8754a4fd855cf01b6d7" +UnitId "base-compat-batteries-0.14.0-4559e1ce7b10f33eb8f8a68fc3faf98c5b77a02a70a49e94c7fe12d566258d75" +UnitId "binary-orphans-1.0.5-1ac470cecdbbf08c25070c27b14612ba0bf2a9c970249cd3f9873f7c5621a401" +UnitId "bitvec-1.1.5.0-9bbed18052bda9065b11af488da12e89f024db0a8a2f3bafe0c7c5b1fb0cf7f3" +UnitId "case-insensitive-1.2.1.0-599c25a76aae9c87830e4315fc13188b41c065228ff3ffe29c4861890d00fb95" +UnitId "cassava-0.5.3.2-9ecb7cb818664c09fc62ef577326ce7343b402e22e0ef979be79145a1ec64400" +UnitId "charset-0.3.10-1a8de4d84dad54957a2ffbfa55d58a7c7ae84b9262921dbcc3c6b1096339cc8a" +UnitId "clock-0.8.4-2292d6cf553e98720aade4be17251554883619d3886e13a1c3f5352321468bae" +UnitId "hsc2hs-0.68.10-e-hsc2hs-3c26ce6e00190495fef7423e6443d58e968627872aa222223bffb4b0ff941572" +UnitId "code-page-0.2.1-a2c681b3ce689b280e3a0d5677f4762f06a7f3615907b61ad81f9fefc42458ab" +UnitId "split-0.2.5-fab53f63a5abbb9e714ec5de37b8818a9b7d1b464c6861b9c6a190a49e3c76d8" +UnitId "vector-algorithms-0.9.0.2-878faad0a12be07267c2d611f73c329fa9e5538ae662595348491d4c985b5241" +UnitId "mono-traversable-1.0.20.0-bf9e5f4a089b178bdfb32a578f05875467f7ce80bdc485a3fc3f700cbc829548" +UnitId "unliftio-core-0.2.1.0-cc06b481863300209bec0bfe4d84fb4b81231588c3e0b1bb95e26ca6105660d8" +UnitId "resourcet-1.3.0-e07d6f5c7723d30c8dc8f55250b19e0714d338737adca6d902a33084f1b04ea6" +UnitId "conduit-1.3.6-f066b03b7df8ad1aca4ce67fcccc2ec0786bb0c941a481f3b6717a2841b3e6aa" +UnitId "network-3.2.4.0-c689708a3979f0107aae1de6fe4da63574adfe6f7d0137fd06ebbd2e880985ed" +UnitId "zlib-0.7.1.0-bf96f10a29146bf94fd15780c570a690bea5eb338569455f6586422043b7aeb3" +UnitId "streaming-commons-0.2.2.6-d2d1e9d25c1552360c4a350aae16900896181c919a31e816b74c20bd2cfdaa3e" +UnitId "typed-process-0.2.12.0-67c36c449e51cf156879000f7fd73161db69ed6355f053beae1ae18c237d54a1" +UnitId "conduit-extra-1.3.6-9b0d18dc823ce95f43977e747c2c0e3aa2c754d580676e5539d292315231ce44" +UnitId "criterion-measurement-0.2.2.0-6cc3570be46a6c116998c381050b3c9042b8709bf12357cd8b378c71af744193" +UnitId "js-chart-2.9.4.1-86c56bc81047dc731ff9cc2fe1943695355df67319c6ecd2d429a1f1226b7557" +UnitId "microstache-1.0.3-1f9bcf5ac6301bc8f3cb48e24e511dc597f06431f128a782601d8b1099a84a59" +UnitId "data-default-class-0.1.2.2-2cf5c1ba4834182d489730b5e9f115f39b02884e581129fdc727ca23cfd851f7" +UnitId "math-functions-0.3.4.4-6b83870c201b5cbdfa40753d9ea91fcf78e084c540b35ded220708275be47d04" +UnitId "mwc-random-0.15.1.0-e4fffe0385459bb9ed1b67776f394793a3a9a33c86e030f429e317d0765014e2" +UnitId "prettyprinter-1.7.1-a2952acf3277904adfc9f81216975cb21318656a97e53d37904afdcac59e616b" +UnitId "prettyprinter-ansi-terminal-1.1.3-b92410ab6527aa9d3f2e514e15dc6d9e7fbc36d96ca11bce0deaeeea8d0bb898" +UnitId "optparse-applicative-0.18.1.0-523f53e9bdd4161ae7f9881991180767a933c2ec89edacc35245aa60ca1041d1" +UnitId "vector-binary-instances-0.2.5.2-cb3c049701a7837cac2e52549eb0eb3cc2ab021cc9081eedcc97c545ed050aec" +UnitId "vector-th-unbox-0.2.2-b8b975c4cdd6b6a4273db4362bd60e846b8277c914fff5ae6e09d2ec7b7930ad" +UnitId "dense-linear-algebra-0.1.0.0-a956709472fcf5f3e037415bbe47376f67b3d48a1cd71511224e8c1f5ec5628f" +UnitId "parallel-3.2.2.0-364aed93072c964b4e0511400336588134b34df10253608f37ea9c5831374463" +UnitId "statistics-0.16.2.1-12687f28633858c96f19394660d2d8bc2911dbec1f39ea8a7523ed5b33b497c8" +UnitId "criterion-1.6.3.0-e446ad49c8fe63c8b5dec3771fef0994c473d7aa272d73290a32ea2eddde966b" +UnitId "criterion-1.6.3.0-e-criterion-report-3dcb04787888cd7471e1c26e6353b49b5455524f970b4cea7f99cca185b47979" +UnitId "transformers-base-0.4.6-a75b623afb29f9b462d935e7d25d008a6002a9c4edcf92ab2c17fb7a0c569dd7" +UnitId "monad-control-1.0.3.1-66790eec955cd825a2bd55d84baef2a84918f590531b6779702c93b6b393ff90" +UnitId "safe-exceptions-0.1.7.4-f07efcd486b7f0bb86d7fc2ced3c662998633ad5093c29150253f9725f2114c9" +UnitId "strict-mutable-base-1.1.0.0-69fc58f5df44bacf4d0526ca3ab732b430356c1dd62392e9d7931f5a89d1cbc1" +UnitId "effectful-core-2.4.0.0-95e97d33981dba6ac271fee73cdb3d92b0e8f6d1b947aa5360dcae3a686d23dc" +UnitId "unliftio-0.2.25.0-2889934ffdd4aba6529610127833bf1ad735712981ac91c879748bf50fe437b1" +UnitId "effectful-2.4.0.0-c5d9f86654ce4d3a54dc5a6303725b234b0544a7fdbde3d0bad7118bb584e9da" +UnitId "ghc-boot-9.4.8" +UnitId "ghc-heap-9.4.8" +UnitId "ghci-9.4.8" +UnitId "hpc-0.6.1.0" +UnitId "terminfo-0.4.1.5" +UnitId "ghc-9.4.8" +UnitId "effectful-plugin-1.1.0.4-8b0295846c35d62bb8e71f91cc77e18dd11f4a7075037031e628ebfe49ae42fc" +UnitId "effectful-th-1.0.0.3-0c0821739ba9fa177d632c095106cc0891b1a37ed8bbfec94502e45e093bae0e" +UnitId "extra-1.8-7422f8ec2eaa18266573784c243a393b6182395d5820a373e38fcd69eb34e31c" +UnitId "file-embed-0.0.16.0-6613e4eb8a47080105976fe2b81a42b0d9fd08b15f6ec50f2f461a5b056e8a43" +UnitId "gitrev-1.3.1-7c995fe6220594860b1959319fa4d9eecc370436c257bbf7924333088009d522" +UnitId "haskeline-0.8.2" +UnitId "haskell-lexer-1.1.1-40e9b4768cacabd45f70a98932d218392048d92e0022a9168a0440910c5683b7" +UnitId "mmorph-1.2.0-3dfdfc92dee08f081e43884ee7314e7d5ab0afbd96369761deaf67584ab2fafc" +UnitId "semigroups-0.20-a463de7bb2be24e7b9e686e5cd8133bb28aefa7a8eb4eb3d249bb753286ebb39" +UnitId "log-base-0.12.0.1-623fe096c2c045e5aff1cfe0bbe7699b8b6a84d2f9ffa9f207d26400294413d5" +UnitId "log-effectful-1.0.0.0-3abeed6a27610fe0c8372b0e3d6bbd73455b2df59c02efc74e2d7c593fd34264" +UnitId "parser-combinators-1.3.0-1952f16d594dbe94dfbf901b1bc1ac212d3e1bc2beb45813855f21c09a66323f" +UnitId "megaparsec-9.6.1-658bb65843e158f936ffbf5c1c6cf97a54f2978633e8d4499ed220f588e200a1" +UnitId "neat-interpolation-0.5.1.4-47bb24bb2ed2c51f7cb8214a73602ec66f7bc49ea0d9622a26499e3e76be1d5f" +UnitId "safe-0.3.21-f381d8ee822c09d490211eff2e73b9c366126c0efb34873f37bf370dba1dfc88" +UnitId "pager-0.1.1.0-d1792f434a9c0b740d8b2c7c24243047af131eedcfdce499d2eff0e4a7f3c27f" +UnitId "path-0.9.5-bbf366f7f1445d2a9f9c73c13fafcd3ee3bf1f846a287ebf1e76ae2da7a10973" +UnitId "temporary-1.3-3dac72ec2334f77ab98ed4e09a78dc0972e303556f455c8812cd74573d7c7bc0" +UnitId "unix-compat-0.7.3-8689bbe43cbf6e2386335eef214a5d7d99af3e35a678dc1b5beafacb03bc836e" +UnitId "path-io-1.8.2-adb910b421dd5754dc2c717a791ebc9dd85ff583076a386b66425a309ed760e1" +UnitId "microlens-0.4.13.1-6b11272fafed215cba7fb88000aa50643abc97dcbf5448d13b7b7d25b744d472" +UnitId "parsers-0.12.11-6f5c8fdde76e8cafb2819c384b6f16ea9baa65ed62108f5ac609b3c0434d6f2e" +UnitId "radixtree-0.6.0.0-70f2e43d23ea34bb7995630a7022ed3e42756d11a88a70e409accfb201c81315" +UnitId "resourcet-effectful-1.0.1.0-219c20775d266746711cd173d4866401ffb39287952627b305b56083db015ef5" +UnitId "terminal-size-0.3.4-d3d731a69995590de5e573de4c4b26a3f86b1785463e683e2ef206fc86744d0e" +UnitId "text-rope-0.3-d6209138333196f7c0093924eca9cf7073581bcd4f07af5ad8df0a1595922aa1" +UnitId "selective-0.7.0.1-572557e30f79d97b1c884f826cfe75937cbff8e16ffd6e76d451a70293c4a0d5" +UnitId "validation-selective-0.2.0.0-23f79e25a9da8e5a6649a81b449c8c0357cf390b7705fc9cc7522a7515c7cf27" +UnitId "tomland-1.3.3.3-2a74e99e8de98327d72d4ba488bb1285b676522183c07095ca8f88a6756cc409" +UnitId "hibet-1.4.0-inplace" +UnitId "hibet-1.4.0-inplace-hibet" +UnitId "hibet-1.4.0-inplace-hibet-benchmark" +UnitId "hspec-expectations-0.8.4-fb37f9e911b287e4b22bcdcc0420d058150de2338ab517c7a5f3843c64dba5ed" +UnitId "quickcheck-io-0.2.0-6a2a99069c10315fe637054647568f4d7fb1af45de8c9dae1b783a7e33724463" +UnitId "tf-random-0.5-68231bf16ee72d6c90671b0af3556b7a25ae7195e9ce9519b06d0cfa017441a3" +UnitId "hspec-core-2.11.9-8dcff20c5003014fbf27f66277526c9273181595a704c24581f531584a6d203b" +UnitId "hspec-discover-2.11.9-e3c412fcca6379fdf744da966055b22e3ca5e325cf81172a809fca11b4462637" +UnitId "hspec-2.11.9-e4e50bcfa1893d3ed7bb8b99c1fa4ae6cdf67b699bf74181a44e2c252af11611" +UnitId "hibet-1.4.0-inplace-hibet-env" +UnitId "hibet-1.4.0-inplace-hibet-labels" +UnitId "hibet-1.4.0-inplace-hibet-parse" +UnitId "hibet-1.4.0-inplace-hibet-pretty" +UnitId "hspec-discover-2.11.9-e-hspec-discover-30dd77a765061f7d963f021ced47cf487ea350fb89c45fdc1a6161a74379cace" +UnitId "pager-0.1.1.0-e-hs-pager-test-pager-d49ceb562f84f7be8d5416deb24bb16b2f0b2f6f287dc9df742bd25feb83b90a" + +Direct deps +~~~~~~~~~~~ + +PkgId (PkgName "hibet") (Ver [1,4,0]) +CompNameLib + base-4.17.2.1 + bytestring-0.11.5.3 + containers-0.6.7 + deepseq-1.4.8.0 + directory-1.3.7.1 + effectful-2.4.0.0 + effectful-core-2.4.0.0 + effectful-plugin-1.1.0.4 + effectful-th-1.0.0.3 + extra-1.8 + filepath-1.4.2.2 + gitrev-1.3.1 + hashable-1.4.7.0 + haskeline-0.8.2 + log-effectful-1.0.0.0 + megaparsec-9.6.1 + neat-interpolation-0.5.1.4 + optparse-applicative-0.18.1.0 + pager-0.1.1.0 + parallel-3.2.2.0 + path-0.9.5 + path-io-1.8.2 + prettyprinter-1.7.1 + prettyprinter-ansi-terminal-1.1.3 + radixtree-0.6.0.0 + resourcet-effectful-1.0.1.0 + terminal-size-0.3.4 + text-2.0.2 + text-rope-0.3 + tomland-1.3.3.3 + unordered-containers-0.2.20 + +PkgId (PkgName "hibet") (Ver [1,4,0]) +CompNameExe "hibet" + base-4.17.2.1 + hibet-1.4.0 + +PkgId (PkgName "hibet") (Ver [1,4,0]) +CompNameBench "hibet-benchmark" + base-4.17.2.1 + bytestring-0.11.5.3 + criterion-1.6.3.0 + file-embed-0.0.16.0 + hibet-1.4.0 + path-0.9.5 + path-io-1.8.2 + text-2.0.2 + text-rope-0.3 + +PkgId (PkgName "hibet") (Ver [1,4,0]) +CompNameTest "hibet-env" + base-4.17.2.1 + bytestring-0.11.5.3 + containers-0.6.7 + effectful-core-2.4.0.0 + hibet-1.4.0 + hspec-2.11.9 + text-2.0.2 + unordered-containers-0.2.20 + +PkgId (PkgName "hibet") (Ver [1,4,0]) +CompNameTest "hibet-labels" + base-4.17.2.1 + bytestring-0.11.5.3 + containers-0.6.7 + hibet-1.4.0 + hspec-2.11.9 + +PkgId (PkgName "hibet") (Ver [1,4,0]) +CompNameTest "hibet-parse" + base-4.17.2.1 + hibet-1.4.0 + hspec-2.11.9 + +PkgId (PkgName "hibet") (Ver [1,4,0]) +CompNameTest "hibet-pretty" + base-4.17.2.1 + hibet-1.4.0 + hspec-2.11.9 + prettyprinter-1.7.1 + diff --git a/hibet.cabal b/hibet.cabal index 87f3739..7ca54de 100644 --- a/hibet.cabal +++ b/hibet.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: hibet -version: 1.3.8 +version: 1.4.0 description: tibetan-english translator synopsis: translator homepage: https://github.com/willbasky/Hibet diff --git a/src/App.hs b/src/App.hs index a4d59ca..6aecd31 100644 --- a/src/App.hs +++ b/src/App.hs @@ -20,7 +20,7 @@ import Effectful.Error.Static ( CallStack, prettyCallStack, Error, runError ) import Effectful.Concurrent ( runConcurrent, Concurrent ) import Effectful.Concurrent.Async (withAsync) -import Effectful.Concurrent.MVar.Strict ( MVar, newEmptyMVar, putMVar ) +import Effectful.Concurrent.MVar ( MVar, newEmptyMVar, putMVar ) import Effectful.Reader.Dynamic ( runReader ) import Effectful.Resource ( runResource, Resource ) import Effectful.Log diff --git a/src/Cli.hs b/src/Cli.hs index 1a966fc..7ad8f18 100644 --- a/src/Cli.hs +++ b/src/Cli.hs @@ -35,7 +35,7 @@ import Effectful ( type (:>), Eff, IOE ) import Effectful.Resource ( Resource ) -- import Effectful.Log ( Log ) import Effectful.Reader.Dynamic (Reader) -import Effectful.Concurrent.MVar.Strict (MVar, Concurrent) +import Effectful.Concurrent.MVar (MVar, Concurrent) -- import Polysemy.Trace (Trace) diff --git a/src/Env.hs b/src/Env.hs index 1e497be..499ab79 100644 --- a/src/Env.hs +++ b/src/Env.hs @@ -32,7 +32,7 @@ import Effectful ( type (:>), Eff ) import Effectful.Error.Static ( Error, throwError ) import Effectful.Concurrent (Concurrent) import Effectful.Reader.Dynamic (Reader) -import Effectful.Concurrent.MVar.Strict (MVar, modifyMVar_, readMVar, putMVar) +import Effectful.Concurrent.MVar (MVar, modifyMVar_, readMVar, putMVar) import Effectful.Reader.Dynamic (ask) -- fo debug diff --git a/src/Translator.hs b/src/Translator.hs index c8d0e70..6f031d3 100644 --- a/src/Translator.hs +++ b/src/Translator.hs @@ -33,7 +33,7 @@ import Effectful ( type (:>), Eff, IOE ) import Effectful.Resource ( allocate, release, Resource ) -- import Effectful.Log ( logInfo_, Log ) import Effectful.Reader.Dynamic (Reader) -import Effectful.Concurrent.MVar.Strict (MVar, Concurrent) +import Effectful.Concurrent.MVar (MVar, Concurrent) -- | Load environment and start loop dialog From d80a5a38f5749bc225755fb5042d2d8cc994c64b Mon Sep 17 00:00:00 2001 From: Vladislav Sabanov Date: Mon, 21 Oct 2024 20:55:34 -0300 Subject: [PATCH 13/15] Fix tests --- cabal-plan.log | 1289 ---------------------------------------------- hibet.cabal | 2 - test/env/Main.hs | 43 +- 3 files changed, 21 insertions(+), 1313 deletions(-) delete mode 100644 cabal-plan.log diff --git a/cabal-plan.log b/cabal-plan.log deleted file mode 100644 index 2bbfe16..0000000 --- a/cabal-plan.log +++ /dev/null @@ -1,1289 +0,0 @@ -using '/home/metaxis/source/haskell/hibet' as project root - -Tree -~~~~ - -aeson-pretty-0.8.10 - [aeson-pretty-0.8.10:exe:"aeson-pretty"] - ├─ aeson-2.2.3.0 - │ ├─ OneTuple-0.4.2 - │ │ ├─ base-4.17.2.1 - │ │ │ ├─ ghc-bignum-1.3 - │ │ │ │ └─ ghc-prim-0.9.1 - │ │ │ │ └─ rts-1.0.2 - │ │ │ ├─ ghc-prim-0.9.1 ┄┄ - │ │ │ └─ rts-1.0.2 ┄┄ - │ │ ├─ ghc-prim-0.9.1 ┄┄ - │ │ └─ template-haskell-2.19.0.0 - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ ghc-boot-th-9.4.8 - │ │ │ └─ base-4.17.2.1 ┄┄ - │ │ ├─ ghc-prim-0.9.1 ┄┄ - │ │ └─ pretty-1.1.3.6 - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ deepseq-1.4.8.0 - │ │ │ ├─ array-0.5.4.0 - │ │ │ │ └─ base-4.17.2.1 ┄┄ - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ └─ ghc-prim-0.9.1 ┄┄ - │ │ └─ ghc-prim-0.9.1 ┄┄ - │ ├─ QuickCheck-2.15.0.1 - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ containers-0.6.7 - │ │ │ ├─ array-0.5.4.0 ┄┄ - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ │ └─ template-haskell-2.19.0.0 ┄┄ - │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ ├─ random-1.2.1.2 - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ ├─ bytestring-0.11.5.3 - │ │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ │ │ ├─ ghc-prim-0.9.1 ┄┄ - │ │ │ │ └─ template-haskell-2.19.0.0 ┄┄ - │ │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ │ ├─ mtl-2.2.2 - │ │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ │ └─ transformers-0.5.6.2 - │ │ │ │ └─ base-4.17.2.1 ┄┄ - │ │ │ └─ splitmix-0.1.0.5 - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ └─ deepseq-1.4.8.0 ┄┄ - │ │ ├─ splitmix-0.1.0.5 ┄┄ - │ │ ├─ template-haskell-2.19.0.0 ┄┄ - │ │ └─ transformers-0.5.6.2 ┄┄ - │ ├─ base-4.17.2.1 ┄┄ - │ ├─ bytestring-0.11.5.3 ┄┄ - │ ├─ character-ps-0.1 - │ │ └─ base-4.17.2.1 ┄┄ - │ ├─ containers-0.6.7 ┄┄ - │ ├─ data-fix-0.3.4 - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ └─ hashable-1.4.7.0 - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ bytestring-0.11.5.3 ┄┄ - │ │ ├─ containers-0.6.7 ┄┄ - │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ ├─ filepath-1.4.2.2 - │ │ │ └─ base-4.17.2.1 ┄┄ - │ │ ├─ ghc-bignum-1.3 ┄┄ - │ │ ├─ ghc-prim-0.9.1 ┄┄ - │ │ ├─ os-string-2.0.6 - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ ├─ bytestring-0.11.5.3 ┄┄ - │ │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ │ ├─ exceptions-0.10.5 - │ │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ │ ├─ mtl-2.2.2 ┄┄ - │ │ │ │ ├─ stm-2.5.1.0 - │ │ │ │ │ ├─ array-0.5.4.0 ┄┄ - │ │ │ │ │ └─ base-4.17.2.1 ┄┄ - │ │ │ │ ├─ template-haskell-2.19.0.0 ┄┄ - │ │ │ │ └─ transformers-0.5.6.2 ┄┄ - │ │ │ └─ template-haskell-2.19.0.0 ┄┄ - │ │ └─ text-2.0.2 - │ │ ├─ array-0.5.4.0 ┄┄ - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ binary-0.8.9.1 - │ │ │ ├─ array-0.5.4.0 ┄┄ - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ ├─ bytestring-0.11.5.3 ┄┄ - │ │ │ └─ containers-0.6.7 ┄┄ - │ │ ├─ bytestring-0.11.5.3 ┄┄ - │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ ├─ ghc-prim-0.9.1 ┄┄ - │ │ └─ template-haskell-2.19.0.0 ┄┄ - │ ├─ deepseq-1.4.8.0 ┄┄ - │ ├─ dlist-1.0 - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ └─ deepseq-1.4.8.0 ┄┄ - │ ├─ exceptions-0.10.5 ┄┄ - │ ├─ generically-0.1.1 - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ └─ base-orphans-0.9.2 - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ └─ ghc-prim-0.9.1 ┄┄ - │ ├─ ghc-prim-0.9.1 ┄┄ - │ ├─ hashable-1.4.7.0 ┄┄ - │ ├─ indexed-traversable-0.1.4 - │ │ ├─ array-0.5.4.0 ┄┄ - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ containers-0.6.7 ┄┄ - │ │ ├─ foldable1-classes-compat-0.1 - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ ├─ containers-0.6.7 ┄┄ - │ │ │ ├─ ghc-prim-0.9.1 ┄┄ - │ │ │ ├─ tagged-0.8.8 - │ │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ │ │ ├─ template-haskell-2.19.0.0 ┄┄ - │ │ │ │ └─ transformers-0.5.6.2 ┄┄ - │ │ │ └─ transformers-0.5.6.2 ┄┄ - │ │ └─ transformers-0.5.6.2 ┄┄ - │ ├─ integer-conversion-0.1.1 - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ bytestring-0.11.5.3 ┄┄ - │ │ ├─ primitive-0.9.0.0 - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ │ ├─ template-haskell-2.19.0.0 ┄┄ - │ │ │ └─ transformers-0.5.6.2 ┄┄ - │ │ └─ text-2.0.2 ┄┄ - │ ├─ integer-logarithms-1.0.3.1 - │ │ ├─ array-0.5.4.0 ┄┄ - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ ghc-bignum-1.3 ┄┄ - │ │ └─ ghc-prim-0.9.1 ┄┄ - │ ├─ network-uri-2.6.4.2 - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ ├─ parsec-3.1.16.1 - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ ├─ bytestring-0.11.5.3 ┄┄ - │ │ │ ├─ mtl-2.2.2 ┄┄ - │ │ │ └─ text-2.0.2 ┄┄ - │ │ ├─ template-haskell-2.19.0.0 ┄┄ - │ │ └─ th-compat-0.1.5 - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ └─ template-haskell-2.19.0.0 ┄┄ - │ ├─ primitive-0.9.0.0 ┄┄ - │ ├─ scientific-0.3.8.0 - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ binary-0.8.9.1 ┄┄ - │ │ ├─ bytestring-0.11.5.3 ┄┄ - │ │ ├─ containers-0.6.7 ┄┄ - │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ ├─ hashable-1.4.7.0 ┄┄ - │ │ ├─ integer-logarithms-1.0.3.1 ┄┄ - │ │ ├─ primitive-0.9.0.0 ┄┄ - │ │ ├─ template-haskell-2.19.0.0 ┄┄ - │ │ └─ text-2.0.2 ┄┄ - │ ├─ semialign-1.3.1 - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ containers-0.6.7 ┄┄ - │ │ ├─ hashable-1.4.7.0 ┄┄ - │ │ ├─ indexed-traversable-0.1.4 ┄┄ - │ │ ├─ indexed-traversable-instances-0.1.2 - │ │ │ ├─ OneTuple-0.4.2 ┄┄ - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ ├─ indexed-traversable-0.1.4 ┄┄ - │ │ │ ├─ tagged-0.8.8 ┄┄ - │ │ │ ├─ unordered-containers-0.2.20 - │ │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ │ │ ├─ hashable-1.4.7.0 ┄┄ - │ │ │ │ └─ template-haskell-2.19.0.0 ┄┄ - │ │ │ └─ vector-0.13.1.0 - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ │ ├─ primitive-0.9.0.0 ┄┄ - │ │ │ └─ vector-stream-0.1.0.1 - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ └─ ghc-prim-0.9.1 ┄┄ - │ │ ├─ semigroupoids-6.0.1 - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ ├─ base-orphans-0.9.2 ┄┄ - │ │ │ ├─ bifunctors-5.6.2 - │ │ │ │ ├─ assoc-1.1.1 - │ │ │ │ │ └─ base-4.17.2.1 ┄┄ - │ │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ │ ├─ comonad-5.0.8 - │ │ │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ │ │ ├─ containers-0.6.7 ┄┄ - │ │ │ │ │ ├─ distributive-0.6.2.1 - │ │ │ │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ │ │ │ ├─ base-orphans-0.9.2 ┄┄ - │ │ │ │ │ │ ├─ tagged-0.8.8 ┄┄ - │ │ │ │ │ │ └─ transformers-0.5.6.2 ┄┄ - │ │ │ │ │ ├─ indexed-traversable-0.1.4 ┄┄ - │ │ │ │ │ ├─ tagged-0.8.8 ┄┄ - │ │ │ │ │ ├─ transformers-0.5.6.2 ┄┄ - │ │ │ │ │ └─ transformers-compat-0.7.2 - │ │ │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ │ │ ├─ ghc-prim-0.9.1 ┄┄ - │ │ │ │ │ └─ transformers-0.5.6.2 ┄┄ - │ │ │ │ ├─ containers-0.6.7 ┄┄ - │ │ │ │ ├─ foldable1-classes-compat-0.1 ┄┄ - │ │ │ │ ├─ tagged-0.8.8 ┄┄ - │ │ │ │ ├─ template-haskell-2.19.0.0 ┄┄ - │ │ │ │ ├─ th-abstraction-0.7.0.0 - │ │ │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ │ │ ├─ containers-0.6.7 ┄┄ - │ │ │ │ │ ├─ ghc-prim-0.9.1 ┄┄ - │ │ │ │ │ └─ template-haskell-2.19.0.0 ┄┄ - │ │ │ │ └─ transformers-0.5.6.2 ┄┄ - │ │ │ ├─ comonad-5.0.8 ┄┄ - │ │ │ ├─ containers-0.6.7 ┄┄ - │ │ │ ├─ contravariant-1.5.5 - │ │ │ │ ├─ StateVar-1.2.2 - │ │ │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ │ │ ├─ stm-2.5.1.0 ┄┄ - │ │ │ │ │ └─ transformers-0.5.6.2 ┄┄ - │ │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ │ └─ transformers-0.5.6.2 ┄┄ - │ │ │ ├─ distributive-0.6.2.1 ┄┄ - │ │ │ ├─ foldable1-classes-compat-0.1 ┄┄ - │ │ │ ├─ hashable-1.4.7.0 ┄┄ - │ │ │ ├─ tagged-0.8.8 ┄┄ - │ │ │ ├─ template-haskell-2.19.0.0 ┄┄ - │ │ │ ├─ transformers-0.5.6.2 ┄┄ - │ │ │ ├─ transformers-compat-0.7.2 ┄┄ - │ │ │ └─ unordered-containers-0.2.20 ┄┄ - │ │ ├─ tagged-0.8.8 ┄┄ - │ │ ├─ these-1.2.1 - │ │ │ ├─ assoc-1.1.1 ┄┄ - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ ├─ binary-0.8.9.1 ┄┄ - │ │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ │ ├─ foldable1-classes-compat-0.1 ┄┄ - │ │ │ └─ hashable-1.4.7.0 ┄┄ - │ │ ├─ transformers-0.5.6.2 ┄┄ - │ │ ├─ unordered-containers-0.2.20 ┄┄ - │ │ └─ vector-0.13.1.0 ┄┄ - │ ├─ strict-0.5.1 - │ │ ├─ assoc-1.1.1 ┄┄ - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ binary-0.8.9.1 ┄┄ - │ │ ├─ bytestring-0.11.5.3 ┄┄ - │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ ├─ ghc-prim-0.9.1 ┄┄ - │ │ ├─ hashable-1.4.7.0 ┄┄ - │ │ ├─ text-2.0.2 ┄┄ - │ │ ├─ these-1.2.1 ┄┄ - │ │ └─ transformers-0.5.6.2 ┄┄ - │ ├─ tagged-0.8.8 ┄┄ - │ ├─ template-haskell-2.19.0.0 ┄┄ - │ ├─ text-2.0.2 ┄┄ - │ ├─ text-iso8601-0.1.1 - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ integer-conversion-0.1.1 ┄┄ - │ │ ├─ text-2.0.2 ┄┄ - │ │ ├─ time-1.12.2 - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ └─ deepseq-1.4.8.0 ┄┄ - │ │ └─ time-compat-1.9.7 - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ base-orphans-0.9.2 ┄┄ - │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ ├─ hashable-1.4.7.0 ┄┄ - │ │ └─ time-1.12.2 ┄┄ - │ ├─ text-short-0.1.6 - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ binary-0.8.9.1 ┄┄ - │ │ ├─ bytestring-0.11.5.3 ┄┄ - │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ ├─ ghc-prim-0.9.1 ┄┄ - │ │ ├─ hashable-1.4.7.0 ┄┄ - │ │ ├─ template-haskell-2.19.0.0 ┄┄ - │ │ └─ text-2.0.2 ┄┄ - │ ├─ th-abstraction-0.7.0.0 ┄┄ - │ ├─ these-1.2.1 ┄┄ - │ ├─ time-1.12.2 ┄┄ - │ ├─ time-compat-1.9.7 ┄┄ - │ ├─ unordered-containers-0.2.20 ┄┄ - │ ├─ uuid-types-1.0.6 - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ binary-0.8.9.1 ┄┄ - │ │ ├─ bytestring-0.11.5.3 ┄┄ - │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ ├─ hashable-1.4.7.0 ┄┄ - │ │ ├─ random-1.2.1.2 ┄┄ - │ │ ├─ template-haskell-2.19.0.0 ┄┄ - │ │ └─ text-2.0.2 ┄┄ - │ ├─ vector-0.13.1.0 ┄┄ - │ └─ witherable-0.5 - │ ├─ base-4.17.2.1 ┄┄ - │ ├─ base-orphans-0.9.2 ┄┄ - │ ├─ containers-0.6.7 ┄┄ - │ ├─ hashable-1.4.7.0 ┄┄ - │ ├─ indexed-traversable-0.1.4 ┄┄ - │ ├─ indexed-traversable-instances-0.1.2 ┄┄ - │ ├─ transformers-0.5.6.2 ┄┄ - │ ├─ unordered-containers-0.2.20 ┄┄ - │ └─ vector-0.13.1.0 ┄┄ - ├─ aeson-pretty-0.8.10 - │ ├─ aeson-2.2.3.0 ┄┄ - │ ├─ base-4.17.2.1 ┄┄ - │ ├─ base-compat-0.14.0 - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ ghc-prim-0.9.1 ┄┄ - │ │ └─ unix-2.7.3 - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ bytestring-0.11.5.3 ┄┄ - │ │ └─ time-1.12.2 ┄┄ - │ ├─ bytestring-0.11.5.3 ┄┄ - │ ├─ scientific-0.3.8.0 ┄┄ - │ ├─ text-2.0.2 ┄┄ - │ ├─ unordered-containers-0.2.20 ┄┄ - │ └─ vector-0.13.1.0 ┄┄ - ├─ attoparsec-0.14.4 - │ ├─ array-0.5.4.0 ┄┄ - │ ├─ attoparsec-0.14.4 - │ │ [attoparsec-0.14.4:lib:"attoparsec-internal"] - │ │ ├─ array-0.5.4.0 ┄┄ - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ bytestring-0.11.5.3 ┄┄ - │ │ └─ text-2.0.2 ┄┄ - │ ├─ base-4.17.2.1 ┄┄ - │ ├─ bytestring-0.11.5.3 ┄┄ - │ ├─ containers-0.6.7 ┄┄ - │ ├─ deepseq-1.4.8.0 ┄┄ - │ ├─ ghc-prim-0.9.1 ┄┄ - │ ├─ scientific-0.3.8.0 ┄┄ - │ ├─ text-2.0.2 ┄┄ - │ └─ transformers-0.5.6.2 ┄┄ - ├─ attoparsec-aeson-2.2.2.0 - │ ├─ aeson-2.2.3.0 ┄┄ - │ ├─ attoparsec-0.14.4 ┄┄ - │ ├─ base-4.17.2.1 ┄┄ - │ ├─ bytestring-0.11.5.3 ┄┄ - │ ├─ character-ps-0.1 ┄┄ - │ ├─ integer-conversion-0.1.1 ┄┄ - │ ├─ primitive-0.9.0.0 ┄┄ - │ ├─ scientific-0.3.8.0 ┄┄ - │ ├─ text-2.0.2 ┄┄ - │ └─ vector-0.13.1.0 ┄┄ - ├─ base-4.17.2.1 ┄┄ - ├─ bytestring-0.11.5.3 ┄┄ - └─ cmdargs-0.10.22 - ├─ base-4.17.2.1 ┄┄ - ├─ filepath-1.4.2.2 ┄┄ - ├─ process-1.6.18.0 - │ ├─ base-4.17.2.1 ┄┄ - │ ├─ deepseq-1.4.8.0 ┄┄ - │ ├─ directory-1.3.7.1 - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ filepath-1.4.2.2 ┄┄ - │ │ ├─ time-1.12.2 ┄┄ - │ │ └─ unix-2.7.3 ┄┄ - │ ├─ filepath-1.4.2.2 ┄┄ - │ └─ unix-2.7.3 ┄┄ - ├─ template-haskell-2.19.0.0 ┄┄ - └─ transformers-0.5.6.2 ┄┄ -criterion-1.6.3.0 - [criterion-1.6.3.0:exe:"criterion-report"] - ├─ base-4.17.2.1 ┄┄ - ├─ base-compat-batteries-0.14.0 - │ ├─ OneTuple-0.4.2 ┄┄ - │ ├─ base-4.17.2.1 ┄┄ - │ ├─ base-compat-0.14.0 ┄┄ - │ ├─ foldable1-classes-compat-0.1 ┄┄ - │ └─ ghc-prim-0.9.1 ┄┄ - ├─ criterion-1.6.3.0 - │ ├─ Glob-0.10.2 - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ containers-0.6.7 ┄┄ - │ │ ├─ directory-1.3.7.1 ┄┄ - │ │ ├─ dlist-1.0 ┄┄ - │ │ ├─ filepath-1.4.2.2 ┄┄ - │ │ ├─ transformers-0.5.6.2 ┄┄ - │ │ └─ transformers-compat-0.7.2 ┄┄ - │ ├─ aeson-2.2.3.0 ┄┄ - │ ├─ base-4.17.2.1 ┄┄ - │ ├─ base-compat-batteries-0.14.0 ┄┄ - │ ├─ binary-0.8.9.1 ┄┄ - │ ├─ binary-orphans-1.0.5 - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ └─ binary-0.8.9.1 ┄┄ - │ ├─ bytestring-0.11.5.3 ┄┄ - │ ├─ cassava-0.5.3.2 - │ │ ├─ Only-0.1 - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ └─ deepseq-1.4.8.0 ┄┄ - │ │ ├─ array-0.5.4.0 ┄┄ - │ │ ├─ attoparsec-0.14.4 ┄┄ - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ bytestring-0.11.5.3 ┄┄ - │ │ ├─ containers-0.6.7 ┄┄ - │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ ├─ hashable-1.4.7.0 ┄┄ - │ │ ├─ scientific-0.3.8.0 ┄┄ - │ │ ├─ text-2.0.2 ┄┄ - │ │ ├─ text-short-0.1.6 ┄┄ - │ │ ├─ transformers-0.5.6.2 ┄┄ - │ │ ├─ unordered-containers-0.2.20 ┄┄ - │ │ └─ vector-0.13.1.0 ┄┄ - │ ├─ code-page-0.2.1 - │ │ └─ base-4.17.2.1 ┄┄ - │ ├─ containers-0.6.7 ┄┄ - │ ├─ criterion-measurement-0.2.2.0 - │ │ ├─ aeson-2.2.3.0 ┄┄ - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ base-compat-0.14.0 ┄┄ - │ │ ├─ binary-0.8.9.1 ┄┄ - │ │ ├─ containers-0.6.7 ┄┄ - │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ ├─ ghc-prim-0.9.1 ┄┄ - │ │ └─ vector-0.13.1.0 ┄┄ - │ ├─ deepseq-1.4.8.0 ┄┄ - │ ├─ directory-1.3.7.1 ┄┄ - │ ├─ exceptions-0.10.5 ┄┄ - │ ├─ filepath-1.4.2.2 ┄┄ - │ ├─ js-chart-2.9.4.1 - │ │ └─ base-4.17.2.1 ┄┄ - │ ├─ microstache-1.0.3 - │ │ ├─ aeson-2.2.3.0 ┄┄ - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ containers-0.6.7 ┄┄ - │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ ├─ directory-1.3.7.1 ┄┄ - │ │ ├─ filepath-1.4.2.2 ┄┄ - │ │ ├─ parsec-3.1.16.1 ┄┄ - │ │ ├─ text-2.0.2 ┄┄ - │ │ ├─ transformers-0.5.6.2 ┄┄ - │ │ ├─ unordered-containers-0.2.20 ┄┄ - │ │ └─ vector-0.13.1.0 ┄┄ - │ ├─ mtl-2.2.2 ┄┄ - │ ├─ mwc-random-0.15.1.0 - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ math-functions-0.3.4.4 - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ ├─ data-default-class-0.1.2.2 - │ │ │ │ └─ base-4.17.2.1 ┄┄ - │ │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ │ ├─ primitive-0.9.0.0 ┄┄ - │ │ │ └─ vector-0.13.1.0 ┄┄ - │ │ ├─ primitive-0.9.0.0 ┄┄ - │ │ ├─ random-1.2.1.2 ┄┄ - │ │ ├─ time-1.12.2 ┄┄ - │ │ └─ vector-0.13.1.0 ┄┄ - │ ├─ optparse-applicative-0.18.1.0 - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ prettyprinter-1.7.1 - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ └─ text-2.0.2 ┄┄ - │ │ ├─ prettyprinter-ansi-terminal-1.1.3 - │ │ │ ├─ ansi-terminal-1.1.1 - │ │ │ │ ├─ ansi-terminal-types-1.1 - │ │ │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ │ │ └─ colour-2.3.6 - │ │ │ │ │ └─ base-4.17.2.1 ┄┄ - │ │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ │ └─ colour-2.3.6 ┄┄ - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ ├─ prettyprinter-1.7.1 ┄┄ - │ │ │ └─ text-2.0.2 ┄┄ - │ │ ├─ process-1.6.18.0 ┄┄ - │ │ ├─ text-2.0.2 ┄┄ - │ │ ├─ transformers-0.5.6.2 ┄┄ - │ │ └─ transformers-compat-0.7.2 ┄┄ - │ ├─ parsec-3.1.16.1 ┄┄ - │ ├─ prettyprinter-1.7.1 ┄┄ - │ ├─ prettyprinter-ansi-terminal-1.1.3 ┄┄ - │ ├─ statistics-0.16.2.1 - │ │ ├─ aeson-2.2.3.0 ┄┄ - │ │ ├─ async-2.2.5 - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ ├─ hashable-1.4.7.0 ┄┄ - │ │ │ └─ stm-2.5.1.0 ┄┄ - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ binary-0.8.9.1 ┄┄ - │ │ ├─ data-default-class-0.1.2.2 ┄┄ - │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ ├─ dense-linear-algebra-0.1.0.0 - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ │ ├─ math-functions-0.3.4.4 ┄┄ - │ │ │ ├─ primitive-0.9.0.0 ┄┄ - │ │ │ ├─ vector-0.13.1.0 ┄┄ - │ │ │ ├─ vector-algorithms-0.9.0.2 - │ │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ │ ├─ bitvec-1.1.5.0 - │ │ │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ │ │ ├─ bytestring-0.11.5.3 ┄┄ - │ │ │ │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ │ │ │ ├─ ghc-bignum-1.3 ┄┄ - │ │ │ │ │ ├─ primitive-0.9.0.0 ┄┄ - │ │ │ │ │ └─ vector-0.13.1.0 ┄┄ - │ │ │ │ ├─ bytestring-0.11.5.3 ┄┄ - │ │ │ │ ├─ primitive-0.9.0.0 ┄┄ - │ │ │ │ └─ vector-0.13.1.0 ┄┄ - │ │ │ ├─ vector-binary-instances-0.2.5.2 - │ │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ │ ├─ binary-0.8.9.1 ┄┄ - │ │ │ │ └─ vector-0.13.1.0 ┄┄ - │ │ │ └─ vector-th-unbox-0.2.2 - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ ├─ template-haskell-2.19.0.0 ┄┄ - │ │ │ └─ vector-0.13.1.0 ┄┄ - │ │ ├─ math-functions-0.3.4.4 ┄┄ - │ │ ├─ mwc-random-0.15.1.0 ┄┄ - │ │ ├─ parallel-3.2.2.0 - │ │ │ ├─ array-0.5.4.0 ┄┄ - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ ├─ containers-0.6.7 ┄┄ - │ │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ │ └─ ghc-prim-0.9.1 ┄┄ - │ │ ├─ primitive-0.9.0.0 ┄┄ - │ │ ├─ random-1.2.1.2 ┄┄ - │ │ ├─ vector-0.13.1.0 ┄┄ - │ │ ├─ vector-algorithms-0.9.0.2 ┄┄ - │ │ ├─ vector-binary-instances-0.2.5.2 ┄┄ - │ │ └─ vector-th-unbox-0.2.2 ┄┄ - │ ├─ text-2.0.2 ┄┄ - │ ├─ time-1.12.2 ┄┄ - │ ├─ transformers-0.5.6.2 ┄┄ - │ ├─ transformers-compat-0.7.2 ┄┄ - │ ├─ vector-0.13.1.0 ┄┄ - │ └─ vector-algorithms-0.9.0.2 ┄┄ - └─ optparse-applicative-0.18.1.0 ┄┄ -hibet-1.4.0 - [hibet-1.4.0:exe:"hibet"] - ├─ base-4.17.2.1 ┄┄ - └─ hibet-1.4.0 - ├─ base-4.17.2.1 ┄┄ - ├─ bytestring-0.11.5.3 ┄┄ - ├─ containers-0.6.7 ┄┄ - ├─ deepseq-1.4.8.0 ┄┄ - ├─ directory-1.3.7.1 ┄┄ - ├─ effectful-2.4.0.0 - │ ├─ async-2.2.5 ┄┄ - │ ├─ base-4.17.2.1 ┄┄ - │ ├─ bytestring-0.11.5.3 ┄┄ - │ ├─ directory-1.3.7.1 ┄┄ - │ ├─ effectful-core-2.4.0.0 - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ containers-0.6.7 ┄┄ - │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ ├─ exceptions-0.10.5 ┄┄ - │ │ ├─ monad-control-1.0.3.1 - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ ├─ stm-2.5.1.0 ┄┄ - │ │ │ ├─ transformers-0.5.6.2 ┄┄ - │ │ │ ├─ transformers-base-0.4.6 - │ │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ │ ├─ base-orphans-0.9.2 ┄┄ - │ │ │ │ ├─ stm-2.5.1.0 ┄┄ - │ │ │ │ ├─ transformers-0.5.6.2 ┄┄ - │ │ │ │ └─ transformers-compat-0.7.2 ┄┄ - │ │ │ └─ transformers-compat-0.7.2 ┄┄ - │ │ ├─ primitive-0.9.0.0 ┄┄ - │ │ ├─ safe-exceptions-0.1.7.4 - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ │ ├─ exceptions-0.10.5 ┄┄ - │ │ │ └─ transformers-0.5.6.2 ┄┄ - │ │ ├─ strict-mutable-base-1.1.0.0 - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ └─ deepseq-1.4.8.0 ┄┄ - │ │ ├─ transformers-base-0.4.6 ┄┄ - │ │ └─ unliftio-core-0.2.1.0 - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ └─ transformers-0.5.6.2 ┄┄ - │ ├─ process-1.6.18.0 ┄┄ - │ ├─ stm-2.5.1.0 ┄┄ - │ ├─ strict-mutable-base-1.1.0.0 ┄┄ - │ ├─ time-1.12.2 ┄┄ - │ └─ unliftio-0.2.25.0 - │ ├─ async-2.2.5 ┄┄ - │ ├─ base-4.17.2.1 ┄┄ - │ ├─ bytestring-0.11.5.3 ┄┄ - │ ├─ deepseq-1.4.8.0 ┄┄ - │ ├─ directory-1.3.7.1 ┄┄ - │ ├─ filepath-1.4.2.2 ┄┄ - │ ├─ process-1.6.18.0 ┄┄ - │ ├─ safe-exceptions-0.1.7.4 ┄┄ - │ ├─ stm-2.5.1.0 ┄┄ - │ ├─ time-1.12.2 ┄┄ - │ ├─ transformers-0.5.6.2 ┄┄ - │ ├─ unix-2.7.3 ┄┄ - │ └─ unliftio-core-0.2.1.0 ┄┄ - ├─ effectful-core-2.4.0.0 ┄┄ - ├─ effectful-plugin-1.1.0.4 - │ ├─ base-4.17.2.1 ┄┄ - │ ├─ containers-0.6.7 ┄┄ - │ ├─ effectful-core-2.4.0.0 ┄┄ - │ └─ ghc-9.4.8 - │ ├─ array-0.5.4.0 ┄┄ - │ ├─ base-4.17.2.1 ┄┄ - │ ├─ binary-0.8.9.1 ┄┄ - │ ├─ bytestring-0.11.5.3 ┄┄ - │ ├─ containers-0.6.7 ┄┄ - │ ├─ deepseq-1.4.8.0 ┄┄ - │ ├─ directory-1.3.7.1 ┄┄ - │ ├─ exceptions-0.10.5 ┄┄ - │ ├─ filepath-1.4.2.2 ┄┄ - │ ├─ ghc-boot-9.4.8 - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ binary-0.8.9.1 ┄┄ - │ │ ├─ bytestring-0.11.5.3 ┄┄ - │ │ ├─ containers-0.6.7 ┄┄ - │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ ├─ directory-1.3.7.1 ┄┄ - │ │ ├─ filepath-1.4.2.2 ┄┄ - │ │ ├─ ghc-boot-th-9.4.8 ┄┄ - │ │ └─ unix-2.7.3 ┄┄ - │ ├─ ghc-heap-9.4.8 - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ containers-0.6.7 ┄┄ - │ │ ├─ ghc-prim-0.9.1 ┄┄ - │ │ └─ rts-1.0.2 ┄┄ - │ ├─ ghci-9.4.8 - │ │ ├─ array-0.5.4.0 ┄┄ - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ binary-0.8.9.1 ┄┄ - │ │ ├─ bytestring-0.11.5.3 ┄┄ - │ │ ├─ containers-0.6.7 ┄┄ - │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ ├─ filepath-1.4.2.2 ┄┄ - │ │ ├─ ghc-boot-9.4.8 ┄┄ - │ │ ├─ ghc-heap-9.4.8 ┄┄ - │ │ ├─ ghc-prim-0.9.1 ┄┄ - │ │ ├─ rts-1.0.2 ┄┄ - │ │ ├─ template-haskell-2.19.0.0 ┄┄ - │ │ ├─ transformers-0.5.6.2 ┄┄ - │ │ └─ unix-2.7.3 ┄┄ - │ ├─ hpc-0.6.1.0 - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ containers-0.6.7 ┄┄ - │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ ├─ directory-1.3.7.1 ┄┄ - │ │ ├─ filepath-1.4.2.2 ┄┄ - │ │ └─ time-1.12.2 ┄┄ - │ ├─ process-1.6.18.0 ┄┄ - │ ├─ stm-2.5.1.0 ┄┄ - │ ├─ template-haskell-2.19.0.0 ┄┄ - │ ├─ terminfo-0.4.1.5 - │ │ └─ base-4.17.2.1 ┄┄ - │ ├─ time-1.12.2 ┄┄ - │ ├─ transformers-0.5.6.2 ┄┄ - │ └─ unix-2.7.3 ┄┄ - ├─ effectful-th-1.0.0.3 - │ ├─ base-4.17.2.1 ┄┄ - │ ├─ containers-0.6.7 ┄┄ - │ ├─ effectful-core-2.4.0.0 ┄┄ - │ ├─ exceptions-0.10.5 ┄┄ - │ ├─ template-haskell-2.19.0.0 ┄┄ - │ └─ th-abstraction-0.7.0.0 ┄┄ - ├─ extra-1.8 - │ ├─ base-4.17.2.1 ┄┄ - │ ├─ clock-0.8.4 - │ │ └─ base-4.17.2.1 ┄┄ - │ ├─ directory-1.3.7.1 ┄┄ - │ ├─ filepath-1.4.2.2 ┄┄ - │ ├─ process-1.6.18.0 ┄┄ - │ ├─ time-1.12.2 ┄┄ - │ └─ unix-2.7.3 ┄┄ - ├─ filepath-1.4.2.2 ┄┄ - ├─ gitrev-1.3.1 - │ ├─ base-4.17.2.1 ┄┄ - │ ├─ base-compat-0.14.0 ┄┄ - │ ├─ directory-1.3.7.1 ┄┄ - │ ├─ filepath-1.4.2.2 ┄┄ - │ ├─ process-1.6.18.0 ┄┄ - │ └─ template-haskell-2.19.0.0 ┄┄ - ├─ hashable-1.4.7.0 ┄┄ - ├─ haskeline-0.8.2 - │ ├─ base-4.17.2.1 ┄┄ - │ ├─ bytestring-0.11.5.3 ┄┄ - │ ├─ containers-0.6.7 ┄┄ - │ ├─ directory-1.3.7.1 ┄┄ - │ ├─ exceptions-0.10.5 ┄┄ - │ ├─ filepath-1.4.2.2 ┄┄ - │ ├─ process-1.6.18.0 ┄┄ - │ ├─ stm-2.5.1.0 ┄┄ - │ ├─ terminfo-0.4.1.5 ┄┄ - │ ├─ transformers-0.5.6.2 ┄┄ - │ └─ unix-2.7.3 ┄┄ - ├─ log-effectful-1.0.0.0 - │ ├─ base-4.17.2.1 ┄┄ - │ ├─ effectful-core-2.4.0.0 ┄┄ - │ ├─ log-base-0.12.0.1 - │ │ ├─ aeson-2.2.3.0 ┄┄ - │ │ ├─ aeson-pretty-0.8.10 ┄┄ - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ bytestring-0.11.5.3 ┄┄ - │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ ├─ exceptions-0.10.5 ┄┄ - │ │ ├─ mmorph-1.2.0 - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ ├─ mtl-2.2.2 ┄┄ - │ │ │ ├─ transformers-0.5.6.2 ┄┄ - │ │ │ └─ transformers-compat-0.7.2 ┄┄ - │ │ ├─ monad-control-1.0.3.1 ┄┄ - │ │ ├─ mtl-2.2.2 ┄┄ - │ │ ├─ semigroups-0.20 - │ │ │ └─ base-4.17.2.1 ┄┄ - │ │ ├─ stm-2.5.1.0 ┄┄ - │ │ ├─ text-2.0.2 ┄┄ - │ │ ├─ time-1.12.2 ┄┄ - │ │ ├─ transformers-base-0.4.6 ┄┄ - │ │ ├─ unliftio-core-0.2.1.0 ┄┄ - │ │ └─ unordered-containers-0.2.20 ┄┄ - │ ├─ text-2.0.2 ┄┄ - │ └─ time-1.12.2 ┄┄ - ├─ megaparsec-9.6.1 - │ ├─ base-4.17.2.1 ┄┄ - │ ├─ bytestring-0.11.5.3 ┄┄ - │ ├─ case-insensitive-1.2.1.0 - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ bytestring-0.11.5.3 ┄┄ - │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ ├─ hashable-1.4.7.0 ┄┄ - │ │ └─ text-2.0.2 ┄┄ - │ ├─ containers-0.6.7 ┄┄ - │ ├─ deepseq-1.4.8.0 ┄┄ - │ ├─ mtl-2.2.2 ┄┄ - │ ├─ parser-combinators-1.3.0 - │ │ └─ base-4.17.2.1 ┄┄ - │ ├─ scientific-0.3.8.0 ┄┄ - │ ├─ text-2.0.2 ┄┄ - │ └─ transformers-0.5.6.2 ┄┄ - ├─ neat-interpolation-0.5.1.4 - │ ├─ base-4.17.2.1 ┄┄ - │ ├─ megaparsec-9.6.1 ┄┄ - │ ├─ template-haskell-2.19.0.0 ┄┄ - │ └─ text-2.0.2 ┄┄ - ├─ optparse-applicative-0.18.1.0 ┄┄ - ├─ pager-0.1.1.0 - │ ├─ base-4.17.2.1 ┄┄ - │ ├─ bytestring-0.11.5.3 ┄┄ - │ ├─ conduit-1.3.6 - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ bytestring-0.11.5.3 ┄┄ - │ │ ├─ directory-1.3.7.1 ┄┄ - │ │ ├─ exceptions-0.10.5 ┄┄ - │ │ ├─ filepath-1.4.2.2 ┄┄ - │ │ ├─ mono-traversable-1.0.20.0 - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ ├─ bytestring-0.11.5.3 ┄┄ - │ │ │ ├─ containers-0.6.7 ┄┄ - │ │ │ ├─ hashable-1.4.7.0 ┄┄ - │ │ │ ├─ split-0.2.5 - │ │ │ │ └─ base-4.17.2.1 ┄┄ - │ │ │ ├─ text-2.0.2 ┄┄ - │ │ │ ├─ transformers-0.5.6.2 ┄┄ - │ │ │ ├─ unordered-containers-0.2.20 ┄┄ - │ │ │ ├─ vector-0.13.1.0 ┄┄ - │ │ │ └─ vector-algorithms-0.9.0.2 ┄┄ - │ │ ├─ mtl-2.2.2 ┄┄ - │ │ ├─ primitive-0.9.0.0 ┄┄ - │ │ ├─ resourcet-1.3.0 - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ ├─ containers-0.6.7 ┄┄ - │ │ │ ├─ exceptions-0.10.5 ┄┄ - │ │ │ ├─ mtl-2.2.2 ┄┄ - │ │ │ ├─ primitive-0.9.0.0 ┄┄ - │ │ │ ├─ transformers-0.5.6.2 ┄┄ - │ │ │ └─ unliftio-core-0.2.1.0 ┄┄ - │ │ ├─ text-2.0.2 ┄┄ - │ │ ├─ transformers-0.5.6.2 ┄┄ - │ │ ├─ unix-2.7.3 ┄┄ - │ │ ├─ unliftio-core-0.2.1.0 ┄┄ - │ │ └─ vector-0.13.1.0 ┄┄ - │ ├─ conduit-extra-1.3.6 - │ │ ├─ async-2.2.5 ┄┄ - │ │ ├─ attoparsec-0.14.4 ┄┄ - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ bytestring-0.11.5.3 ┄┄ - │ │ ├─ conduit-1.3.6 ┄┄ - │ │ ├─ directory-1.3.7.1 ┄┄ - │ │ ├─ filepath-1.4.2.2 ┄┄ - │ │ ├─ network-3.2.4.0 - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ ├─ bytestring-0.11.5.3 ┄┄ - │ │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ │ ├─ directory-1.3.7.1 ┄┄ - │ │ │ └─ stm-2.5.1.0 ┄┄ - │ │ ├─ primitive-0.9.0.0 ┄┄ - │ │ ├─ process-1.6.18.0 ┄┄ - │ │ ├─ resourcet-1.3.0 ┄┄ - │ │ ├─ stm-2.5.1.0 ┄┄ - │ │ ├─ streaming-commons-0.2.2.6 - │ │ │ ├─ array-0.5.4.0 ┄┄ - │ │ │ ├─ async-2.2.5 ┄┄ - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ ├─ bytestring-0.11.5.3 ┄┄ - │ │ │ ├─ directory-1.3.7.1 ┄┄ - │ │ │ ├─ network-3.2.4.0 ┄┄ - │ │ │ ├─ process-1.6.18.0 ┄┄ - │ │ │ ├─ random-1.2.1.2 ┄┄ - │ │ │ ├─ stm-2.5.1.0 ┄┄ - │ │ │ ├─ text-2.0.2 ┄┄ - │ │ │ ├─ transformers-0.5.6.2 ┄┄ - │ │ │ ├─ unix-2.7.3 ┄┄ - │ │ │ └─ zlib-0.7.1.0 - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ └─ bytestring-0.11.5.3 ┄┄ - │ │ ├─ text-2.0.2 ┄┄ - │ │ ├─ transformers-0.5.6.2 ┄┄ - │ │ ├─ typed-process-0.2.12.0 - │ │ │ ├─ async-2.2.5 ┄┄ - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ ├─ bytestring-0.11.5.3 ┄┄ - │ │ │ ├─ process-1.6.18.0 ┄┄ - │ │ │ ├─ stm-2.5.1.0 ┄┄ - │ │ │ ├─ transformers-0.5.6.2 ┄┄ - │ │ │ └─ unliftio-core-0.2.1.0 ┄┄ - │ │ └─ unliftio-core-0.2.1.0 ┄┄ - │ ├─ directory-1.3.7.1 ┄┄ - │ ├─ process-1.6.18.0 ┄┄ - │ ├─ resourcet-1.3.0 ┄┄ - │ ├─ safe-0.3.21 - │ │ └─ base-4.17.2.1 ┄┄ - │ ├─ terminfo-0.4.1.5 ┄┄ - │ ├─ text-2.0.2 ┄┄ - │ ├─ transformers-0.5.6.2 ┄┄ - │ └─ unix-2.7.3 ┄┄ - ├─ parallel-3.2.2.0 ┄┄ - ├─ path-0.9.5 - │ ├─ aeson-2.2.3.0 ┄┄ - │ ├─ base-4.17.2.1 ┄┄ - │ ├─ deepseq-1.4.8.0 ┄┄ - │ ├─ exceptions-0.10.5 ┄┄ - │ ├─ filepath-1.4.2.2 ┄┄ - │ ├─ hashable-1.4.7.0 ┄┄ - │ ├─ template-haskell-2.19.0.0 ┄┄ - │ └─ text-2.0.2 ┄┄ - ├─ path-io-1.8.2 - │ ├─ base-4.17.2.1 ┄┄ - │ ├─ containers-0.6.7 ┄┄ - │ ├─ directory-1.3.7.1 ┄┄ - │ ├─ dlist-1.0 ┄┄ - │ ├─ exceptions-0.10.5 ┄┄ - │ ├─ filepath-1.4.2.2 ┄┄ - │ ├─ path-0.9.5 ┄┄ - │ ├─ temporary-1.3 - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ directory-1.3.7.1 ┄┄ - │ │ ├─ exceptions-0.10.5 ┄┄ - │ │ ├─ filepath-1.4.2.2 ┄┄ - │ │ ├─ random-1.2.1.2 ┄┄ - │ │ ├─ transformers-0.5.6.2 ┄┄ - │ │ └─ unix-2.7.3 ┄┄ - │ ├─ time-1.12.2 ┄┄ - │ ├─ transformers-0.5.6.2 ┄┄ - │ └─ unix-compat-0.7.3 - │ ├─ base-4.17.2.1 ┄┄ - │ └─ unix-2.7.3 ┄┄ - ├─ prettyprinter-1.7.1 ┄┄ - ├─ prettyprinter-ansi-terminal-1.1.3 ┄┄ - ├─ radixtree-0.6.0.0 - │ ├─ base-4.17.2.1 ┄┄ - │ ├─ containers-0.6.7 ┄┄ - │ ├─ deepseq-1.4.8.0 ┄┄ - │ ├─ microlens-0.4.13.1 - │ │ └─ base-4.17.2.1 ┄┄ - │ ├─ mtl-2.2.2 ┄┄ - │ ├─ parsers-0.12.11 - │ │ ├─ attoparsec-0.14.4 ┄┄ - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ base-orphans-0.9.2 ┄┄ - │ │ ├─ binary-0.8.9.1 ┄┄ - │ │ ├─ charset-0.3.10 - │ │ │ ├─ array-0.5.4.0 ┄┄ - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ ├─ bytestring-0.11.5.3 ┄┄ - │ │ │ ├─ containers-0.6.7 ┄┄ - │ │ │ └─ unordered-containers-0.2.20 ┄┄ - │ │ ├─ containers-0.6.7 ┄┄ - │ │ ├─ mtl-2.2.2 ┄┄ - │ │ ├─ parsec-3.1.16.1 ┄┄ - │ │ ├─ scientific-0.3.8.0 ┄┄ - │ │ ├─ text-2.0.2 ┄┄ - │ │ ├─ transformers-0.5.6.2 ┄┄ - │ │ └─ unordered-containers-0.2.20 ┄┄ - │ ├─ text-2.0.2 ┄┄ - │ └─ vector-0.13.1.0 ┄┄ - ├─ resourcet-effectful-1.0.1.0 - │ ├─ base-4.17.2.1 ┄┄ - │ ├─ effectful-core-2.4.0.0 ┄┄ - │ └─ resourcet-1.3.0 ┄┄ - ├─ terminal-size-0.3.4 - │ └─ base-4.17.2.1 ┄┄ - ├─ text-2.0.2 ┄┄ - ├─ text-rope-0.3 - │ ├─ base-4.17.2.1 ┄┄ - │ ├─ deepseq-1.4.8.0 ┄┄ - │ ├─ text-2.0.2 ┄┄ - │ └─ vector-0.13.1.0 ┄┄ - ├─ tomland-1.3.3.3 - │ ├─ base-4.17.2.1 ┄┄ - │ ├─ bytestring-0.11.5.3 ┄┄ - │ ├─ containers-0.6.7 ┄┄ - │ ├─ deepseq-1.4.8.0 ┄┄ - │ ├─ hashable-1.4.7.0 ┄┄ - │ ├─ megaparsec-9.6.1 ┄┄ - │ ├─ mtl-2.2.2 ┄┄ - │ ├─ parser-combinators-1.3.0 ┄┄ - │ ├─ text-2.0.2 ┄┄ - │ ├─ time-1.12.2 ┄┄ - │ ├─ unordered-containers-0.2.20 ┄┄ - │ └─ validation-selective-0.2.0.0 - │ ├─ base-4.17.2.1 ┄┄ - │ ├─ deepseq-1.4.8.0 ┄┄ - │ └─ selective-0.7.0.1 - │ ├─ base-4.17.2.1 ┄┄ - │ └─ transformers-0.5.6.2 ┄┄ - └─ unordered-containers-0.2.20 ┄┄ -hibet-1.4.0 - [hibet-1.4.0:bench:"hibet-benchmark"] - ├─ base-4.17.2.1 ┄┄ - ├─ bytestring-0.11.5.3 ┄┄ - ├─ criterion-1.6.3.0 ┄┄ - ├─ file-embed-0.0.16.0 - │ ├─ base-4.17.2.1 ┄┄ - │ ├─ bytestring-0.11.5.3 ┄┄ - │ ├─ directory-1.3.7.1 ┄┄ - │ ├─ filepath-1.4.2.2 ┄┄ - │ └─ template-haskell-2.19.0.0 ┄┄ - ├─ hibet-1.4.0 ┄┄ - ├─ path-0.9.5 ┄┄ - ├─ path-io-1.8.2 ┄┄ - ├─ text-2.0.2 ┄┄ - └─ text-rope-0.3 ┄┄ -hibet-1.4.0 - [hibet-1.4.0:test:"hibet-env"] - ├─ base-4.17.2.1 ┄┄ - ├─ bytestring-0.11.5.3 ┄┄ - ├─ containers-0.6.7 ┄┄ - ├─ effectful-core-2.4.0.0 ┄┄ - ├─ hibet-1.4.0 ┄┄ - ├─ hspec-2.11.9 - │ ├─ QuickCheck-2.15.0.1 ┄┄ - │ ├─ base-4.17.2.1 ┄┄ - │ ├─ hspec-core-2.11.9 - │ │ ├─ HUnit-1.6.2.0 - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ ├─ call-stack-0.4.0 - │ │ │ │ └─ base-4.17.2.1 ┄┄ - │ │ │ └─ deepseq-1.4.8.0 ┄┄ - │ │ ├─ QuickCheck-2.15.0.1 ┄┄ - │ │ ├─ ansi-terminal-1.1.1 ┄┄ - │ │ ├─ array-0.5.4.0 ┄┄ - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ call-stack-0.4.0 ┄┄ - │ │ ├─ deepseq-1.4.8.0 ┄┄ - │ │ ├─ directory-1.3.7.1 ┄┄ - │ │ ├─ filepath-1.4.2.2 ┄┄ - │ │ ├─ haskell-lexer-1.1.1 - │ │ │ └─ base-4.17.2.1 ┄┄ - │ │ ├─ hspec-expectations-0.8.4 - │ │ │ ├─ HUnit-1.6.2.0 ┄┄ - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ └─ call-stack-0.4.0 ┄┄ - │ │ ├─ process-1.6.18.0 ┄┄ - │ │ ├─ quickcheck-io-0.2.0 - │ │ │ ├─ HUnit-1.6.2.0 ┄┄ - │ │ │ ├─ QuickCheck-2.15.0.1 ┄┄ - │ │ │ └─ base-4.17.2.1 ┄┄ - │ │ ├─ random-1.2.1.2 ┄┄ - │ │ ├─ stm-2.5.1.0 ┄┄ - │ │ ├─ tf-random-0.5 - │ │ │ ├─ base-4.17.2.1 ┄┄ - │ │ │ ├─ primitive-0.9.0.0 ┄┄ - │ │ │ ├─ random-1.2.1.2 ┄┄ - │ │ │ └─ time-1.12.2 ┄┄ - │ │ ├─ time-1.12.2 ┄┄ - │ │ └─ transformers-0.5.6.2 ┄┄ - │ ├─ hspec-discover-2.11.9 - │ │ ├─ base-4.17.2.1 ┄┄ - │ │ ├─ directory-1.3.7.1 ┄┄ - │ │ └─ filepath-1.4.2.2 ┄┄ - │ └─ hspec-expectations-0.8.4 ┄┄ - ├─ text-2.0.2 ┄┄ - └─ unordered-containers-0.2.20 ┄┄ -hibet-1.4.0 - [hibet-1.4.0:test:"hibet-labels"] - ├─ base-4.17.2.1 ┄┄ - ├─ bytestring-0.11.5.3 ┄┄ - ├─ containers-0.6.7 ┄┄ - ├─ hibet-1.4.0 ┄┄ - └─ hspec-2.11.9 ┄┄ -hibet-1.4.0 - [hibet-1.4.0:test:"hibet-parse"] - ├─ base-4.17.2.1 ┄┄ - ├─ hibet-1.4.0 ┄┄ - └─ hspec-2.11.9 ┄┄ -hibet-1.4.0 - [hibet-1.4.0:test:"hibet-pretty"] - ├─ base-4.17.2.1 ┄┄ - ├─ hibet-1.4.0 ┄┄ - ├─ hspec-2.11.9 ┄┄ - └─ prettyprinter-1.7.1 ┄┄ -hsc2hs-0.68.10 - [hsc2hs-0.68.10:exe:"hsc2hs"] - ├─ base-4.17.2.1 ┄┄ - ├─ containers-0.6.7 ┄┄ - ├─ directory-1.3.7.1 ┄┄ - ├─ filepath-1.4.2.2 ┄┄ - └─ process-1.6.18.0 ┄┄ -hspec-discover-2.11.9 - [hspec-discover-2.11.9:exe:"hspec-discover"] - ├─ base-4.17.2.1 ┄┄ - ├─ directory-1.3.7.1 ┄┄ - ├─ filepath-1.4.2.2 ┄┄ - └─ hspec-discover-2.11.9 ┄┄ -pager-0.1.1.0 - [pager-0.1.1.0:exe:"hs-pager-test-pager"] - ├─ base-4.17.2.1 ┄┄ - ├─ bytestring-0.11.5.3 ┄┄ - ├─ conduit-extra-1.3.6 ┄┄ - ├─ pager-0.1.1.0 ┄┄ - └─ text-2.0.2 ┄┄ - -Top-sorted -~~~~~~~~~~ - -UnitId "rts-1.0.2" -UnitId "ghc-prim-0.9.1" -UnitId "ghc-bignum-1.3" -UnitId "base-4.17.2.1" -UnitId "array-0.5.4.0" -UnitId "deepseq-1.4.8.0" -UnitId "ghc-boot-th-9.4.8" -UnitId "pretty-1.1.3.6" -UnitId "template-haskell-2.19.0.0" -UnitId "containers-0.6.7" -UnitId "filepath-1.4.2.2" -UnitId "time-1.12.2" -UnitId "bytestring-0.11.5.3" -UnitId "unix-2.7.3" -UnitId "directory-1.3.7.1" -UnitId "dlist-1.0-a33e5a7f21dad55513d80ffb06f20c2ff9a02682175b739ebc182ca2e2ba9508" -UnitId "transformers-0.5.6.2" -UnitId "transformers-compat-0.7.2-07807f6a916fed9cec5ac85ad002b56765f520681b2bbe9a3eb8b85bf077eafe" -UnitId "Glob-0.10.2-0adca46b32ac4956360a311e257658751e5fced3b74560cea74ed0dad8f2068c" -UnitId "call-stack-0.4.0-ef00e2167e83fb3355138aa96af1a70586e142f51a7b8330cf284129747e54a2" -UnitId "HUnit-1.6.2.0-81b4dc237915cc9d8f527716e205cd06628ff22d41ad3bc2ddbc155e19abb115" -UnitId "OneTuple-0.4.2-6e48a5a19ac27c7595d4a46dd031470e496b7f4dfada40e2cdf255c120b8b82e" -UnitId "Only-0.1-588a84422107567fe3e1b9b0c57f651cf082a7604c671377fb32a9ba34597a92" -UnitId "mtl-2.2.2" -UnitId "splitmix-0.1.0.5-4b143f483b5c4b68de945ccc15fa9370952f4fb7bd1e652c89a5928edc61b8e6" -UnitId "random-1.2.1.2-bcc926197c32f4db989238c5ad865acee4ac5050d11236d68e7af0232def6b43" -UnitId "QuickCheck-2.15.0.1-972dc976edb56b14d43453aea439900256117d54d75561c0c6bdb59e1b145b65" -UnitId "stm-2.5.1.0" -UnitId "StateVar-1.2.2-6c6f2d2fb12d62ce79fbf55097def1b8d77de556076d2fc8c77b411230bf4711" -UnitId "character-ps-0.1-06ba824204450a7d75a6b5a69c46c9406f5b6cf26ecfcc7c643c22dac4fe5fb0" -UnitId "exceptions-0.10.5" -UnitId "os-string-2.0.6-cf1b6058be6ec02ee665e6c0f59d1a630aeebaf5a699ebefdd08a0c3202d55f2" -UnitId "binary-0.8.9.1" -UnitId "text-2.0.2" -UnitId "hashable-1.4.7.0-a3f848b51d3df7052cbed116a7f829ada74559e2dd374afc89e06fde8aff204f" -UnitId "data-fix-0.3.4-4265fb7b5977cc6f163f052782769db9e0f98c62defa957f0ca22adfb1ea753c" -UnitId "base-orphans-0.9.2-7d503c32a334b2638e893e36b022c722bf894e3a74efa923c34eecc4f8ded6a0" -UnitId "generically-0.1.1-8f35505db6974335818517e8950dbf70e0dd5d9708f58e5a504ef1664fcf78c3" -UnitId "tagged-0.8.8-624b214960ff455bd482541a3c1e8bb3f35211ff82b756b79d5e450f98504a31" -UnitId "foldable1-classes-compat-0.1-103edd132976bd4a0e84499965ad0a5acf05bf23c9ccbbc5b79481c3014de3a3" -UnitId "indexed-traversable-0.1.4-c813b8aa61317a7149a92b8dc88844032c92406800ce2daf603f143059d27ddf" -UnitId "primitive-0.9.0.0-c17bfbc8573696bac8dd2ab2fd37a6595b395851b9dacccaf9812eafc03386b4" -UnitId "integer-conversion-0.1.1-f8ca56537e919e8545730b167b3626f9466d44cce0716055c3f70fba5e5cd187" -UnitId "integer-logarithms-1.0.3.1-f507db5eefcca9e02639c7fe32e341eabef3f2cd3213abf71e52f4346676a682" -UnitId "parsec-3.1.16.1" -UnitId "th-compat-0.1.5-d430812e254ef1713c60f9abd970ca4eda63a18350cd1d066b09dcebdcafa3ae" -UnitId "network-uri-2.6.4.2-f40d21da8706a6b7452a1c3f0654daf2d3e5bcb709547f666db1ff73b405b19d" -UnitId "scientific-0.3.8.0-9052163982295f3479b2460669123aa22f39e8ea28c9e10399845c425bf1ff26" -UnitId "unordered-containers-0.2.20-efcbf6df023ae02f2e1871036ac5d6975b6e1500121ccc3aa22e285f17b29891" -UnitId "vector-stream-0.1.0.1-f1d79872e7d79a09fd296306cd5dfb6c0221d55fc2f68a9711e495945aca48ad" -UnitId "vector-0.13.1.0-a342e5f0ce133bf9ec0ca8b6a47c80616ae79f7110aeae8394957472013236f5" -UnitId "indexed-traversable-instances-0.1.2-5dded62ed3d931993a8a99b1359449ff5e36dec313770271748d53d312df05c0" -UnitId "assoc-1.1.1-9e811843201b30cbef6987433580f967a3b752c8d46b6589aa9958541d181df2" -UnitId "distributive-0.6.2.1-285005ac57a7911dc3dbaab7b67315951c7b9ac3d7337c7bb81e11b86f7817a0" -UnitId "comonad-5.0.8-c6b48e0dbf30c925f1e792482ea9d4c97729493ccf7e76e3243c0c61df0b42bd" -UnitId "th-abstraction-0.7.0.0-562e7270faddda2f9fbe3f4fd9bb8d9203b7679ccbe13c5f16c40ca8058116a2" -UnitId "bifunctors-5.6.2-a7a06bbdbd7c6b866678e439ae28b310f527629610ff6010cdba7faa553d08e3" -UnitId "contravariant-1.5.5-a20fe5ca314e5b5686dbb79b903d0150095d3c61a4c6738ed1f85388648d9801" -UnitId "semigroupoids-6.0.1-9f3a8e0f08c130261c06673731219bf16f745a01a78e6a2ecc157ba3ef3083ba" -UnitId "these-1.2.1-f4f66c9501ab6821c772aec8f39ce00c2ad1ed025841124a19e4028c18110cc3" -UnitId "semialign-1.3.1-86ca68b007f33eed2072b7f2e270045806e2133aea75ff69a19fa00f3e3cd39c" -UnitId "strict-0.5.1-35dc86c70785609eabfcb6bddfecda432802d1bc80c8c936e09b908174de55b2" -UnitId "time-compat-1.9.7-a1d6136dacb9065c6b24e087e3aba59255c9aeb5d4a1b7fa17dd03e8846b5c0c" -UnitId "text-iso8601-0.1.1-edd04b8b2f7f9d08698584b88223ebaf2f0e562a0eb156b491a9d58b79631cd8" -UnitId "text-short-0.1.6-b39cf6f3ed71a27bf96da9b4631bb71e645591162103083879f8792ef5149344" -UnitId "uuid-types-1.0.6-ee2e5a6c4d0ee00c14aadac46507f84c9e28db947a33470d56c4b35151eba96e" -UnitId "witherable-0.5-bf0c2fe06347134e341b760889037e7c9840808499c0114a0a602dbcb8d12231" -UnitId "aeson-2.2.3.0-f18b1721c51142786e715fe204ab8163388ddacca1b3ba145c77ff93b0ef2923" -UnitId "base-compat-0.14.0-095e05fe1857649a2325f5795a1754e1153ec188b5bcb7efd282b0d4b8676477" -UnitId "aeson-pretty-0.8.10-b6be571c3a9e9e2b10b0921cecedca4ea99e74930adbbc6b939a5b8930e3f626" -UnitId "attoparsec-0.14.4-l-attoparsec-internal-0c8890450f0c579acd356ab408d800df04e2dd0824e4996b6c5bfadcf67947a4" -UnitId "attoparsec-0.14.4-08498dc37dfa13e1fef27d0a99956f89da9d4ed48d090fa2fc36f61f4483c236" -UnitId "attoparsec-aeson-2.2.2.0-f7f38ec1c76875a16f5c69bd480d45d5e9e572d2b746426140e132bc86e6af6c" -UnitId "process-1.6.18.0" -UnitId "cmdargs-0.10.22-58faeb4494cce0a5bccb94b4731d9db6dc0f954d85dec375e3a8ba8222430c46" -UnitId "aeson-pretty-0.8.10-e-aeson-pretty-593c5942194de3fc3a653f2485d5d59ec98367560a9576729a2b37fdd73e822a" -UnitId "colour-2.3.6-101a30bf97e485340c2f8c4965d7a09c45f53ec9a0681956d60a295961f45156" -UnitId "ansi-terminal-types-1.1-6d303a0fcc5112274788c758aaccf72e202bb06412e506879a622118dc4a6efe" -UnitId "ansi-terminal-1.1.1-9a0832138b85587e564b731f3eb8544cfac3f1b09c25035e0c255ff5defabbc9" -UnitId "async-2.2.5-ee1c1688744aac44514d29eb273b4b6ba90bf2122fbbf8754a4fd855cf01b6d7" -UnitId "base-compat-batteries-0.14.0-4559e1ce7b10f33eb8f8a68fc3faf98c5b77a02a70a49e94c7fe12d566258d75" -UnitId "binary-orphans-1.0.5-1ac470cecdbbf08c25070c27b14612ba0bf2a9c970249cd3f9873f7c5621a401" -UnitId "bitvec-1.1.5.0-9bbed18052bda9065b11af488da12e89f024db0a8a2f3bafe0c7c5b1fb0cf7f3" -UnitId "case-insensitive-1.2.1.0-599c25a76aae9c87830e4315fc13188b41c065228ff3ffe29c4861890d00fb95" -UnitId "cassava-0.5.3.2-9ecb7cb818664c09fc62ef577326ce7343b402e22e0ef979be79145a1ec64400" -UnitId "charset-0.3.10-1a8de4d84dad54957a2ffbfa55d58a7c7ae84b9262921dbcc3c6b1096339cc8a" -UnitId "clock-0.8.4-2292d6cf553e98720aade4be17251554883619d3886e13a1c3f5352321468bae" -UnitId "hsc2hs-0.68.10-e-hsc2hs-3c26ce6e00190495fef7423e6443d58e968627872aa222223bffb4b0ff941572" -UnitId "code-page-0.2.1-a2c681b3ce689b280e3a0d5677f4762f06a7f3615907b61ad81f9fefc42458ab" -UnitId "split-0.2.5-fab53f63a5abbb9e714ec5de37b8818a9b7d1b464c6861b9c6a190a49e3c76d8" -UnitId "vector-algorithms-0.9.0.2-878faad0a12be07267c2d611f73c329fa9e5538ae662595348491d4c985b5241" -UnitId "mono-traversable-1.0.20.0-bf9e5f4a089b178bdfb32a578f05875467f7ce80bdc485a3fc3f700cbc829548" -UnitId "unliftio-core-0.2.1.0-cc06b481863300209bec0bfe4d84fb4b81231588c3e0b1bb95e26ca6105660d8" -UnitId "resourcet-1.3.0-e07d6f5c7723d30c8dc8f55250b19e0714d338737adca6d902a33084f1b04ea6" -UnitId "conduit-1.3.6-f066b03b7df8ad1aca4ce67fcccc2ec0786bb0c941a481f3b6717a2841b3e6aa" -UnitId "network-3.2.4.0-c689708a3979f0107aae1de6fe4da63574adfe6f7d0137fd06ebbd2e880985ed" -UnitId "zlib-0.7.1.0-bf96f10a29146bf94fd15780c570a690bea5eb338569455f6586422043b7aeb3" -UnitId "streaming-commons-0.2.2.6-d2d1e9d25c1552360c4a350aae16900896181c919a31e816b74c20bd2cfdaa3e" -UnitId "typed-process-0.2.12.0-67c36c449e51cf156879000f7fd73161db69ed6355f053beae1ae18c237d54a1" -UnitId "conduit-extra-1.3.6-9b0d18dc823ce95f43977e747c2c0e3aa2c754d580676e5539d292315231ce44" -UnitId "criterion-measurement-0.2.2.0-6cc3570be46a6c116998c381050b3c9042b8709bf12357cd8b378c71af744193" -UnitId "js-chart-2.9.4.1-86c56bc81047dc731ff9cc2fe1943695355df67319c6ecd2d429a1f1226b7557" -UnitId "microstache-1.0.3-1f9bcf5ac6301bc8f3cb48e24e511dc597f06431f128a782601d8b1099a84a59" -UnitId "data-default-class-0.1.2.2-2cf5c1ba4834182d489730b5e9f115f39b02884e581129fdc727ca23cfd851f7" -UnitId "math-functions-0.3.4.4-6b83870c201b5cbdfa40753d9ea91fcf78e084c540b35ded220708275be47d04" -UnitId "mwc-random-0.15.1.0-e4fffe0385459bb9ed1b67776f394793a3a9a33c86e030f429e317d0765014e2" -UnitId "prettyprinter-1.7.1-a2952acf3277904adfc9f81216975cb21318656a97e53d37904afdcac59e616b" -UnitId "prettyprinter-ansi-terminal-1.1.3-b92410ab6527aa9d3f2e514e15dc6d9e7fbc36d96ca11bce0deaeeea8d0bb898" -UnitId "optparse-applicative-0.18.1.0-523f53e9bdd4161ae7f9881991180767a933c2ec89edacc35245aa60ca1041d1" -UnitId "vector-binary-instances-0.2.5.2-cb3c049701a7837cac2e52549eb0eb3cc2ab021cc9081eedcc97c545ed050aec" -UnitId "vector-th-unbox-0.2.2-b8b975c4cdd6b6a4273db4362bd60e846b8277c914fff5ae6e09d2ec7b7930ad" -UnitId "dense-linear-algebra-0.1.0.0-a956709472fcf5f3e037415bbe47376f67b3d48a1cd71511224e8c1f5ec5628f" -UnitId "parallel-3.2.2.0-364aed93072c964b4e0511400336588134b34df10253608f37ea9c5831374463" -UnitId "statistics-0.16.2.1-12687f28633858c96f19394660d2d8bc2911dbec1f39ea8a7523ed5b33b497c8" -UnitId "criterion-1.6.3.0-e446ad49c8fe63c8b5dec3771fef0994c473d7aa272d73290a32ea2eddde966b" -UnitId "criterion-1.6.3.0-e-criterion-report-3dcb04787888cd7471e1c26e6353b49b5455524f970b4cea7f99cca185b47979" -UnitId "transformers-base-0.4.6-a75b623afb29f9b462d935e7d25d008a6002a9c4edcf92ab2c17fb7a0c569dd7" -UnitId "monad-control-1.0.3.1-66790eec955cd825a2bd55d84baef2a84918f590531b6779702c93b6b393ff90" -UnitId "safe-exceptions-0.1.7.4-f07efcd486b7f0bb86d7fc2ced3c662998633ad5093c29150253f9725f2114c9" -UnitId "strict-mutable-base-1.1.0.0-69fc58f5df44bacf4d0526ca3ab732b430356c1dd62392e9d7931f5a89d1cbc1" -UnitId "effectful-core-2.4.0.0-95e97d33981dba6ac271fee73cdb3d92b0e8f6d1b947aa5360dcae3a686d23dc" -UnitId "unliftio-0.2.25.0-2889934ffdd4aba6529610127833bf1ad735712981ac91c879748bf50fe437b1" -UnitId "effectful-2.4.0.0-c5d9f86654ce4d3a54dc5a6303725b234b0544a7fdbde3d0bad7118bb584e9da" -UnitId "ghc-boot-9.4.8" -UnitId "ghc-heap-9.4.8" -UnitId "ghci-9.4.8" -UnitId "hpc-0.6.1.0" -UnitId "terminfo-0.4.1.5" -UnitId "ghc-9.4.8" -UnitId "effectful-plugin-1.1.0.4-8b0295846c35d62bb8e71f91cc77e18dd11f4a7075037031e628ebfe49ae42fc" -UnitId "effectful-th-1.0.0.3-0c0821739ba9fa177d632c095106cc0891b1a37ed8bbfec94502e45e093bae0e" -UnitId "extra-1.8-7422f8ec2eaa18266573784c243a393b6182395d5820a373e38fcd69eb34e31c" -UnitId "file-embed-0.0.16.0-6613e4eb8a47080105976fe2b81a42b0d9fd08b15f6ec50f2f461a5b056e8a43" -UnitId "gitrev-1.3.1-7c995fe6220594860b1959319fa4d9eecc370436c257bbf7924333088009d522" -UnitId "haskeline-0.8.2" -UnitId "haskell-lexer-1.1.1-40e9b4768cacabd45f70a98932d218392048d92e0022a9168a0440910c5683b7" -UnitId "mmorph-1.2.0-3dfdfc92dee08f081e43884ee7314e7d5ab0afbd96369761deaf67584ab2fafc" -UnitId "semigroups-0.20-a463de7bb2be24e7b9e686e5cd8133bb28aefa7a8eb4eb3d249bb753286ebb39" -UnitId "log-base-0.12.0.1-623fe096c2c045e5aff1cfe0bbe7699b8b6a84d2f9ffa9f207d26400294413d5" -UnitId "log-effectful-1.0.0.0-3abeed6a27610fe0c8372b0e3d6bbd73455b2df59c02efc74e2d7c593fd34264" -UnitId "parser-combinators-1.3.0-1952f16d594dbe94dfbf901b1bc1ac212d3e1bc2beb45813855f21c09a66323f" -UnitId "megaparsec-9.6.1-658bb65843e158f936ffbf5c1c6cf97a54f2978633e8d4499ed220f588e200a1" -UnitId "neat-interpolation-0.5.1.4-47bb24bb2ed2c51f7cb8214a73602ec66f7bc49ea0d9622a26499e3e76be1d5f" -UnitId "safe-0.3.21-f381d8ee822c09d490211eff2e73b9c366126c0efb34873f37bf370dba1dfc88" -UnitId "pager-0.1.1.0-d1792f434a9c0b740d8b2c7c24243047af131eedcfdce499d2eff0e4a7f3c27f" -UnitId "path-0.9.5-bbf366f7f1445d2a9f9c73c13fafcd3ee3bf1f846a287ebf1e76ae2da7a10973" -UnitId "temporary-1.3-3dac72ec2334f77ab98ed4e09a78dc0972e303556f455c8812cd74573d7c7bc0" -UnitId "unix-compat-0.7.3-8689bbe43cbf6e2386335eef214a5d7d99af3e35a678dc1b5beafacb03bc836e" -UnitId "path-io-1.8.2-adb910b421dd5754dc2c717a791ebc9dd85ff583076a386b66425a309ed760e1" -UnitId "microlens-0.4.13.1-6b11272fafed215cba7fb88000aa50643abc97dcbf5448d13b7b7d25b744d472" -UnitId "parsers-0.12.11-6f5c8fdde76e8cafb2819c384b6f16ea9baa65ed62108f5ac609b3c0434d6f2e" -UnitId "radixtree-0.6.0.0-70f2e43d23ea34bb7995630a7022ed3e42756d11a88a70e409accfb201c81315" -UnitId "resourcet-effectful-1.0.1.0-219c20775d266746711cd173d4866401ffb39287952627b305b56083db015ef5" -UnitId "terminal-size-0.3.4-d3d731a69995590de5e573de4c4b26a3f86b1785463e683e2ef206fc86744d0e" -UnitId "text-rope-0.3-d6209138333196f7c0093924eca9cf7073581bcd4f07af5ad8df0a1595922aa1" -UnitId "selective-0.7.0.1-572557e30f79d97b1c884f826cfe75937cbff8e16ffd6e76d451a70293c4a0d5" -UnitId "validation-selective-0.2.0.0-23f79e25a9da8e5a6649a81b449c8c0357cf390b7705fc9cc7522a7515c7cf27" -UnitId "tomland-1.3.3.3-2a74e99e8de98327d72d4ba488bb1285b676522183c07095ca8f88a6756cc409" -UnitId "hibet-1.4.0-inplace" -UnitId "hibet-1.4.0-inplace-hibet" -UnitId "hibet-1.4.0-inplace-hibet-benchmark" -UnitId "hspec-expectations-0.8.4-fb37f9e911b287e4b22bcdcc0420d058150de2338ab517c7a5f3843c64dba5ed" -UnitId "quickcheck-io-0.2.0-6a2a99069c10315fe637054647568f4d7fb1af45de8c9dae1b783a7e33724463" -UnitId "tf-random-0.5-68231bf16ee72d6c90671b0af3556b7a25ae7195e9ce9519b06d0cfa017441a3" -UnitId "hspec-core-2.11.9-8dcff20c5003014fbf27f66277526c9273181595a704c24581f531584a6d203b" -UnitId "hspec-discover-2.11.9-e3c412fcca6379fdf744da966055b22e3ca5e325cf81172a809fca11b4462637" -UnitId "hspec-2.11.9-e4e50bcfa1893d3ed7bb8b99c1fa4ae6cdf67b699bf74181a44e2c252af11611" -UnitId "hibet-1.4.0-inplace-hibet-env" -UnitId "hibet-1.4.0-inplace-hibet-labels" -UnitId "hibet-1.4.0-inplace-hibet-parse" -UnitId "hibet-1.4.0-inplace-hibet-pretty" -UnitId "hspec-discover-2.11.9-e-hspec-discover-30dd77a765061f7d963f021ced47cf487ea350fb89c45fdc1a6161a74379cace" -UnitId "pager-0.1.1.0-e-hs-pager-test-pager-d49ceb562f84f7be8d5416deb24bb16b2f0b2f6f287dc9df742bd25feb83b90a" - -Direct deps -~~~~~~~~~~~ - -PkgId (PkgName "hibet") (Ver [1,4,0]) -CompNameLib - base-4.17.2.1 - bytestring-0.11.5.3 - containers-0.6.7 - deepseq-1.4.8.0 - directory-1.3.7.1 - effectful-2.4.0.0 - effectful-core-2.4.0.0 - effectful-plugin-1.1.0.4 - effectful-th-1.0.0.3 - extra-1.8 - filepath-1.4.2.2 - gitrev-1.3.1 - hashable-1.4.7.0 - haskeline-0.8.2 - log-effectful-1.0.0.0 - megaparsec-9.6.1 - neat-interpolation-0.5.1.4 - optparse-applicative-0.18.1.0 - pager-0.1.1.0 - parallel-3.2.2.0 - path-0.9.5 - path-io-1.8.2 - prettyprinter-1.7.1 - prettyprinter-ansi-terminal-1.1.3 - radixtree-0.6.0.0 - resourcet-effectful-1.0.1.0 - terminal-size-0.3.4 - text-2.0.2 - text-rope-0.3 - tomland-1.3.3.3 - unordered-containers-0.2.20 - -PkgId (PkgName "hibet") (Ver [1,4,0]) -CompNameExe "hibet" - base-4.17.2.1 - hibet-1.4.0 - -PkgId (PkgName "hibet") (Ver [1,4,0]) -CompNameBench "hibet-benchmark" - base-4.17.2.1 - bytestring-0.11.5.3 - criterion-1.6.3.0 - file-embed-0.0.16.0 - hibet-1.4.0 - path-0.9.5 - path-io-1.8.2 - text-2.0.2 - text-rope-0.3 - -PkgId (PkgName "hibet") (Ver [1,4,0]) -CompNameTest "hibet-env" - base-4.17.2.1 - bytestring-0.11.5.3 - containers-0.6.7 - effectful-core-2.4.0.0 - hibet-1.4.0 - hspec-2.11.9 - text-2.0.2 - unordered-containers-0.2.20 - -PkgId (PkgName "hibet") (Ver [1,4,0]) -CompNameTest "hibet-labels" - base-4.17.2.1 - bytestring-0.11.5.3 - containers-0.6.7 - hibet-1.4.0 - hspec-2.11.9 - -PkgId (PkgName "hibet") (Ver [1,4,0]) -CompNameTest "hibet-parse" - base-4.17.2.1 - hibet-1.4.0 - hspec-2.11.9 - -PkgId (PkgName "hibet") (Ver [1,4,0]) -CompNameTest "hibet-pretty" - base-4.17.2.1 - hibet-1.4.0 - hspec-2.11.9 - prettyprinter-1.7.1 - diff --git a/hibet.cabal b/hibet.cabal index 7ca54de..b743efa 100644 --- a/hibet.cabal +++ b/hibet.cabal @@ -217,7 +217,6 @@ test-suite hibet-env hibet , bytestring , hspec - , containers , text , unordered-containers , effectful-core @@ -237,7 +236,6 @@ test-suite hibet-parse build-depends: hibet , hspec - -- , megaparsec other-modules: Paths_hibet diff --git a/test/env/Main.hs b/test/env/Main.hs index 7467d12..138dcdc 100644 --- a/test/env/Main.hs +++ b/test/env/Main.hs @@ -9,7 +9,7 @@ import Effectful.Error.Static import Effects.File (FileSystem (..)) import qualified Effects.File as EF import Env (Env (..), makeEnv) -import Label (LabelFull (..), Labels (..), Title (..)) +import Label (Title (..)) import Parse (Script (Script), ScriptType (..), WylieTibetMap, splitSyllables) import Paths (dictPath1, dictPath2, sylPath, titlePath) import Type (HibetError (..)) @@ -18,9 +18,8 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL import Data.Function ((&)) import qualified Data.HashMap.Strict as HM -import Data.List (sort) +import Data.List (sort, sortOn) import Data.Maybe (mapMaybe) -import qualified Data.Set as Set import qualified Data.Text.Encoding as TE import Test.Hspec (Spec, describe, expectationFailure, hspec, it, shouldBe) @@ -64,17 +63,17 @@ translate = Right env -> do let query = "mir" let reply = mapMaybe (searchTranslation query) env.dictionaryMeta - reply + sortOn dictNumber reply `shouldBe` [ Answer - { targets = [Target "as/for/ to a human being"] - , dictNumber = 16 - , dictTitle = Title "Ives Waldo" - } - , Answer { targets = [Target "termin. case of mi"] , dictNumber = 15 , dictTitle = Title "James Valby" } + , Answer + { targets = [Target "as/for/ to a human being"] + , dictNumber = 16 + , dictTitle = Title "Ives Waldo" + } , Answer { targets = [ Target @@ -103,17 +102,17 @@ translate = Left err -> expectationFailure $ show err Right env -> do let reply = mapMaybe (searchTranslation "re ba byed pa") env.dictionaryMeta - reply + sortOn dictNumber reply `shouldBe` [ Answer - { targets = [Target "demand, ask, hope, wish, expect"] - , dictNumber = 15 - , dictTitle = Title "James Valby" - } - , Answer { targets = [Target "to hope, wish, expect, demand, ask"] , dictNumber = 7 , dictTitle = Title "Rangjung Yeshe" } + , Answer + { targets = [Target "demand, ask, hope, wish, expect"] + , dictNumber = 15 + , dictTitle = Title "James Valby" + } ] it "Search re ba med pa" $ do res <- runFileMock makeEnv @@ -121,16 +120,16 @@ translate = Left err -> expectationFailure $ show err Right env -> do let reply = mapMaybe (searchTranslation "re ba med pa") env.dictionaryMeta - reply + sortOn dictNumber reply `shouldBe` [ Answer { targets = [Target "hopeless; no hope"] , dictNumber = 5 , dictTitle = Title "Hopkins" } , Answer - { targets = [Target "{MSA}nirapekṣa; {MSA}niṣpratikāṅkṣa"] - , dictNumber = 41 - , dictTitle = Title "Hopkins Sanskrit" + { targets = [Target "hopeless, despairing"] + , dictNumber = 15 + , dictTitle = Title "James Valby" } , Answer { targets = [Target "hopeless, no hope of --"] @@ -138,9 +137,9 @@ translate = , dictTitle = Title "Ives Waldo" } , Answer - { targets = [Target "hopeless, despairing"] - , dictNumber = 15 - , dictTitle = Title "James Valby" + { targets = [Target "{MSA}nirapekṣa; {MSA}niṣpratikāṅkṣa"] + , dictNumber = 41 + , dictTitle = Title "Hopkins Sanskrit" } ] From c3874b46e745d22ca5398f8f5af868a9cce1fcfb Mon Sep 17 00:00:00 2001 From: Vladislav Sabanov Date: Mon, 21 Oct 2024 21:14:09 -0300 Subject: [PATCH 14/15] Fix cabal check --- hibet.cabal | 443 +++++++++++++++++++++++++--------------------------- 1 file changed, 209 insertions(+), 234 deletions(-) diff --git a/hibet.cabal b/hibet.cabal index b743efa..d64d0d2 100644 --- a/hibet.cabal +++ b/hibet.cabal @@ -1,272 +1,247 @@ -cabal-version: 3.0 -name: hibet -version: 1.4.0 -description: tibetan-english translator -synopsis: translator -homepage: https://github.com/willbasky/Hibet -bug-reports: https://github.com/willbasky/Hibet/issues -license: BSD-3-Clause -license-file: LICENSE -author: willbasky -maintainer: willgame(at)mail(dot)ru -copyright: 2023 willbasky -category: Utility -build-type: Simple -extra-doc-files: README.md - , CHANGELOG.md -data-files: dicts/*.txt - , stuff/titles.toml - , stuff/tibetan-syllables +cabal-version: 3.0 +name: hibet +version: 1.4.0 +description: tibetan-english translator +synopsis: translator +homepage: https://github.com/willbasky/Hibet +bug-reports: https://github.com/willbasky/Hibet/issues +license: BSD-3-Clause +license-file: LICENSE +author: willbasky +maintainer: willgame(at)mail(dot)ru +copyright: 2023 willbasky +category: Utility +build-type: Simple +extra-doc-files: + CHANGELOG.md + README.md + +data-files: + dicts/*.txt + stuff/tibetan-syllables + stuff/titles.toml + extra-source-files: test/env/data/dicts/*.txt test/env/data/stuff/tibetan-syllables test/env/data/stuff/titles.toml -tested-with: - GHC==9.4.8 + +tested-with: GHC ==9.4.8 source-repository head - type: git - location: https://github.com/willbasky/Hibet.git + type: git + location: https://github.com/willbasky/Hibet.git common common-dot - default-extensions: - OverloadedRecordDot + default-extensions: OverloadedRecordDot common common-options - build-depends: base >= 4.11 && < 5 - - ghc-options: -Wall - -Wcompat - -Widentities - -Wincomplete-uni-patterns - -Wincomplete-record-updates - -Wredundant-constraints - -- -split-sections - -fhide-source-paths - -- -Wmissing-export-lists - -Wpartial-fields - -Wmissing-deriving-strategies - -fwrite-ide-info - -hiedir=.hie - -Wunused-packages - -- -ddump-if-trace - -- -O2 - -- -eventlog - -- -finfo-table-map - -- -fdistinct-constructor-tables - - default-language: Haskell2010 - + build-depends: base >=4.11 && <5 + ghc-options: + -Wall -Wcompat -Widentities -Wincomplete-uni-patterns + -Wincomplete-record-updates -Wredundant-constraints + -fhide-source-paths -Wpartial-fields -Wmissing-deriving-strategies + -fwrite-ide-info -hiedir=.hie -Wunused-packages + + -- -split-sections + -- -Wmissing-export-lists + -- -ddump-if-trace + -- -O2 + -- -eventlog + -- -finfo-table-map + -- -fdistinct-constructor-tables + + default-language: Haskell2010 default-extensions: - DataKinds - DeriveGeneric - DerivingStrategies - DuplicateRecordFields - FlexibleContexts - FlexibleInstances - GADTs - LambdaCase - MultiParamTypeClasses - OverloadedStrings - RankNTypes - RecordWildCards - PolyKinds - ScopedTypeVariables - TemplateHaskell - TupleSections - TypeApplications - TypeFamilies - TypeOperators - TypeSynonymInstances - UndecidableInstances + DataKinds + DeriveGeneric + DerivingStrategies + DuplicateRecordFields + FlexibleContexts + FlexibleInstances + GADTs + LambdaCase + MultiParamTypeClasses + OverloadedStrings + PolyKinds + RankNTypes + RecordWildCards + ScopedTypeVariables + TemplateHaskell + TupleSections + TypeApplications + TypeFamilies + TypeOperators + TypeSynonymInstances + UndecidableInstances library import: - common-options + common-options , common-dot - ghc-options: - -fplugin=Effectful.Plugin - hs-source-dirs: src - exposed-modules: - App - Cli - Effects.Common - Effects.File - Effects.Console - Effects.PrettyPrint - Env - Dictionary - Label - Parse - Parse.SyllableLines - Parse.TibetanWord - Parse.WylieWord - Parse.WylieText - Parse.Type - Pretty - Translator - Type - Utility - - other-modules: Paths_hibet - , Sandbox - autogen-modules: Paths_hibet + ghc-options: -fplugin=Effectful.Plugin + hs-source-dirs: src + exposed-modules: + App + Cli + Dictionary + Effects.Common + Effects.Console + Effects.File + Effects.PrettyPrint + Env + Label + Parse + Parse.SyllableLines + Parse.TibetanWord + Parse.Type + Parse.WylieText + Parse.WylieWord + Pretty + Translator + Type + Utility + + other-modules: + Paths_hibet + Sandbox + + autogen-modules: + Paths_hibet build-depends: - bytestring - , containers - , deepseq - , directory - , effectful-th - , effectful - , effectful-core - , effectful-plugin - , log-effectful - , resourcet-effectful - , extra - , filepath - , gitrev - , haskeline - , hashable - , megaparsec - , neat-interpolation - , optparse-applicative - , pager - , parallel - , path - , path-io - , prettyprinter - , prettyprinter-ansi-terminal - , radixtree ^>=0.6.0.0 - , terminal-size - , text - , text-rope - , tomland ^>=1.3.3.2 - , unordered-containers - + , bytestring >=0.11.5 && <0.12 + , containers >=0.6.7 && <0.7 + , deepseq >=1.4.8 && <1.5 + , directory >=1.3.7 && <1.4 + , effectful >=2.4.0 && <2.5 + , effectful-core >=2.4.0 && <2.5 + , effectful-plugin >=1.1.0 && <1.2 + , effectful-th >=1.0.0 && <1.1 + , extra >=1.8 && <1.9 + , filepath >=1.4.2 && <1.5 + , gitrev >=1.3.1 && <1.4 + , hashable >=1.4.7 && <1.5 + , haskeline >=0.8.2 && <0.9 + , log-effectful >=1.0.0 && <1.1 + , megaparsec >=9.6.1 && <9.7 + , neat-interpolation >=0.5.1 && <0.6 + , optparse-applicative >=0.18.1 && <0.19 + , pager >=0.1.1 && <0.2 + , parallel >=3.2.2 && <3.3 + , path >=0.9.5 && <0.10 + , path-io >=1.8.2 && <1.9 + , prettyprinter >=1.7.1 && <1.8 + , prettyprinter-ansi-terminal >=1.1.3 && <1.2 + , resourcet-effectful >=1.0.1 && <1.1 + , terminal-size >=0.3.4 && <0.4 + , text >=2.0.2 && <2.1 + , text-rope >=0.3 && <0.4 + , unordered-containers >=0.2.20 && <0.3 executable hibet - import: common-options - hs-source-dirs: app - main-is: Main.hs - ghc-options: -Wall - -- -O2 -eventlog - -- ^ for threadscope - -threaded - -rtsopts - -Wincomplete-uni-patterns - -Wincomplete-record-updates - -Wcompat - -Widentities - -Wredundant-constraints - -fhide-source-paths - -Wmissing-export-lists - -Wpartial-fields - - -with-rtsopts=-N16 - -with-rtsopts=-qn8 - -with-rtsopts=-A64m - -with-rtsopts=-AL128m - -with-rtsopts=-I0 - -with-rtsopts=-T - build-depends: - hibet + import: common-options + hs-source-dirs: app + main-is: Main.hs + ghc-options: + -Wall -threaded -rtsopts -Wincomplete-uni-patterns + -Wincomplete-record-updates -Wcompat -Widentities + -Wredundant-constraints -fhide-source-paths -Wmissing-export-lists + -Wpartial-fields -with-rtsopts=-N16 -with-rtsopts=-qn8 + -with-rtsopts=-A64m -with-rtsopts=-AL128m -with-rtsopts=-I0 + -with-rtsopts=-T + -- -O2 -eventlog + -- ^ for threadscope + build-depends: hibet test-suite hibet-pretty - import: common-options - type: exitcode-stdio-1.0 - hs-source-dirs: test/pretty - main-is: Main.hs - ghc-options: -Wall - -threaded - -rtsopts - -with-rtsopts=-N + import: common-options + type: exitcode-stdio-1.0 + hs-source-dirs: test/pretty + main-is: Main.hs + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N build-depends: - hibet - , hspec - , prettyprinter + , hibet + , hspec + , prettyprinter test-suite hibet-labels - import: common-options - type: exitcode-stdio-1.0 - hs-source-dirs: test/labels - main-is: Main.hs - ghc-options: -Wall - -threaded - -rtsopts - -with-rtsopts=-N + import: common-options + type: exitcode-stdio-1.0 + hs-source-dirs: test/labels + main-is: Main.hs + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N build-depends: - hibet - , bytestring - , containers - , hspec + , bytestring + , containers + , hibet + , hspec test-suite hibet-env import: - common-options + common-options , common-dot - type: exitcode-stdio-1.0 - hs-source-dirs: test/env - main-is: Main.hs - ghc-options: -Wall - -threaded - -rtsopts - -with-rtsopts=-N - build-depends: - hibet - , bytestring - , hspec - , text - , unordered-containers - , effectful-core - other-modules: Paths_hibet - Paths + type: exitcode-stdio-1.0 + hs-source-dirs: test/env + main-is: Main.hs + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + build-depends: + , bytestring + , effectful-core + , hibet + , hspec + , text + , unordered-containers + + other-modules: + Paths + Paths_hibet + autogen-modules: + Paths_hibet test-suite hibet-parse - import: common-options - type: exitcode-stdio-1.0 - hs-source-dirs: test/parse - main-is: Main.hs - ghc-options: -Wall - -threaded - -rtsopts - -with-rtsopts=-N + import: common-options + type: exitcode-stdio-1.0 + hs-source-dirs: test/parse + main-is: Main.hs + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N build-depends: - hibet - , hspec - - other-modules: Paths_hibet + , hibet + , hspec + other-modules: + Paths_hibet + autogen-modules: + Paths_hibet benchmark hibet-benchmark - import: common-options - type: exitcode-stdio-1.0 - hs-source-dirs: benchmark - main-is: Main.hs - + import: common-options + type: exitcode-stdio-1.0 + hs-source-dirs: benchmark + main-is: Main.hs build-depends: - hibet - , criterion - , path - , path-io >= 1.4.0 - , text - , bytestring - , file-embed - , text-rope - -- , weigh - -- , streamly - -- , unordered-containers - -- , conduit - -- , async - - other-modules: Paths_hibet - Lines - Common - - ghc-options: -threaded - -rtsopts - -with-rtsopts=-N - - + , bytestring + , criterion + , file-embed + , hibet + , path + , path-io >=1.4.0 + , text + , text-rope + + -- , weigh + -- , streamly + -- , unordered-containers + -- , conduit + -- , async + + other-modules: + Common + Lines + Paths_hibet + autogen-modules: + Paths_hibet + + ghc-options: -threaded -rtsopts -with-rtsopts=-N From 6a5e8affde6590b22c0127f1ba91ce700c9dc458 Mon Sep 17 00:00:00 2001 From: Vladislav Sabanov Date: Mon, 21 Oct 2024 21:26:56 -0300 Subject: [PATCH 15/15] Fix build --- hibet.cabal | 73 +++++++++++++++++++++++++---------------------------- 1 file changed, 35 insertions(+), 38 deletions(-) diff --git a/hibet.cabal b/hibet.cabal index d64d0d2..1047e41 100644 --- a/hibet.cabal +++ b/hibet.cabal @@ -107,37 +107,38 @@ library Paths_hibet Sandbox - autogen-modules: - Paths_hibet + autogen-modules: Paths_hibet build-depends: - , bytestring >=0.11.5 && <0.12 - , containers >=0.6.7 && <0.7 - , deepseq >=1.4.8 && <1.5 - , directory >=1.3.7 && <1.4 - , effectful >=2.4.0 && <2.5 - , effectful-core >=2.4.0 && <2.5 - , effectful-plugin >=1.1.0 && <1.2 - , effectful-th >=1.0.0 && <1.1 - , extra >=1.8 && <1.9 - , filepath >=1.4.2 && <1.5 - , gitrev >=1.3.1 && <1.4 - , hashable >=1.4.7 && <1.5 - , haskeline >=0.8.2 && <0.9 - , log-effectful >=1.0.0 && <1.1 - , megaparsec >=9.6.1 && <9.7 - , neat-interpolation >=0.5.1 && <0.6 - , optparse-applicative >=0.18.1 && <0.19 - , pager >=0.1.1 && <0.2 - , parallel >=3.2.2 && <3.3 - , path >=0.9.5 && <0.10 - , path-io >=1.8.2 && <1.9 - , prettyprinter >=1.7.1 && <1.8 - , prettyprinter-ansi-terminal >=1.1.3 && <1.2 - , resourcet-effectful >=1.0.1 && <1.1 - , terminal-size >=0.3.4 && <0.4 - , text >=2.0.2 && <2.1 - , text-rope >=0.3 && <0.4 - , unordered-containers >=0.2.20 && <0.3 + , bytestring ^>=0.11.5 + , containers ^>=0.6.7 + , deepseq ^>=1.4.8 + , directory ^>=1.3.7 + , effectful ^>=2.4.0 + , effectful-core ^>=2.4.0 + , effectful-plugin ^>=1.1.0 + , effectful-th ^>=1.0.0 + , extra ^>=1.8 + , filepath ^>=1.4.2 + , gitrev ^>=1.3.1 + , hashable ^>=1.4.7 + , haskeline ^>=0.8.2 + , log-effectful ^>=1.0.0 + , megaparsec ^>=9.6.1 + , neat-interpolation ^>=0.5.1 + , optparse-applicative ^>=0.18.1 + , pager ^>=0.1.1 + , parallel ^>=3.2.2 + , path ^>=0.9.5 + , path-io ^>=1.8.2 + , prettyprinter ^>=1.7.1 + , prettyprinter-ansi-terminal ^>=1.1.3 + , radixtree ^>=0.6.0.0 + , resourcet-effectful ^>=1.0.1 + , terminal-size ^>=0.3.4 + , text ^>=2.0.2 + , text-rope ^>=0.3 + , tomland ^>=1.3.3.2 + , unordered-containers ^>=0.2.20 executable hibet import: common-options @@ -198,8 +199,7 @@ test-suite hibet-env other-modules: Paths Paths_hibet - autogen-modules: - Paths_hibet + autogen-modules: Paths_hibet test-suite hibet-parse import: common-options @@ -211,10 +211,8 @@ test-suite hibet-parse , hibet , hspec - other-modules: - Paths_hibet - autogen-modules: - Paths_hibet + other-modules: Paths_hibet + autogen-modules: Paths_hibet benchmark hibet-benchmark import: common-options @@ -241,7 +239,6 @@ benchmark hibet-benchmark Common Lines Paths_hibet - autogen-modules: - Paths_hibet + autogen-modules: Paths_hibet ghc-options: -threaded -rtsopts -with-rtsopts=-N