packages feed

early (empty) → 0.0.0

raw patch · 8 files changed

+735/−0 lines, 8 filesdep +basedep +containersdep +early

Dependencies added: base, containers, early, ghc, ghc-lib-parser, syb, text, transformers, unordered-containers

Files

+ LICENSE view
@@ -0,0 +1,29 @@+Copyright © 2020 Sky Above Limited+Copyright © 2018 Mark Karpov++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright+  notice, this list of conditions and the following disclaimer in the+  documentation and/or other materials provided with the distribution.++* Neither the name Sky Above Limited, Mark Karpov nor the names of+  contributors may be used to endorse or promote products derived from+  this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY EXPRESS+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES+OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN+NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,+EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,123 @@+# early++Add early return to any `do`-expression++<!-- markdown-toc start - Don't edit this section. Run M-x markdown-toc-refresh-toc -->+**Table of Contents**++- [early](#early)+    - [Description](#description)+    - [How it works](#how-it-works)+    - [Details](#details)+        - [Why not `ExceptT` or exceptions?](#why-not-exceptt-or-exceptions)+    - [Inspiration](#inspiration)+    - [Special thanks](#special-thanks)++<!-- markdown-toc end -->+++## Description++This package is a GHC plugin to add special syntax for early return in+`do`-notation. It provides a way to terminate the current+`do`-expression with a result, usually a failure result, but not+necessarily. It should not be confused with an exception handler. It+uses regular values everywhere.++## How it works++The plugin is enabled in any module via a pragma.++``` haskell+{-# OPTIONS -F -pgmF=early #-}+```++The syntax `?` can be added to the end of any `do` statement to make+it short-circuit when the action produces a certain "stop" result+(such as `Left`, or `Nothing`; **the particular type is type-class+based**, see the Details section below).++Suppose that `grabEnv :: String -> IO (Either Error String)`, then you+can write this:++```haskell+app :: IO (Either Error String)+app = do+  path <- grabEnv "PATH"?+  putStrLn "Look ma, no lifts!"+  magic <- grabEnv "MAGIC"?+  pure (Right (path ++ magic))+```++Note the final `pure` in the do should wrap the type, as the type of+the whole `do`-block has changed.++That's it! See `test/Main.hs` for full example.++## Details++The syntax `stmt?` is desugared in this way:++* `do stmt?; next` becomes `do earlyThen stmt next`+* `do pat <- stmt?; next; next2` becomes `do early stmt (\pat -> do next; next2; ...)`++The `early` and `earlyThen` are driven by the `Early` class, which any+functor-like data type can implement.++``` haskell+early :: (Monad m, Early f) => m (f a) -> (a -> m (f b)) -> m (f b)+earlyThen :: (Monad m, Early f) => m (f a) -> m (f b) -> m (f b)+```++``` haskell+class Functor f => Early f where+  dispatch :: Applicative m => f a -> (a -> m (f b)) -> m (f b)+```++Two provided instances out of the box are `Either e` and `Maybe`, but+others can be added freely, such as a `Failure e a` type of your+library, etc.++### Why not `ExceptT` or exceptions?++Full explanation here:+[my recoverable errors post](https://chrisdone.com/posts/recoverable-errors-in-haskell/).++Because `ExceptT` (or `ContT`) cannot be an+instance of `MonadUnliftIO`. It is not unliftable; this means that+exceptions, cleanup and concurrency don't have an interpretation. This+is an area where monad transformers in `mtl`/`transformers` don't+compose. Other free monads commute, but then you have to use a free+monad which has a complicated story regarding performance.++## Inspiration++The syntax and concept of using simple return values for early+termination and failure handling is inspired+[by Rust's error handling](https://doc.rust-lang.org/rust-by-example/error/result/enter_question_mark.html). The+`Early` class resembles the+[Try trait](https://doc.rust-lang.org/std/ops/trait.Try.html), but is+slightly different, as Haskell has higher-kinded types.++Additionally, one can take a Rust-like view of error handling in+Haskell:++|Use-case|Haskell|Rust|+|---:|---:|---:|+|Unrecoverable errors|Throwing exceptions|Panics|+|Recoverable errors|Return `Either`/`Maybe`|Return `Result`/`Some`|++This plugin allows one to structure their code in such a way.++## Future Work++A small library of short-circuiting `traverse`/`fold` would let one+use actions that return `Either`/`Maybe`.++## Special thanks++The following people's work helped me a lot to get my work done faster:++* Shayne Fletcher and Neil Mitchell https://github.com/digital-asset/ghc-lib+* Oleg Grenrus https://github.com/phadej/idioms-plugins+* Mark Karpov https://github.com/mrkkrp/ghc-syntax-highlighter
+ app/Main.hs view
@@ -0,0 +1,208 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}+{-# OPTIONS_GHC -fno-warn-missing-fields -fno-warn-orphans #-}++-- | This is the preprocessor that extracts ? from the module, retaining+-- their positions, and then passes them to the compiler plugin.+--++-- © 2020 Sky Above Limited+-- © 2018 Mark Karpov++module Main (main) where+import                            Control.Monad+import                            Data.HashMap.Strict (HashMap)+import qualified                  Data.HashMap.Strict as HM+import                            Data.List (foldl')+import qualified                  Data.List as List+import                            Data.Maybe+import                            Data.Text (Text)+import qualified                  Data.Text as T+import qualified                  Data.Text.IO as T+import "ghc-lib-parser"           DynFlags+import qualified "ghc-lib-parser" EnumSet as ES+import "ghc-lib-parser"           FastString (mkFastString)+import "ghc-lib-parser"           GHC.LanguageExtensions+import qualified "ghc-lib-parser" Lexer as L+import "ghc-lib-parser"           SrcLoc+import "ghc-lib-parser"           StringBuffer+import                            System.Environment++main :: IO ()+main = do+  _:input:output:_ <- getArgs+  contents <- T.readFile input -- gather metadata, transform content+  case tokenizeHaskellLoc contents of+    Nothing -> error "Bad lex!"+    Just tokens -> do+      T.writeFile+        output+        (T.concat+           [ "{-# LINE 1 \"" <> T.pack input <> "\" #-}\n"+           , "{-# OPTIONS -fplugin=EarlyPlugin -fplugin-opt=EarlyPlugin:"+           , T.intercalate+               ","+               (map+                  (\Loc {..} ->+                     T.intercalate ":" (map (T.pack . show) [line, col]))+                  qs)+           , " #-}\n"+           , strip (buildlocs qs) contents+           ])+      where qs = questions (filter (not . isComment . fst) tokens)++isComment :: L.Token -> Bool+isComment =+  \case+    L.ITcomment_line_prag -> True+    L.ITdocCommentNext _ -> True+    L.ITdocCommentPrev _ -> True+    L.ITdocCommentNamed _ -> True+    L.ITdocSection _ _ -> True+    L.ITdocOptions _ -> True+    L.ITlineComment _ -> True+    L.ITblockComment _ -> True+    _ -> False++buildlocs :: [Loc] -> HashMap Int [Int]+buildlocs = HM.fromListWith (<>) . map (\Loc{line,col} -> (line,pure col))++-- Keep a running map of lines to cols to delete. Clear the lines+-- after applying them, reducing the map size. Perhaps that's a+-- premature optimization, but it's clean.+strip :: HashMap Int [Int] -> Text -> Text+strip locs0 = T.unlines . snd . List.mapAccumL cut locs0 . zip [1 ..] . T.lines+  where+    cut locs (line, text) =+      if HM.null locs+        then (locs, text)+        else case HM.lookup line locs of+               Nothing -> (locs, text)+               Just cols -> (HM.delete line locs, text')+                 where !text' =+                         foldl'+                           (\text'' col ->+                              T.take (col - 1) text'' <> " " <>+                              T.drop col text'')+                           text+                           cols++questions :: [(L.Token, Maybe t)] -> [t]+questions tokens =+  mapMaybe+    (\((tok, loc), (ntok, _)) -> do+       guard (tok == (L.ITvarsym "?") && isEndOfStatement ntok)+       loc)+    (zip tokens (drop 1 tokens))++-- False negatives are an error, but false positives are fine, they+-- will be rejected in a later stage when more information is+-- available.+--+-- A question-mark can only appear BEFORE the last do statement,+-- therefore the only legitimate token following is a semi! which+-- separates do statements, explicitly or implicitly.+--+-- This would permit also @where x = 1?; y = 2@, but that's fine. It+-- will be flagged up as invalid during the parsing phase in the+-- plugin. We will complain loudly as an error when any remaining ?'s+-- are not resolved during that stage.+--+-- Additionally, it's not in operator position (e.g. x?y); we do not+-- want to pick up valid syntax.+isEndOfStatement :: L.Token -> Bool+isEndOfStatement =+  \case+    L.ITsemi -> True+    _ -> False++deriving instance Eq L.Token+data Loc = Loc+  { line, col :: !Int+  } deriving (Eq, Ord, Show)++tokenizeHaskellLoc :: Text -> Maybe [(L.Token, Maybe Loc)]+tokenizeHaskellLoc input =+  case L.unP pLexer parseState of+    L.PFailed {} -> Nothing+    L.POk _ x -> Just x+  where+    location = mkRealSrcLoc (mkFastString "") 1 1+    buffer = stringToStringBuffer (T.unpack input)+    parseState = L.mkPStatePure parserFlags buffer location+    parserFlags = L.mkParserFlags (foldl' xopt_set initialDynFlags enabledExts)+    initialDynFlags =+      DynFlags+        { warningFlags = ES.empty,+          generalFlags =+            ES.fromList+              [ Opt_Haddock,+                Opt_KeepRawTokenStream+              ],+          extensions = [],+          extensionFlags = ES.empty,+          safeHaskell = Sf_Safe,+          language = Just Haskell2010+        }++pLexer :: L.P [(L.Token, Maybe Loc)]+pLexer = go+  where+    go = do+      r <- L.lexer False return+      case r of+        L _ L.ITeof -> return []+        _ ->+          case fixupToken r of+            x -> (x :) <$> go++fixupToken :: Located L.Token -> (L.Token, Maybe Loc)+fixupToken (L srcSpan tok) = (tok,srcSpanToLoc srcSpan)++srcSpanToLoc :: SrcSpan -> Maybe Loc+srcSpanToLoc (RealSrcSpan rss) =+  let start = realSrcSpanStart rss+   in Just $+      Loc (srcLocLine start) (srcLocCol start)+srcSpanToLoc _ = Nothing++----------------------------------------------------------------------------+-- Language extensions++-- | Language extensions we enable by default.+enabledExts :: [Extension]+enabledExts =+  [ ForeignFunctionInterface,+    InterruptibleFFI,+    CApiFFI,+    Arrows,+    TemplateHaskell,+    TemplateHaskellQuotes,+    ImplicitParams,+    OverloadedLabels,+    ExplicitForAll,+    BangPatterns,+    PatternSynonyms,+    MagicHash,+    RecursiveDo,+    UnicodeSyntax,+    UnboxedTuples,+    UnboxedSums,+    DatatypeContexts,+    TransformListComp,+    QuasiQuotes,+    LambdaCase,+    BinaryLiterals,+    NegativeLiterals,+    HexFloatLiterals,+    TypeApplications,+    StaticPointers,+    NumericUnderscores,+    StarIsType+  ]
+ early.cabal view
@@ -0,0 +1,73 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 7c267bac1eef5336a088a22b865353f3c8f7ac23d785d3fe187d43fb7b5454d4++name:           early+version:        0.0.0+synopsis:       Early return syntax in do-notation (GHC plugin)+description:    Please see the README on GitHub at <https://github.com/inflex-io/early#readme>+category:       Development+homepage:       https://github.com/inflex-io/early#readme+bug-reports:    https://github.com/inflex-io/early/issues+author:         Sky Above Limited+maintainer:     chris@skyabove.io+copyright:      2021 Chris Done+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md++source-repository head+  type: git+  location: https://github.com/inflex-io/early++library+  exposed-modules:+      Control.Early+      Data.Early+      EarlyPlugin+  other-modules:+      Paths_early+  hs-source-dirs:+      src+  ghc-options: -Wall+  build-depends:+      base >=4.7 && <5+    , containers+    , ghc+    , syb+    , text+    , transformers+  default-language: Haskell2010++executable early+  main-is: Main.hs+  other-modules:+      Paths_early+  hs-source-dirs:+      app+  ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+  build-depends:+      base >=4.7 && <5+    , ghc-lib-parser+    , text+    , unordered-containers+  default-language: Haskell2010++test-suite early-test+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      Paths_early+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+  build-depends:+      base >=4.7 && <5+    , early+  default-language: Haskell2010
+ src/Control/Early.hs view
@@ -0,0 +1,48 @@+-- | Early return in monads.++module Control.Early+  ( Early(..)+  , early+  , earlyThen+  ) where++--------------------------------------------------------------------------------+-- Class providing different early return types++-- | A class for things which can offer branching for early return.+--+-- The most obvious two types are 'Either' and 'Maybe'.+class Functor f => Early f where+  dispatch :: Applicative m => f a -> (a -> m (f b)) -> m (f b)++--------------------------------------------------------------------------------+-- Top-level API++-- | Early return specialized on f (for now).+early :: (Monad m, Early f) => m (f a) -> (a -> m (f b)) -> m (f b)+early m f = do+  r <- m+  dispatch r f+{-# INLINE early #-}++-- | Early return specialized on f (for now).+earlyThen :: (Monad m, Early f) => m (f a) -> m (f b) -> m (f b)+earlyThen m f = early m (const f)+{-# INLINE earlyThen #-}++--------------------------------------------------------------------------------+-- Instances++instance Early (Either e) where+  dispatch r f =+    case r of+      Left e -> pure (Left e)+      Right x -> f x+  {-# INLINE dispatch #-}++instance Early Maybe where+  dispatch r f =+    case r of+      Nothing -> pure Nothing+      Just x -> f x+  {-# INLINE dispatch #-}
+ src/Data/Early.hs view
@@ -0,0 +1,40 @@+module Data.Early+  ( FoldableEarly(..)+  , TraversableEarly(..)+  ) where++import           Control.Early+import           Data.Sequence (Seq)+import qualified Data.Sequence as Seq++class Foldable t => FoldableEarly t where+  foldE :: (Monad m, Early f, Applicative f)+        => (x -> a -> m (f x)) -> x -> t a -> m (f x)++instance FoldableEarly [] where+  foldE cons nil0 = go nil0+    where+      go nil [] = pure (pure nil)+      go nil (x:xs) = early (cons nil x) (\x' -> go x' xs)++instance FoldableEarly Seq where+  foldE cons nil0 = go nil0+    where+      go nil Seq.Empty = pure (pure nil)+      go nil (x Seq.:<| xs) = early (cons nil x) (\x' -> go x' xs)++class Traversable t => TraversableEarly t where+  traverseE :: (Monad m, Early f, Applicative f)+            => (a -> m (f b)) -> t a -> m (f (t b))++instance TraversableEarly [] where+  traverseE f = go []+    where+      go acc [] = pure (pure (reverse acc))+      go acc (x:xs) = early (f x) (\x' -> go (x' : acc) xs)++instance TraversableEarly Seq where+  traverseE f = go mempty+    where+      go acc Seq.Empty = pure (pure acc)+      go acc (x Seq.:<| xs) = early (f x) (\x' -> go (acc Seq.:|> x') xs)
+ src/EarlyPlugin.hs view
@@ -0,0 +1,187 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PackageImports #-}+module EarlyPlugin (plugin) where++import                 Control.Monad.IO.Class (MonadIO (..))+import                 Control.Monad.Trans.State.Strict+import qualified       Data.Generics as SYB+import                 Data.Text (Text)+import qualified       Data.Text as T+import qualified "ghc" GhcPlugins as GHC+import "ghc"           HsExtension (GhcPs)+import "ghc"           HsSyn+import "ghc"           OccName+import "ghc"           SrcLoc+import                 Text.Read++plugin :: GHC.Plugin+plugin = GHC.defaultPlugin+    { GHC.parsedResultAction = \cliOptions -> pluginImpl cliOptions+    , GHC.pluginRecompile = GHC.purePlugin+    }++pluginImpl :: [GHC.CommandLineOption] -> GHC.ModSummary -> GHC.HsParsedModule -> GHC.Hsc GHC.HsParsedModule+pluginImpl options _modSummary m = do+  case parseLocs (foldMap T.pack options) of+    Left err -> error err+    Right [] -> pure m+    Right locs -> do+      dflags <- GHC.getDynFlags+      debug $ GHC.showPpr dflags (GHC.hpm_module m)+      debug "===>"+      (hpm_module', locs_found) <-+        runStateT (transform locs dflags (GHC.hpm_module m)) 0+      if locs_found == length locs+        then do+          debug $ show locs+          debug $ GHC.showPpr dflags (hpm_module')+          let module' = m {GHC.hpm_module = hpm_module'}+          return module'+        else do+          -- Later, we can collect the offending locations instead of+          -- simply counting, and emit a more useful error message.+          error "There is a question-mark used in a non-statement position!"++debug :: MonadIO m => String -> m ()+-- debug = liftIO . putStrLn+debug _ = pure ()++transform ::+     [Loc]+  -> GHC.DynFlags+  -> GHC.Located (HsModule GhcPs)+  -> StateT Int GHC.Hsc (GHC.Located (HsModule GhcPs))+transform locs dflags = SYB.everywhereM (SYB.mkM (transformDo dflags locs))++transformDo ::+     GHC.DynFlags+  -> [Loc]+  -> LHsExpr GhcPs+  -> StateT Int GHC.Hsc (LHsExpr GhcPs)+transformDo dflags locs =+  \case+    (L l (HsDo xdo DoExpr (L l' stmts@(_:_)))) -> do+      stmts' <- transformStmts dflags locs stmts+      pure (L l (HsDo xdo DoExpr (L l' stmts')))+    e -> pure e++transformStmts ::+     GHC.DynFlags+  -> [Loc]+  -> [LStmt GhcPs (LHsExpr GhcPs)]+  -> StateT Int GHC.Hsc [LStmt GhcPs (LHsExpr GhcPs)]+transformStmts _ _ [] = pure []+transformStmts dflags locs (current:rest)+  | stmtIsEarly locs current = do+    modify' (+1)+    stmts <- transformStmts dflags locs rest+    pure (transformStmt current stmts)+  | otherwise = fmap (current :) (transformStmts dflags locs rest)++transformStmt ::+     LStmt GhcPs (LHsExpr GhcPs)+  -> [LStmt GhcPs (LHsExpr GhcPs)]+  -> [LStmt GhcPs (LHsExpr GhcPs)]+transformStmt (L stmtloc current) rest =+  case current of+    BodyStmt x lexpr l r ->+      [ L stmtloc+          (BodyStmt+             x+             (L GHC.noSrcSpan+                (HsApp+                   NoExt+                   (L GHC.noSrcSpan+                      (HsApp+                         NoExt+                         (L GHC.noSrcSpan+                            (HsVar NoExt (L GHC.noSrcSpan earlyThenName)))+                         lexpr))+                   (L GHC.noSrcSpan (HsDo NoExt DoExpr (L GHC.noSrcSpan rest)))))+             l+             r)+      ]+    BindStmt x lpat lexpr l r ->+      [ L stmtloc+          (BodyStmt+             x+             (L GHC.noSrcSpan+                (HsApp+                   NoExt+                   (L GHC.noSrcSpan+                      (HsApp+                         NoExt+                         (L GHC.noSrcSpan+                            (HsVar NoExt (L GHC.noSrcSpan earlyName)))+                         lexpr))+                   (makeLambda+                      lpat+                      (L GHC.noSrcSpan+                         (HsDo NoExt DoExpr (L GHC.noSrcSpan rest))))))+             l+             r)+      ]+    _ -> L stmtloc current : rest++-- | Making a lambda took me like 15 minutes of endless types. So this+-- is in a function.+makeLambda :: LPat GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs+makeLambda lpat lexpr =+  L GHC.noSrcSpan+    (HsLam+       NoExt+       (MG+          NoExt+          (L GHC.noSrcSpan+             [ L GHC.noSrcSpan+                 (Match+                    NoExt+                    LambdaExpr+                    [lpat]+                    (GRHSs+                       NoExt+                       [L GHC.noSrcSpan (GRHS NoExt [] lexpr)]+                       (L GHC.noSrcSpan (EmptyLocalBinds NoExt))))+             ])+          GHC.Generated))++stmtIsEarly :: [Loc] -> LStmt GhcPs (LHsExpr GhcPs) -> Bool+stmtIsEarly locs (L l BindStmt {}) = any (flip srcSpanFollowedBy l) locs+stmtIsEarly locs (L l BodyStmt {}) = any (flip srcSpanFollowedBy l) locs+stmtIsEarly _ _ = False++--------------------------------------------------------------------------------+-- Names++earlyName :: GHC.RdrName+earlyName = GHC.mkQual OccName.varName ("Control.Early","early")++earlyThenName :: GHC.RdrName+earlyThenName = GHC.mkQual OccName.varName ("Control.Early","earlyThen")++--------------------------------------------------------------------------------+-- Locations++srcSpanFollowedBy :: Loc -> SrcSpan -> Bool+srcSpanFollowedBy (Loc line col) sp =+  case sp of+    RealSrcSpan s -> srcSpanEndLine s == line + 1 && srcSpanEndCol s == col+    _ -> False++data Loc = Loc+  { line, col :: !Int+  } deriving (Eq, Ord, Show)++parseLocs :: Text -> Either String [Loc]+parseLocs =+  mapM+    ((\case+        [x, y] -> do+          line <- readEither (T.unpack x)+          col <- readEither (T.unpack y)+          pure (Loc {line, col})+        _ -> Left "Expected line:col pattern for input.") .+     T.splitOn ":") .+  T.splitOn ","
+ test/Main.hs view
@@ -0,0 +1,27 @@+{-# OPTIONS -F -pgmF=early #-}++module Main (main) where++import Control.Early+import System.Environment++data Error =+  MissingEnv String+  deriving (Show)++grabEnv :: String -> IO (Either Error String)+grabEnv key = do+  result <- lookupEnv key+  pure (maybe (Left (MissingEnv key)) Right result)++main :: IO ()+main = do+  result <- app+  print result++app :: IO (Either Error String)+app = do+  path <- fmap (maybe (Left (MissingEnv "PATH")) Right) $ lookupEnv "PATH"?+  grabEnv "PWD"?+  magic <- grabEnv "PATH"?+  pure (Right (path ++ magic))