Skip to content

Instantly share code, notes, and snippets.

@sorki
Created June 12, 2020 12:14
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save sorki/10a035089e601045789357f37e7ab89c to your computer and use it in GitHub Desktop.
Save sorki/10a035089e601045789357f37e7ab89c to your computer and use it in GitHub Desktop.
hnix-store-polysemy
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE LambdaCase, BlockArguments #-}
{-# LANGUAGE GADTs, FlexibleContexts, TypeOperators, DataKinds, PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module System.Nix.Store.Poly where
import Polysemy
import Polysemy.Error
import Polysemy.Input
import Polysemy.Output
import Polysemy.Reader
import Polysemy.State
import Data.Text (Text)
import System.Nix.StorePath (StorePath, StorePathSet)
import System.Nix.StorePathMetadata (StorePathMetadata)
import qualified Debug.Trace
import qualified System.Nix.Hash
import qualified System.Nix.Store.Remote
newtype TextName = TextName { unTextName :: Text }
deriving Show
newtype TextBody = TextBody { unTextBody :: Text }
deriving Show
data Store m a where
QueryPathMetadata :: StorePath
-> Store m StorePathMetadata
AddText :: TextName
-> TextBody
-> StorePathSet -- ^ References
-> Bool -- ^ Repair
-> Store m StorePath
makeSem ''Store
remoteStoreToIO :: ( Member (Embed IO) r
, Member (Error String) r
)
=> Sem (Store ': r) a
-> Sem r a
remoteStoreToIO = interpret $ \case
QueryPathMetadata path ->
fromEitherM
$ fst
<$> ( System.Nix.Store.Remote.runStore
$ System.Nix.Store.Remote.queryPathInfoUncached @'System.Nix.Hash.SHA256 path
)
-- needs conversion ValidPath -> StorePathMetadata
--storeToDB = interpret $ \case
-- QueryPathMetadata path ->
data EventLog m a where
TraceEvent :: String -> EventLog m ()
TraceMarker :: String -> EventLog m ()
makeSem ''EventLog
eventLogToIO :: Member (Embed IO) r
=> Sem (EventLog ': r) a
-> Sem r a
eventLogToIO = interpret $ \case
TraceEvent msg -> embed $ Debug.Trace.traceEventIO msg
TraceMarker msg -> embed $ Debug.Trace.traceMarkerIO msg
runEventLog :: Sem (EventLog ': r) a
-> Sem r a
runEventLog = interpret $ \case
TraceEvent msg -> return $ Debug.Trace.traceEvent msg ()
TraceMarker msg -> return $ Debug.Trace.traceMarker msg ()
test = run . runEventLog $ traceMarker "Test marker" >> traceEvent "Test event"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment