such progress, much wow.
This commit is contained in:
parent
8befc7c94d
commit
f2ca0b1834
GPG Key ID:
057D94F356F41E25
66
app/Main.hs
66
app/Main.hs
@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Main where
|
||||
|
||||
import Text.Printf
|
||||
@ -8,8 +9,12 @@ import Data.List
|
||||
import System.Random
|
||||
import Control.Concurrent
|
||||
import Control.Parallel.Strategies
|
||||
import Control.Monad.Writer
|
||||
import qualified Debug.Trace as Debug
|
||||
import qualified Control.Foldl as F
|
||||
import System.IO
|
||||
import Data.Aeson
|
||||
import qualified Data.ByteString as BS
|
||||
|
||||
import ArbitraryEnzymeTree
|
||||
import Environment
|
||||
@ -38,9 +43,9 @@ exampleEnvironment addedC es pred tox =
|
||||
, maxCompound = maxCompoundWithoutGeneric + addedC
|
||||
, toxicCompounds = tox --[(Produced FPP,0.1)] ++ tox
|
||||
, possibleEnzymes = es -- [pps,fpps] ++ es
|
||||
, settings = Settings { automimicry = True
|
||||
, settings = Settings { automimicry = False
|
||||
, predatorsRandom = False
|
||||
, numPlants = 150
|
||||
, numPlants = 50
|
||||
}
|
||||
}
|
||||
|
||||
@ -63,7 +68,7 @@ exampleEnvironment addedC es pred tox =
|
||||
-- defaultAbsorption = fmap ( limit Phosphor 2
|
||||
-- . limit Nitrate 1
|
||||
-- . limit Sulfur 0
|
||||
-- ) <$> asks soil
|
||||
-- ) <$> fromEnv soil
|
||||
-- -- custom absorbtion with helper-function:
|
||||
-- limit :: Nutrient -> Amount -> (Nutrient, Amount) -> (Nutrient, Amount)
|
||||
-- limit n a (n', a')
|
||||
@ -73,7 +78,7 @@ exampleEnvironment addedC es pred tox =
|
||||
-- Running the simulation
|
||||
-- ----------------------
|
||||
|
||||
loop :: Int -> [Plant] -> Environment -> IO ()
|
||||
loop :: Int -> [Plant] -> Simulation -> IO ()
|
||||
loop loopAmount ps env = loop' loopAmount 0 ps env
|
||||
|
||||
where
|
||||
@ -83,30 +88,39 @@ loop loopAmount ps env = loop' loopAmount 0 ps env
|
||||
Just (_,toxicity) -> (e,"\ESC[38;5;" ++ show (16 + 36*5 + 6*floor (5*(1-toxicity)) + 0) ++ "m" -- yellow -> red rainbow for tocixity 0 -> 1
|
||||
++ padded 50 (show (enzymeName e)) ++ "\ESC[0m")
|
||||
Nothing -> (e, padded 50 (show (enzymeName e)))
|
||||
) <$> possibleEnzymes env
|
||||
) <$> possibleEnzymes (snd env)
|
||||
toxins :: [(Compound, Amount)]
|
||||
toxins = toxicCompounds env
|
||||
toxins = toxicCompounds (snd env)
|
||||
padded i str = take i $ str ++ repeat ' '
|
||||
printEvery = 10
|
||||
loop' :: Int -> Int -> [Plant] -> Environment -> IO ()
|
||||
loop' loopAmount curLoop plants e = unless (loopAmount+1 == curLoop) $ do
|
||||
loop' :: Int -> Int -> [Plant] -> Simulation -> IO ()
|
||||
loop' loopAmount curLoop plants s = unless (loopAmount+1 == curLoop) $ do
|
||||
when (curLoop `mod` printEvery == 0) $ do
|
||||
putStr "\ESC[2J\ESC[H"
|
||||
printEnvironment e
|
||||
printEnvironment (snd env)
|
||||
putStrLn ""
|
||||
putStrLn $ "Generation " ++ show curLoop ++ " of " ++ show loopAmount ++ ":"
|
||||
newPlants <- flip runReaderT e $ do
|
||||
newPlants <- simulate s $ do
|
||||
(!fs,cs) <- unzip <$> fitness plants
|
||||
let fps = zip plants fs -- gives us plants & their fitness in a tuple
|
||||
sumFitness = sum fs
|
||||
spc = meanAndVar `from` sumProducedCompounds $ cs
|
||||
ndc = meanAndVar `from` numDistinctCompounds $ cs
|
||||
fns = meanAndVar `from` id $ fs
|
||||
when (curLoop `mod` printEvery == 0) $ liftIO $ do
|
||||
printPopulation stringe (zip3 plants fs cs)
|
||||
putStrLn $ "Population statistics: VarC = " ++ (padded 50 . show . varianceOfProducedCompounds $ cs)
|
||||
++ " DistC = " ++ (padded 50 . show . meanOfDistinctCompounds $ cs)
|
||||
putStrLn $ "Population statistics (mean,variance):"
|
||||
putStrLn $ "Amount of Components produced = " ++ (padded 50 . show $ spc)
|
||||
putStrLn $ "Number of distinct Components = " ++ (padded 50 . show $ ndc)
|
||||
putStrLn $ "Fitness = " ++ (padded 50 . show $ fns)
|
||||
hFlush stdout
|
||||
threadDelay $ 100*1000 -- sleep x*1000ns (=x ~ ms)
|
||||
threadDelay $ 10*1000 -- sleep x*1000ns (=x ~ ms)
|
||||
tell $ show curLoop
|
||||
++ "," ++ show (fst spc) ++ "," ++ show (snd spc)
|
||||
++ "," ++ show (fst ndc) ++ "," ++ show (snd ndc)
|
||||
++ "," ++ show (fst fns) ++ "," ++ show (snd fns)
|
||||
-- generate x new plants.
|
||||
np <- asks (numPlants . settings)
|
||||
np <- fromEnv (numPlants . settings)
|
||||
sequence . flip fmap [1..np] $ \_ -> do
|
||||
parent' <- liftIO $ randomRIO (0,sumFitness)
|
||||
let
|
||||
@ -119,26 +133,29 @@ loop loopAmount ps env = loop' loopAmount 0 ps env
|
||||
| otherwise = findParent (x-f) ps
|
||||
parent = findParent parent' fps
|
||||
haploMate parent
|
||||
loop' loopAmount (curLoop+1) newPlants e
|
||||
loop' loopAmount (curLoop+1) newPlants s
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
hSetBuffering stdin NoBuffering
|
||||
--hSetBuffering stdout NoBuffering
|
||||
randomCompounds <- makeHead (Substrate PPM) <$> generateTreeFromList 40 (toEnum <$> [(maxCompoundWithoutGeneric+1)..] :: [Compound]) -- generate roughly x compounds
|
||||
randomCompounds <- makeHead (Substrate PPM) <$> generateTreeFromList 30 (toEnum <$> [(maxCompoundWithoutGeneric+1)..] :: [Compound]) -- generate roughly x compounds
|
||||
ds <- randoms <$> newStdGen
|
||||
probs <- randomRs (0.2,0.7) <$> newStdGen
|
||||
--probs <- randomRs (0.2,0.7) <$> newStdGen
|
||||
let poisonedTree = poisonTree ds randomCompounds
|
||||
poisonCompounds = foldMap (\(a,b) -> [(b,a) | a > 0.5]) poisonedTree
|
||||
predators <- generatePredators 0.5 poisonedTree
|
||||
let env = exampleEnvironment (getTreeSize randomCompounds) (generateEnzymeFromTree randomCompounds) (zip predators probs) poisonCompounds
|
||||
emptyPlants = replicate (numPlants . settings $ env) emptyPlant
|
||||
--let env = exampleEnvironment (getTreeSize randomCompounds) (generateEnzymeFromTree randomCompounds) (zip predators probs) poisonCompounds
|
||||
(Just env) <- decodeStrict' <$> BS.readFile "environment2.json"
|
||||
let emptyPlants = replicate (numPlants . settings $ env) emptyPlant
|
||||
enzs <- randomRs (0,length (possibleEnzymes env) - 1) <$> newStdGen
|
||||
let startPlants = randomGenome 1 enzs (possibleEnzymes env) emptyPlants
|
||||
printEnvironment env
|
||||
writeFile "poison.twopi" $ generateDotFromPoisonTree "poison" 0.5 poisonedTree
|
||||
--writeFile "environment.json" . encode $ env
|
||||
putStr "\ESC[?1049h"
|
||||
loop 2000 startPlants env
|
||||
logfile <- openFile "simulation.log" WriteMode
|
||||
loop 2000 startPlants (logfile,env)
|
||||
putStrLn "Simulation ended. Press key to exit."
|
||||
_ <- getChar
|
||||
putStr "\ESC[?1049l"
|
||||
@ -182,8 +199,12 @@ printEnvironment (Environment soil pred metaIter maxComp toxic possEnz settings)
|
||||
printPopulation :: [(Enzyme,String)] -> [(Plant,Double,Vector Amount)] -> IO ()
|
||||
printPopulation es ps = do
|
||||
let padded i str = take i $ str ++ repeat ' '
|
||||
putStr $ padded 50 "Population:"
|
||||
forM_ ps $ \(_,f,_) -> putStr (printColor f '█')
|
||||
n = length ps
|
||||
fitnesses = (\(_,f,_) -> f) <$> ps
|
||||
meanFitness = sum fitnesses / fromIntegral n
|
||||
maxFitness = maximum fitnesses
|
||||
putStr $ padded 50 ("Population: (fitness: mean " ++ padded 5 (show meanFitness) ++ ", max: " ++ padded 5 (show maxFitness) ++ ")")
|
||||
forM_ ps $ \(_,f,_) -> putStr (printColor (f/maxFitness) '█')
|
||||
putStrLn colorOff
|
||||
forM_ es $ \(e,s) -> do
|
||||
putStr s
|
||||
@ -204,6 +225,7 @@ printPopulation es ps = do
|
||||
|
||||
printColor :: Double -> Char -> String
|
||||
printColor x c
|
||||
| x > 1 = "Error: " ++ show x
|
||||
| x*x < 0.5 = "\ESC[38;5;" ++ show (16 + 36*5 + 6*floor (5*2*x') + 0) ++ "m" ++ [c] ++ ""
|
||||
| otherwise = "\ESC[38;5;" ++ show (16 + 36*floor (5*2*(1-x')) + 6*5 + 0) ++ "m" ++ [c] ++ ""
|
||||
-- 32 bit
|
||||
|
||||
@ -28,6 +28,8 @@ dependencies:
|
||||
- pretty-simple
|
||||
- parallel
|
||||
- foldl
|
||||
- aeson
|
||||
- bytestring
|
||||
|
||||
library:
|
||||
source-dirs: src
|
||||
|
||||
@ -1,14 +1,24 @@
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE TypeSynonymInstances #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
module Environment where
|
||||
|
||||
import Data.Functor ((<$>))
|
||||
import Control.Applicative ((<*>))
|
||||
import Control.Monad (forM_)
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Writer.Strict
|
||||
import Control.Parallel.Strategies
|
||||
import Data.List (permutations, subsequences)
|
||||
import Numeric.LinearAlgebra
|
||||
import Text.Printf
|
||||
import System.Random
|
||||
import System.IO
|
||||
import Data.Aeson
|
||||
import GHC.Generics
|
||||
|
||||
import WriterIO
|
||||
|
||||
type Probability = Double
|
||||
type Quantity = Int
|
||||
@ -17,18 +27,27 @@ type Amount = Double
|
||||
|
||||
-- | Nutrients are the basis for any reaction and are found in the environment of the plant.
|
||||
data Nutrient = PPM
|
||||
deriving (Show, Enum, Bounded, Eq)
|
||||
deriving (Show, Enum, Bounded, Eq, Generic)
|
||||
|
||||
instance FromJSON Nutrient
|
||||
instance ToJSON Nutrient
|
||||
|
||||
-- | Fixed, non-generic Components
|
||||
data Component = PP
|
||||
| FPP
|
||||
deriving (Show, Enum, Bounded, Eq)
|
||||
deriving (Show, Enum, Bounded, Eq, Generic)
|
||||
|
||||
instance FromJSON Component
|
||||
instance ToJSON Component
|
||||
|
||||
-- | Compounds are either direct nutrients, already processed components or GenericCompound
|
||||
data Compound = Substrate Nutrient
|
||||
| Produced Component
|
||||
| GenericCompound Int
|
||||
deriving (Show, Eq)
|
||||
deriving (Show, Eq, Generic)
|
||||
|
||||
instance FromJSON Compound
|
||||
instance ToJSON Compound
|
||||
|
||||
instance Enum Compound where
|
||||
toEnum x
|
||||
@ -64,7 +83,10 @@ data Enzyme = Enzyme
|
||||
-- ^ in case of competition for nutrients this denotes the priority
|
||||
-- Nothing = max possible
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
deriving (Show, Eq, Generic)
|
||||
|
||||
instance FromJSON Enzyme
|
||||
instance ToJSON Enzyme
|
||||
|
||||
-- | conviniently make an Enzyme using 1 of the first compund to produce 1 of the second
|
||||
makeSimpleEnzyme :: Compound -> Compound -> Enzyme
|
||||
@ -84,14 +106,20 @@ data Predator = Predator { irresistance :: [Compound]
|
||||
, numAttacks :: Amount
|
||||
-- ^ Avarage number of attacks in a generation of appearance
|
||||
-- (~ mean of poisson-distribution)
|
||||
} deriving (Show, Eq)
|
||||
} deriving (Show, Eq, Generic)
|
||||
|
||||
instance FromJSON Predator
|
||||
instance ToJSON Predator
|
||||
|
||||
-- | Settings to enable/disable parts of the simulation
|
||||
data Settings = Settings { automimicry :: Bool -- ^ do we have automimicry-protection?
|
||||
, predatorsRandom :: Bool -- ^ do predators always appear or according to their random distribution?
|
||||
, numPlants :: Int -- ^ number of plants in starting population
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
deriving (Show, Eq, Generic)
|
||||
|
||||
instance FromJSON Settings
|
||||
instance ToJSON Settings
|
||||
|
||||
-- | The environment itself.
|
||||
|
||||
@ -116,13 +144,26 @@ data Environment =
|
||||
, possibleEnzymes :: [Enzyme]
|
||||
-- ^ All enzymes that can be created by genetic manipulation in this setting.
|
||||
, settings :: Settings
|
||||
} deriving (Show, Eq)
|
||||
} deriving (Show, Eq, Generic)
|
||||
|
||||
instance FromJSON Environment
|
||||
instance ToJSON Environment
|
||||
|
||||
-- helper function. Allows for [0..maxCompoundWithoutGeneric] :: [Compound] with all non-generic Compounds
|
||||
maxCompoundWithoutGeneric :: Int
|
||||
maxCompoundWithoutGeneric = fromEnum (maxBound :: Nutrient) + fromEnum (maxBound :: Component) + 1
|
||||
|
||||
type World a = ReaderT Environment IO a
|
||||
type Simulation = (Handle, Environment)
|
||||
type World a = WriterIOT (ReaderT Simulation IO) a
|
||||
|
||||
instance HasHandle (WriterIOT (ReaderT Simulation IO)) where
|
||||
getHandle = asks fst
|
||||
|
||||
fromEnv :: (Environment -> a) -> World a
|
||||
fromEnv f = asks $ f . snd
|
||||
|
||||
simulate :: Simulation -> World a -> IO a
|
||||
simulate (log, e) = fmap fst . flip runReaderT (log,e) . runWriterT . getWriterT
|
||||
|
||||
-- Plants
|
||||
-- ------
|
||||
@ -158,15 +199,15 @@ fitness ps = do
|
||||
nutrients <- mapM absorbNutrients ps -- absorb soil
|
||||
products <- sequenceA $ zipWith produceCompounds ps nutrients -- produce compounds
|
||||
ds <- liftIO $ randoms <$> newStdGen
|
||||
preds <- asks predators
|
||||
randPred <- asks (predatorsRandom . settings)
|
||||
preds <- fromEnv predators
|
||||
randPred <- fromEnv (predatorsRandom . settings)
|
||||
let
|
||||
appearingPredators = if randPred then
|
||||
fmap (fst . fst) . filter (\((_,p),r) -> p > r) $ zip preds ds -- assign one probability to each predator, filter those who appear, throw random data away again.
|
||||
-- appearingPredators is now a sublist of preds without the probability.
|
||||
else
|
||||
fst <$> preds -- else just forget about probabilities
|
||||
automimicry <- asks (automimicry . settings)
|
||||
automimicry <- fromEnv (automimicry . settings)
|
||||
popDefense <- if automimicry then
|
||||
forM appearingPredators $ \p -> do
|
||||
as <- mapM (dieToPredator p) products -- how good can an individual deter p
|
||||
@ -176,7 +217,7 @@ fitness ps = do
|
||||
dieRate <- mapM (dieToPredators (zip appearingPredators popDefense)) products -- defeat predators with produced compounds
|
||||
let sumEnzymes = sum . fmap (\(_,q,a) -> fromIntegral q*a) . genome <$> ps -- amount of enzymes * activation = resources "wasted"
|
||||
staticCostOfEnzymes = (\x -> 1 - 0.02*x) <$> sumEnzymes -- static cost of creating enzymes
|
||||
nutrientsAvailable <- fmap snd <$> asks soil
|
||||
nutrientsAvailable <- fmap snd <$> fromEnv soil
|
||||
let nutrientsLeft = (\p -> [p ! i | i <- [0..fromEnum (maxBound :: Nutrient)]]) <$> products
|
||||
nutrientRatio = minimum . zipWith (flip (/)) nutrientsAvailable <$> nutrientsLeft
|
||||
costOfEnzymes = max 0 <$> zipWith (\s n -> s-n*0.1) staticCostOfEnzymes nutrientRatio -- cost to keep enzymes are static costs + amount of nutrient sucked out of the primary cycle
|
||||
@ -186,8 +227,8 @@ fitness ps = do
|
||||
|
||||
produceCompounds :: Plant -> [(Nutrient, Amount)] -> World (Vector Amount)
|
||||
produceCompounds (Plant genes _) substrate = do
|
||||
numIter <- asks metabolismIteration
|
||||
numCompounds <- asks maxCompound
|
||||
numIter <- fromEnv metabolismIteration
|
||||
numCompounds <- fromEnv maxCompound
|
||||
let
|
||||
initialAmount = assoc (numCompounds+1) 0 ((\(n,a) -> (fromEnum $ Substrate n,a)) <$> substrate) :: Vector Amount
|
||||
enzymes = (\(e,q,a) -> (synthesis e,fromIntegral q*a)) <$> genes -- [(((Component,Amount),(Component,Amount)),q*a)], Amount got * by quantity & activation
|
||||
@ -218,7 +259,7 @@ dieToPredators appearingPredators compounds = do
|
||||
|
||||
dieToPredator :: Predator -> Vector Amount -> World Double
|
||||
dieToPredator p comps = do
|
||||
toxins <- asks toxicCompounds
|
||||
toxins <- fromEnv toxicCompounds
|
||||
return $ product [1 - min 1 (comps ! fromEnum t * l) | (t,l) <- toxins, t `elem` irresistance p]
|
||||
|
||||
-- Mating & Creation of diversity
|
||||
@ -239,7 +280,7 @@ haploMate (Plant genes abs) = do
|
||||
r3 <- liftIO ((randoms <$> newStdGen) :: IO [Double])
|
||||
r4 <- liftIO digen
|
||||
r5 <- liftIO digen
|
||||
enzymes <- asks possibleEnzymes
|
||||
enzymes <- fromEnv possibleEnzymes
|
||||
re1 <- liftIO ((randomRs (0,length enzymes - 1) <$> newStdGen) :: IO [Int])
|
||||
re2 <- liftIO ((randomRs (0,length enzymes - 1) <$> newStdGen) :: IO [Int])
|
||||
let
|
||||
@ -288,7 +329,7 @@ haploMate (Plant genes abs) = do
|
||||
|
||||
-- | Plant with no secondary metabolism with unlimited extraction from environment.
|
||||
emptyPlant :: Plant
|
||||
emptyPlant = Plant [] (asks soil)
|
||||
emptyPlant = Plant [] (fromEnv soil)
|
||||
|
||||
getAmountOf :: Compound -> [(Compound, Amount)] -> Amount
|
||||
getAmountOf c = sum . fmap snd . filter ((== c) . fst)
|
||||
|
||||
@ -1,5 +1,9 @@
|
||||
module Evaluation ( varianceOfProducedCompounds
|
||||
, meanOfDistinctCompounds
|
||||
module Evaluation
|
||||
( sumProducedCompounds
|
||||
, numDistinctCompounds
|
||||
, sumCompounds
|
||||
, from
|
||||
, meanAndVar
|
||||
) where
|
||||
|
||||
import Control.Foldl as F
|
||||
@ -10,11 +14,31 @@ import Environment
|
||||
eps :: Amount
|
||||
eps = 0.01
|
||||
|
||||
varianceOfProducedCompounds :: [LA.Vector Amount] -> Double
|
||||
varianceOfProducedCompounds comps = F.fold F.variance $ sumElements <$> comps
|
||||
-- | sum of produced compounds ignoring everything defined as 'Nutrient'.
|
||||
sumProducedCompounds :: Functor f => f (LA.Vector Amount) -> f Amount
|
||||
-- sumProducedCompounds :: [LA.Vector Amount] -> [Amount]
|
||||
-- cut off numNutrients from the start of the vector and then sum.
|
||||
sumProducedCompounds = fmap $ (\v -> sumElements . LA.subVector numNutrients (size v - numNutrients) $ v)
|
||||
where
|
||||
numNutrients = fromEnum (maxBound :: Nutrient) + 1 --enum starts at 0, subVector-indexing at 1
|
||||
|
||||
-- | sum of all compounds
|
||||
sumCompounds :: Functor f => f (LA.Vector Amount) -> f Amount
|
||||
--sumCompounds :: [LA.Vector Amount] -> [Amount]
|
||||
sumCompounds = fmap sumElements
|
||||
|
||||
-- | count compound as active if it is over eps.
|
||||
meanOfDistinctCompounds :: [LA.Vector Amount] -> Double
|
||||
meanOfDistinctCompounds comps = F.fold F.mean $ sumElements . LA.cmap (\x -> if abs x < eps then 0 else 1) <$> comps
|
||||
numDistinctCompounds :: Functor f => f (LA.Vector Amount) -> f Amount
|
||||
--numDistinctCompounds :: [LA.Vector Amount] -> [Amount]
|
||||
numDistinctCompounds comps = sumElements . LA.cmap (\x -> if abs x < eps then 0 else 1) <$> comps
|
||||
|
||||
-- TODO: Mean enzyme-activity?
|
||||
-- | helper function for Foldl-Package.
|
||||
--
|
||||
-- Usage: @F.mean `from` sumCompounds $ v@ where v is a Set/List/Vector/... of Vector of Compounds.
|
||||
infixr 9 `from`
|
||||
from :: Foldable f => F.Fold a b -> (c -> f a) -> c -> b
|
||||
from f w b = F.fold f (w b)
|
||||
|
||||
-- | helper to get mean and variance in a single pass.
|
||||
meanAndVar :: F.Fold Amount (Amount,Amount)
|
||||
meanAndVar = (,) <$> F.mean <*> F.variance
|
||||
|
||||
27
src/WriterIO.hs
Normal file
27
src/WriterIO.hs
Normal file
@ -0,0 +1,27 @@
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
module WriterIO (
|
||||
WriterIOT(..)
|
||||
, HasHandle(..)
|
||||
) where
|
||||
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.State
|
||||
import Control.Monad.Writer.Strict
|
||||
import System.IO
|
||||
|
||||
newtype WriterIOT m a = WriterIOT { getWriterT :: WriterT () m a }
|
||||
deriving (Functor, Applicative, Monad, MonadIO, MonadTrans, MonadReader r, MonadState s)
|
||||
|
||||
class HasHandle m where
|
||||
getHandle :: m Handle
|
||||
|
||||
instance (MonadIO m, HasHandle (WriterIOT m)) => MonadWriter String (WriterIOT m) where
|
||||
tell w = do
|
||||
h <- getHandle
|
||||
liftIO $ hPutStrLn h w
|
||||
listen = fmap (\a -> (a,error "cannot read from already written stuff"))
|
||||
pass = fmap fst
|
||||
Loading…
Reference in New Issue
Block a user