THSH 0.0.0.2 → 0.0.0.3

raw patch · 8 files changed

+76/−41 lines, 8 filesdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−1
• THSH.cabal +5/−6
• loader/main.hs +2/−2
• src/THSH.hs +10/−0
• src/THSH/Fn.hs +20/−19
• src/THSH/Internal/PyFInternals.hs +1/−1
• src/THSH/Internal/THUtils.hs +22/−9
• src/THSH/Script.hs +6/−3

@@ -1,5 +1,14 @@ # Revision history for THSH -## 0.1.0.0 -- YYYY-mm-dd+## 0.3.0.0 -- WIP++- Built for GHC versions from 9.2.8++## 0.2.0.0 -- 2024-10-14++* Demoed at MuniHac 2024.+* Published to hackage.++## 0.1.0.0 -- 2024-10-13  * First version. Released on an unsuspecting world.

@@ -20,7 +20,7 @@ -- PVP summary:     +-+------- breaking API changes --                  | | +----- non-breaking API additions --                  | | | +--- code changes with no API change-version:            0.0.0.2+version:            0.0.0.3  -- A short (one-line) description of the package. synopsis: A "noDSL" approach to mixing shell scripting with Haskell programs using Template Haskell@@ -44,13 +44,14 @@ -- copyright: category:           System build-type:         Simple+tested-with:        GHC == { 9.10.1, 9.8.2, 9.6.6, 9.4.8, 9.2.8 }  -- Extra doc files to be distributed with the package, such as a CHANGELOG or a README. extra-doc-files:    CHANGELOG.md  source-repository head-  type:              git-  location:          https://github.com/hellwolf/THSH+  type:             git+  location:         https://github.com/hellwolf/THSH  -- Extra source files to be distributed with the package, such as examples, or a tutorial module. -- extra-source-files:@@ -66,10 +67,9 @@  common base-deps     build-depends: ghc >= 9.2.0,-                   base >= 4.17.0.0 && <= 9999.0.0.0,+                   base >= 4.16.0.0 && <= 9999.0.0.0,                    template-haskell - library     import:           warnings, extensions, base-deps @@ -126,7 +126,6 @@      main-is:          Main.hs     build-depends:-        base >=4.17.0.0,         PyF,         THSH     hs-source-dirs:   test

@@ -43,8 +43,8 @@ helpHeader :: String helpHeader = "Usage: thsh script [OPTION...] [--] [args...]" -data Flag = Verbosity   !Int    -- valid values: 0..3; invalid values -> -1-          | UseLanguageEdition String+data Flag = Verbosity !Int    -- valid values: 0..3; invalid values -> -1+          | UseLanguageEdition !String           | DisableBlockArguments           | PrintHelp             deriving (Show, Eq)

@@ -1,3 +1,13 @@+{-|+Module      : THSH+Description : The Template Haskell SHell library.+Copyright   : (c) Miao ZhiCheng, 2024+License     : MIT+Maintainer  : zhicheng.miao@gmail.com+Stability   : experimental+Portability : POSIX+-}+ module THSH   ( module THSH.Funclet   , module THSH.QQ

@@ -8,9 +8,10 @@ Portability : POSIX -} module THSH.Fn-  ( ContentFn (..), stringContentFn, stringContentIOFn, textContentFn, textContentIOFn+  ( FnFunction (..)+  , ContentFn (..), stringContentFn, stringContentIOFn, textContentFn, textContentIOFn   , LineReadFn (..), lineReadFn-  , fn ) where+  , Fn, fn ) where  import           Control.Concurrent      (forkIO) import           Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)@@ -27,11 +28,18 @@ import           THSH.Funclet            (Funclet (..))  --- | A 'Fn' is a function that, given a set of handles to communicate with it, it returns an exit code.+-- | A 'FnFunction' is a function that, given a set of handles to communicate with it, it returns an exit code. class FnFunction f where   runFn :: f -> (Handle, Handle, Handle) -> IO ExitCode --- | A 'Fn' that converts the entire input content to another as 'String'.+-- | The new type wrapper of any "FnFunction" instance.+newtype Fn f = MkFn f++-- | Marker for the thsh quasi-quote to recognize a 'FnFunction' code block.+fn :: FnFunction f => f -> Fn f+fn = MkFn++-- | A 'FnFunction' that converts the entire input content to another as 'String'. data ContentFn m s = MkContentFn (s -> m s) (Handle -> m s) (Handle -> s -> m ())  instance FnFunction (ContentFn IO s) where@@ -48,7 +56,7 @@ stringContentIOFn :: (String -> IO String) -> ContentFn IO String stringContentIOFn f = MkContentFn f hGetContents hPutStr --- | 'ContentFn' for the 'Text' type from the text package.+-- | 'ContentFn' for the 'Data.Text' type from the text package. textContentFn :: (T.Text -> T.Text) -> ContentFn IO T.Text textContentFn f = MkContentFn (pure . f) Data.Text.IO.hGetContents Data.Text.IO.hPutStr @@ -56,14 +64,14 @@ textContentIOFn :: (T.Text -> IO T.Text) -> ContentFn IO T.Text textContentIOFn f = MkContentFn f Data.Text.IO.hGetContents Data.Text.IO.hPutStr --- | A 'Fn' that reads line by line via 'Read' instances of @a@ and accumulates context @b@.+-- | A 'FnFunction' that reads line by line via 'Read' instances of @a@ and accumulates context @b@. data LineReadFn m a b = Read a                       => MkLineReadFn-                         (a -> b -> m (b, Maybe String)) -- read an element; accumulate context; and maybe an output-                         (b -> m (Maybe String))         -- final output-                         b                               -- initial context+                         (a -> b -> m (b, Maybe String)) -- ^ read an element; accumulate context; and maybe an output+                         (b -> m (Maybe String))         -- ^ final output+                         b                               -- ^ initial context --- Idiomatic wrapper for the `MkLineReadFn`+-- | Idiomatic wrapper for the `MkLineReadFn` lineReadFn :: forall a b.               Read a            => (a -> b -> (b, Maybe String))@@ -90,12 +98,8 @@                        True  -> pure Nothing)     pure ExitSuccess --- | 'Fn' wraps a type of 'FnFunction' instance.-data Fn f = FnFunction f => Fn f---- | 'Fn' is a trivial 'Funclet'.-instance Funclet (Fn f) where-  runFunclet (Fn f) cb = do+instance FnFunction f => Funclet (Fn f) where+  runFunclet (MkFn f) cb = do     handles <- newEmptyMVar     _ <- forkIO $ bracket       (do@@ -109,6 +113,3 @@       (\(hInR, hOutW, hErrW) -> mapM_ hClose [hInR, hOutW, hErrW])       (\(hInR, hOutW, hErrW) -> cb =<< runFn f (hInR, hOutW, hErrW))     takeMVar handles--fn :: FnFunction f => f -> Fn f-fn = Fn

@@ -14,7 +14,7 @@  -- ghc modules import           GHC                        (SrcSpan)-import           GHC.TypeError              (ErrorMessage (Text), TypeError)+import           GHC.TypeLits               (ErrorMessage (Text), TypeError) import           Language.Haskell.TH.Syntax (Exp (..), Lit (..), Q (..)) -- baes module import           Data.Kind                  (Type)

@@ -9,15 +9,30 @@   ) where  import           GHC                        (SrcSpan, moduleNameString)-import           GHC.Tc.Errors.Types        (TcRnMessage (TcRnUnknownMessage)) import           GHC.Tc.Types               (TcM) import           GHC.Tc.Utils.Monad         (addErrAt)+#if MIN_VERSION_ghc(9,8,0)+import           GHC.Tc.Errors.Types        (TcRnMessage (TcRnUnknownMessage)) import           GHC.Types.Error            (NoDiagnosticOpts (NoDiagnosticOpts), UnknownDiagnostic (UnknownDiagnostic))+import           GHC.Utils.Error            (mkPlainError, noHints)+import           GHC.Utils.Outputable       (text)+#elif MIN_VERSION_ghc(9,6,0)+import           GHC.Tc.Errors.Types        (TcRnMessage (TcRnUnknownMessage))+import           GHC.Types.Error            (UnknownDiagnostic (UnknownDiagnostic))+import           GHC.Utils.Error            (mkPlainError, noHints)+import           GHC.Utils.Outputable       (text)+#elif MIN_VERSION_ghc(9,4,0)+import           GHC.Driver.Errors.Types    (GhcMessage (GhcPsMessage))+import           GHC.Parser.Errors.Types    (PsMessage (PsUnknownMessage))+import           GHC.Tc.Errors.Types        (TcRnMessage (TcRnUnknownMessage))+import           GHC.Utils.Error            (mkPlainError, noHints)+import           GHC.Utils.Outputable       (text)+#else+import           Data.String                (fromString)+#endif import           GHC.Types.Name             (getOccString, occNameString) import           GHC.Types.Name.Reader      (RdrName (..)) import qualified GHC.Unit.Module            as Module-import           GHC.Utils.Error            (mkPlainError, noHints)-import           GHC.Utils.Outputable       (text) import qualified Language.Haskell.TH        as TH import           Language.Haskell.TH.Syntax (Q (Q)) --@@ -32,14 +47,12 @@ reportErrorAt :: SrcSpan -> String -> Q () reportErrorAt loc msg = unsafeRunTcM $ addErrAt loc msg'   where-#if MIN_VERSION_ghc(9,7,0)+#if MIN_VERSION_ghc(9,8,0)     msg' = TcRnUnknownMessage (UnknownDiagnostic (const NoDiagnosticOpts) (mkPlainError noHints (text msg))) #elif MIN_VERSION_ghc(9,6,0)-    msg' = TcRnUnknownMessage (UnknownDiagnostic $ mkPlainError noHints $-                         text msg)-#elif MIN_VERSION_ghc(9,3,0)-    msg' = TcRnUnknownMessage (GhcPsMessage $ PsUnknownMessage $ mkPlainError noHints $-                         text msg)+    msg' = TcRnUnknownMessage (UnknownDiagnostic $ mkPlainError noHints $ text msg)+#elif MIN_VERSION_ghc(9,4,0)+    msg' = TcRnUnknownMessage (GhcPsMessage $ PsUnknownMessage $ mkPlainError noHints $ text msg) #else     msg' = fromString msg #endif

@@ -36,10 +36,15 @@ import           THSH.Internal.ProcessUtils (binaryCat, pollProcessExitCode)  +-- | A script is a funclet that has its source code and a list of other funclets it depends on. data Script = MkScript { source   :: String                        , funclets :: [AnyFunclet]                        } +-- | Marker for the thsh quasi-quote to recognize a 'Script'.+sh :: Script -> Script+sh = id+ instance Funclet Script where   runFunclet (MkScript { source, funclets }) cb = do     handles <- newEmptyMVar@@ -86,11 +91,9 @@     (hInW, hOutR, hErrR) <- takeMVar handles     pure (hInW, hOutR, hErrR) +-- | The piping code snippet that should substitute the funclet occurrences during quasi quoting. genFuncletPipeCode :: Int -> String genFuncletPipeCode i = "__pipeFunclet " <> (show i)--sh :: Script -> Script-sh = id  {- INTERNAL FUNCTIONS -}