Move StdIdT out of the StandardT transformer
This commit is contained in:
parent
db5cfa3185
commit
04cf8be650
16
main/Main.hs
16
main/Main.hs
|
@ -31,6 +31,7 @@ import Data.Text.Prettyprint.Doc.Render.Text
|
|||
import Nix
|
||||
import Nix.Convert
|
||||
import qualified Nix.Eval as Eval
|
||||
import Nix.Fresh.Basic
|
||||
import Nix.Json
|
||||
-- import Nix.Lint
|
||||
import Nix.Options.Parser
|
||||
|
@ -97,8 +98,8 @@ main = do
|
|||
NixException frames ->
|
||||
errorWithoutStackTrace
|
||||
. show
|
||||
=<< renderFrames @(StdValue (StandardT IO))
|
||||
@(StdThunk (StandardT IO))
|
||||
=<< renderFrames @(StdValue (StandardT (StdIdT IO)))
|
||||
@(StdThunk (StandardT (StdIdT IO)))
|
||||
frames
|
||||
|
||||
when (repl opts) $ withNixContext Nothing Repl.main
|
||||
|
@ -136,7 +137,7 @@ main = do
|
|||
where
|
||||
printer
|
||||
| finder opts
|
||||
= fromValue @(AttrSet (StdValue (StandardT IO))) >=> findAttrs
|
||||
= fromValue @(AttrSet (StdValue (StandardT (StdIdT IO)))) >=> findAttrs
|
||||
| xml opts
|
||||
= liftIO
|
||||
. putStrLn
|
||||
|
@ -156,7 +157,8 @@ main = do
|
|||
| otherwise
|
||||
= liftIO . print <=< prettyNValue
|
||||
where
|
||||
findAttrs :: AttrSet (StdValue (StandardT IO)) -> StandardT IO ()
|
||||
findAttrs :: AttrSet (StdValue (StandardT (StdIdT IO)))
|
||||
-> StandardT (StdIdT IO) ()
|
||||
findAttrs = go ""
|
||||
where
|
||||
go prefix s = do
|
||||
|
@ -165,7 +167,7 @@ main = do
|
|||
Pure (StdThunk (extract -> Thunk _ _ ref)) -> do
|
||||
let path = prefix ++ Text.unpack k
|
||||
(_, descend) = filterEntry path k
|
||||
val <- readVar @(StandardT IO) ref
|
||||
val <- readVar @(StandardT (StdIdT IO)) ref
|
||||
case val of
|
||||
Computed _ -> pure (k, Nothing)
|
||||
_ | descend -> (k, ) <$> forceEntry path nv
|
||||
|
@ -207,8 +209,8 @@ main = do
|
|||
. (k ++)
|
||||
. (": " ++)
|
||||
. show
|
||||
=<< renderFrames @(StdValue (StandardT IO))
|
||||
@(StdThunk (StandardT IO))
|
||||
=<< renderFrames @(StdValue (StandardT (StdIdT IO)))
|
||||
@(StdThunk (StandardT (StdIdT IO)))
|
||||
frames
|
||||
return Nothing
|
||||
|
||||
|
|
|
@ -207,8 +207,7 @@ instance ( MonadAtomicRef m
|
|||
|
||||
newtype StandardTF r m a
|
||||
= StandardTF (ReaderT (Context r (StdValue r))
|
||||
(StateT (HashMap FilePath NExprLoc)
|
||||
(StdIdT m)) a)
|
||||
(StateT (HashMap FilePath NExprLoc) m) a)
|
||||
deriving
|
||||
( Functor
|
||||
, Applicative
|
||||
|
@ -223,8 +222,8 @@ newtype StandardTF r m a
|
|||
, MonadState (HashMap FilePath NExprLoc)
|
||||
)
|
||||
|
||||
instance MonadTrans (StandardTF m) where
|
||||
lift = StandardTF . lift . lift . lift
|
||||
instance MonadTrans (StandardTF r) where
|
||||
lift = StandardTF . lift . lift
|
||||
|
||||
instance (MonadPutStr r, MonadPutStr m) => MonadPutStr (StandardTF r m)
|
||||
instance (MonadHttp r, MonadHttp m) => MonadHttp (StandardTF r m)
|
||||
|
@ -241,14 +240,13 @@ instance MonadTrans (Fix1T StandardTF) where
|
|||
lift = Fix1T . lift
|
||||
|
||||
-- | This instance is based on the 'StdIdT' layer of 'StandardTF m'.
|
||||
instance MonadAtomicRef m => MonadThunkId (Fix1T StandardTF m) where
|
||||
type ThunkId (Fix1T StandardTF m) = Int
|
||||
freshId = mkStandardT $ lift $ lift freshId
|
||||
instance MonadThunkId m => MonadThunkId (Fix1T StandardTF m) where
|
||||
type ThunkId (Fix1T StandardTF m) = ThunkId m
|
||||
|
||||
mkStandardT
|
||||
:: ReaderT (Context (StandardT m) (StdValue (StandardT m)))
|
||||
(StateT (HashMap FilePath NExprLoc)
|
||||
(StdIdT m)) a
|
||||
m) a
|
||||
-> StandardT m a
|
||||
mkStandardT = Fix1T . StandardTF
|
||||
|
||||
|
@ -256,11 +254,11 @@ runStandardT
|
|||
:: StandardT m a
|
||||
-> ReaderT (Context (StandardT m) (StdValue (StandardT m)))
|
||||
(StateT (HashMap FilePath NExprLoc)
|
||||
(StdIdT m)) a
|
||||
m) a
|
||||
runStandardT (Fix1T (StandardTF m)) = m
|
||||
|
||||
runWithBasicEffects :: (MonadIO m, MonadAtomicRef m)
|
||||
=> Options -> StandardT m a -> m a
|
||||
=> Options -> StandardT (StdIdT m) a -> m a
|
||||
runWithBasicEffects opts =
|
||||
go . (`evalStateT` mempty)
|
||||
. (`runReaderT` newContext opts)
|
||||
|
@ -270,5 +268,5 @@ runWithBasicEffects opts =
|
|||
i <- newVar (1 :: Int)
|
||||
runFreshIdT i action
|
||||
|
||||
runWithBasicEffectsIO :: Options -> StandardT IO a -> IO a
|
||||
runWithBasicEffectsIO :: Options -> StandardT (StdIdT IO) a -> IO a
|
||||
runWithBasicEffectsIO = runWithBasicEffects
|
||||
|
|
|
@ -14,6 +14,7 @@ import Data.Time
|
|||
import Nix
|
||||
import Nix.Exec ( )
|
||||
import Nix.Standard
|
||||
import Nix.Fresh.Basic
|
||||
import System.Environment
|
||||
import System.IO
|
||||
import System.Posix.Files
|
||||
|
@ -21,7 +22,7 @@ import System.Posix.Temp
|
|||
import System.Process
|
||||
import Test.Tasty.HUnit
|
||||
|
||||
hnixEvalFile :: Options -> FilePath -> IO (StdValueNF (StandardT IO))
|
||||
hnixEvalFile :: Options -> FilePath -> IO (StdValueNF (StandardT (StdIdT IO)))
|
||||
hnixEvalFile opts file = do
|
||||
parseResult <- parseNixFileLoc file
|
||||
case parseResult of
|
||||
|
@ -35,11 +36,11 @@ hnixEvalFile opts file = do
|
|||
NixException frames ->
|
||||
errorWithoutStackTrace
|
||||
. show
|
||||
=<< renderFrames @(StdValue (StandardT IO))
|
||||
@(StdThunk (StandardT IO))
|
||||
=<< renderFrames @(StdValue (StandardT (StdIdT IO)))
|
||||
@(StdThunk (StandardT (StdIdT IO)))
|
||||
frames
|
||||
|
||||
hnixEvalText :: Options -> Text -> IO (StdValueNF (StandardT IO))
|
||||
hnixEvalText :: Options -> Text -> IO (StdValueNF (StandardT (StdIdT IO)))
|
||||
hnixEvalText opts src = case parseNixText src of
|
||||
Failure err ->
|
||||
error
|
||||
|
|
Loading…
Reference in New Issue