Haskell UUID generation - haskell

I am new to Haskell and need help. I am trying to build a new data type that has to be somehow unique, so I decided to use UUID as a unique identifier:
data MyType = MyType {
uuid :: UUID,
elements :: AnotherType
}
in this way, I can do following:
instance Eq MyType where
x == y = uuid x == uuid y
x /= y = not (x == y)
The problem is that all known (to me) UUID generators produce IO UUID, but I need to use it in a pure code as mentioned above. Could you please suggest if there is any way to extract UUID out of IO UUID, or maybe be there is a better way to do what I need in Haskell? Thanks.
UPDATE
Thanks for all the great suggestions and the code example. From what is posted here I can say you cannot break a referential transparency, but there are smart ways how to solve the problem without breaking it and, probably the most optimal one, is listed in the answer below.
There is also one alternative approach that I was able to explore myself based on provided recommendations with the usage of State Monad:
type M = State StdGen
type AnotherType = String
data MyType = MyType {
uuid :: UUID,
elements :: AnotherType
} deriving (Show)
mytype :: AnotherType -> M MyType
mytype x = do
gen <- get
let (val, gen') = random gen
put gen'
return $ MyType val x
main :: IO ()
main = do
state <- getStdGen
let (result, newState) = runState (mytype "Foo") state
putStrLn $ show result
let (result', newState') = runState (mytype "Bar") newState
setStdGen newState'
putStrLn $ show result'
Not sure if it is the most elegant implementation, but it works.

If you're looking at the functions in the uuid package, then UUID has a Random instance. This means that it's possible to generate a sequence of random UUIDs in pure code using standard functions from System.Random using a seed:
import System.Random
import Data.UUID
someUUIDs :: [UUID]
someUUIDs =
let seed = 123
g0 = mkStdGen seed -- RNG from seed
(u1, g1) = random g0
(u2, g2) = random g1
(u3, g3) = random g2
in [u1,u2,u3]
Note that someUUIDs creates the same three "unique" UUIDs every time it's called because the seed is hard-coded.
As with all pure Haskell code, unless you cheat (using unsafe functions), you can't expect to generate a sequence of actually unique UUIDs without explicitly passing some state (in this case, a StdGen RNG) between calls to random.
The usual solution to avoid the ugly boilerplate of passing the generator around is to run at least part of your code within a monad that can maintain the needed state. Some people like to use the MonadRandom package, though you can also use the regular State monad with a StdGen somewhere in the state. The main advantages of MonadRandom over State is that you get some dedicated syntax (getRandom) and can create a monad stack that includes both RandomT and StateT so you can separate your RNG state from the rest of your application state.
Using MonadRandom, you might write an application like:
import Control.Monad.Random.Strict
import System.Random
import Data.UUID
-- monad for the application
type M = Rand StdGen
-- get a generator and run the application in "M"
main :: IO ()
main = do
g <- getStdGen -- get a timestamp-seeded generator
let log = evalRand app g -- run the (pure) application in the monad
putStr log
-- the "pure" application, running in monad "M"
app :: M String
app = do
foo <- myType "foo"
bar <- myType "bar"
-- do some processing
return $ unlines ["Results:", show foo, show bar]
type AnotherType = String
data MyType = MyType {
uuid :: UUID,
elements :: AnotherType
} deriving (Show)
-- smart constructor for MyType with unique UUID
myType :: AnotherType -> M MyType
myType x = MyType <$> getRandom <*> pure x
Note that substantial parts of the application will need to be written in monadic syntax and run in the application M monad. This isn't a big restriction -- most non-trivial applications are going to be written in some monad.

Related

Generate a sequential or random value each time a function is called

I need to make each instance of Sphere get a unique identifier so that no two Spheres are equal. I won't know ahead of time how many spheres I'll need to make so will need to make them one at a time, but still increment the identifier.
Most solutions I've tried have this issue where I end up with an IO a and need the unsafePerformIO to get the value.
This code comes close, but the resulting identifier is always the same:
module Shape ( Sphere (..)
, sphere
, newID
) where
import System.Random
import System.IO.Unsafe (unsafePerformIO)
data Sphere = Sphere { identifier :: Int
} deriving (Show, Eq)
sphere :: Sphere
sphere = Sphere { identifier = newID }
newID :: Int
newID = unsafePerformIO (randomRIO (1, maxBound :: Int))
This would work as well, and works great in the REPL, but when I put it in a function, it only returns a new value the first time and the same value after that.
import Data.Unique
sphere = Sphere { identifier = (hashUnique $ unsafePerformIO newUnique) }
I know think this all leads to the State Monad, but I don't understand that yet. Is there no other way that will "get the job done", without biting off all the other monad stuff?
First of all, don’t use unsafePerformIO here. It doesn’t do what you want anyway: it doesn’t “get the a out of an IO a”, since an IO a doesn’t contain an a; rather, unsafePerformIO hides an IO action behind a magical value that executes the action when somebody evaluates the value, which could happen multiple times or never because of laziness.
Is there no other way that will "get the job done", without biting off all the other monad stuff?
Not really. You’re going to have to maintain some kind of state if you want to generate unique IDs. (You may be able to avoid needing unique IDs altogether, but I don’t have enough context to say.) State can be handled in a few ways: manually passing values around, using State to simplify that pattern, or using IO.
Suppose we want to generate sequential IDs. Then the state is just an integer. A function that generates a fresh ID can simply take that state as input and return an updated state. I think you’ll see straight away why that’s too simple, so we tend to avoid writing code like this:
-- Differentiating “the next-ID state” from “some ID” for clarity.
newtype IdState = IdState Id
type Id = Int
-- Return new sphere and updated state.
newSphere :: IdState -> (Sphere, IdState)
newSphere s0 = let
(i, s1) = newId s0
in (Sphere i, s1)
-- Return new ID and updated state.
newId :: IdState -> (Id, IdState)
newId (IdState i) = (i, IdState (i + 1))
newSpheres3 :: IdState -> ((Sphere, Sphere, Sphere), IdState)
newSpheres3 s0 = let
(sphere1, s1) = newSphere s0
(sphere2, s2) = newSphere s1
(sphere3, s3) = newSphere s2
in ((sphere1, sphere2, sphere3), s3)
main :: IO ()
main = do
-- Generate some spheres with an initial ID of 0.
-- Ignore the final state with ‘_’.
let (spheres, _) = newSpheres3 (IdState 0)
-- Do stuff with them.
print spheres
Obviously this is very repetitive and error-prone, since we have to pass the correct state along at each step. The State type has a Monad instance that abstracts out this repetitive pattern and lets you use do notation instead:
import Control.Monad.Trans.State (State, evalState, state)
newSphere :: State IdState Sphere
newSphere = do
i <- newId
pure (Sphere i)
-- or:
-- newSphere = fmap Sphere newId
-- newSphere = Sphere <$> newId
-- Same function as before, just wrapped in ‘State’.
newId :: State IdState Id
newId = state (\ (IdState i) -> (i, IdState (i + 1)))
-- Much simpler!
newSpheres3 :: State IdState (Sphere, Sphere, Sphere)
newSpheres3 = do
sphere1 <- newSphere
sphere2 <- newSphere
sphere3 <- newSphere
pure (sphere1, sphere2, sphere3)
-- or:
-- newSpheres3 = (,,) <$> newSphere <*> newSphere <*> newSphere
main :: IO ()
main = do
-- Run the ‘State’ action and discard the final state.
let spheres = evalState newSpheres3 (IdState 0)
-- Again, do stuff with the results.
print spheres
State is what I would reach for normally, since it can be used within pure code, and combined with other effects without much trouble using StateT, and because it’s actually immutable under the hood, just an abstraction on top of passing values around, you can easily and efficiently save and roll back states.
If you want to use randomness, Unique, or make your state actually mutable, you generally have to use IO, because IO is specifically about breaking referential transparency like that, typically by interacting with the outside world or other threads. (There are also alternatives like ST for putting imperative code behind a pure API, or concurrency APIs like Control.Concurrent.STM.STM, Control.Concurrent.Async.Async, and Data.LVish.Par, but I won’t go into them here.)
Fortunately, that’s very similar to the State code above, so if you understand how to use one, it should be easier to understand the other.
With random IDs using IO (not guaranteed to be unique):
import System.Random
newSphere :: IO Sphere
newSphere = Sphere <$> newId
newId :: IO Id
newId = randomRIO (1, maxBound :: Id)
newSpheres3 :: IO (Sphere, Sphere, Sphere)
newSpheres3 = (,,) <$> newSphere <*> newSphere <*> newSphere
main :: IO ()
main = do
spheres <- newSpheres3
print spheres
With Unique IDs (also not guaranteed to be unique, but unlikely to collide):
import Data.Unique
newSphere :: IO Sphere
newSphere = Sphere <$> newId
newId :: IO Id
newId = hashUnique <$> newUnique
-- …
With sequential IDs, using a mutable IORef:
import Data.IORef
newtype IdSource = IdSource (IORef Id)
newSphere :: IdSource -> IO Sphere
newSphere s = Sphere <$> newId s
newId :: IdSource -> IO Id
newId (IdSource ref) = do
i <- readIORef ref
writeIORef ref (i + 1)
pure i
-- …
You’re going to have to understand how to use do notation and functors, applicatives, and monads at some point, because that’s just how effects are represented in Haskell. You don’t necessarily need to understand every detail of how they work internally in order to just use them, though. I got pretty far when I was learning Haskell with some rules of thumb, like:
A do statement can be:
An action: (action :: m a)
Often m () in the middle
Often pure (expression :: a) :: m a at the end
A let binding for expressions: let (var :: a) = (expression :: a)
A monadic binding for actions: (var :: a) <- (action :: m a)
f <$> action applies a pure function to an action, short for do { x <- action; pure (f x) }
f <$> action1 <*> action2 applies a pure function of multiple arguments to multiple actions, short for do { x <- action1; y <- action2; pure (f x y) }
action2 =<< action1 is short for do { x <- action1; action2 x }

QuickCheck sequential Map key generation

I am trying to test a logic of custom data type. It receives a Map Int String as a parameter and then I need to add an element into the Map inside the object.
Type declaration and insertion function look like this:
import qualified Data.IntMap.Strict as M
import Data.UUID (UUID)
import Control.Monad.State
import System.Random
type StrMap = M.IntMap String
type MType = State StdGen
data MyType = MyType {
uuid :: UUID,
strs :: StrMap
} deriving (Show)
create :: StrMap -> MType MyType
create pm = do
state <- get
let (uuid, newState) = random state
put newState
return $ MyType uuid pm
strsSize :: MyType -> Int
strsSize e = M.size $ strs e
addStr :: MyType -> String -> MyType
addStr e p = e { strs = M.insert (strsSize e) p $ strs e }
It is important to have sequential keys in the Map, so having [0, 1, 3] is not acceptable.
I was trying to test it using HSpec with QuickCheck:
main :: IO ()
main = hspec spec
spec :: Spec
spec = describe "Creation and update" $ do
QuickCheck.prop "Check map addition" $ do
\xs str -> monadicIO $ do
state <- run(getStdGen)
let (result, newState) = runState (create xs) state
run(setStdGen newState)
let result' = addStr result str
assert $ (strsSize result) + 1 == strsSize result' -- fails here
The problem is that QuickCheck generates random keys and I am not sure how do I force it to generate a sequential keys for the Map. The problem with absense of the sequense is that function addStr may override values in case of repetetive keys, which is not desirable behavior.
UPDATE
Thanks for all the help! After a long discussion and some kind of a thinking I ended up with the following solution:
spec :: Spec
spec = describe "Creation and update" $ do
QuickCheck.prop "Check map addition" $ do
\xs str -> not (null xs) Property.==> monadicIO $ do
state <- run(getStdGen)
let mp = M.fromList $ zip [0..(length xs)] xs
let (result, newState) = runState (create mp) state
run(setStdGen newState)
let result' = addStr result str
assert $ (strsSize result) + 1 == strsSize result'
Basically, I had to generate some random set of strings and them convert in into a map manually. It is probably not the most elegant solution, but it works as needed.
Instead of using QuickCheck to generate arbitrary data that satisfies some complex invariant, which can be difficult, you can use QuickCheck to generate fully arbitrary data from which you can then construct data that satisfies the invariant (by some method external to the system being tested which you trust to be correct).
The invariant in this case is given as "keys must be contiguous", but is actually "keys must be contiguous and start from 0". This is sufficient, but more than necessary. The minimal invariant required by addStr is "the map must not contain a key that is the size of the map", since that is the key we intend to insert. By simplifying the constraint, we also make it easier to satisfy: we can generate an arbitrary map (which may contain the bad key) and then delete the bad key, giving a satisfactory map.
I'll also note that the UUID (and thus the mechanism for generating it, which requires State and perhaps IO) is irrelevant to the property being tested. This means we can construct the MyType with any UUID we have lying around (like the nil UUID provided by the package) and avoid the monadic stuff:
spec :: Spec
spec = describe "Creation and update" $ do
QuickCheck.prop "Check map addition" $ do
\strmap -> -- we don't actually care what the String being inserted is for this test
let myType = MyType UUID.nil (M.delete (M.size strmap) strmap) -- Enforce the invariant
in assert $ strsSize (addStr myType "") = strsSize myType + 1
If you wanted to, you could also make an instance of Arbitrary for MyType that does something like this, or something that satisfies the stronger invariant (which may be required for other tests). I'll leave that as an exercise for you, but feel free to ask more questions if you get stuck trying it.

Haskell Type Polymorphism -- Mapping to String

I am new to Haskell, so maybe I am missing some fundamental concepts here (or maybe failed to find the appropriate extension). I was wondering if there was a way to optimize or further abstract the following scenario. This code seems very redundant.
Let's say I have the following data classes:
data Person = Person
{ personName :: !String
, personAge :: !Int
} deriving Show
data Dog = Dog
{ dogName :: !String
, dogAge :: !Int
} deriving Show
Let's say I have a service and I'm only concerned with outputing records as strings. In reality, the strings will probably be JSON and the records fetched from the DB, but let's take a simpler case. I basically need a URL token to fetch an appropriate object (say, the string "dog" will get me a Dog, or even just the Haskell "show" string, without expressly declaring it as (value)::Dog).
I have attempted to implement this in several ways...the only thing that seems to work is the following:
data Creature = DogC Dog
| PersonC Person
deriving Show
fromString :: String -> Maybe Creature
fromString "dog" = Just $ DogC $ Dog "muffin" 8
fromString "person" = Just $ PersonC $ Person "John" 22
fromString _ = Nothing
main :: IO ()
main = do
putStrLn $ show $ fromString "dog"
I'm not entirely fond of the new type, nor the list of fromString declarations. And to benefit from the original data declarations, I would probably need to write a similarly tedious expression (eg, "fromCreature") to revert Creature back into my original types. This information might change, so I would probably need TH for a few of the declarations...
Is there a way around some of this? I fiddled with GADTs and classes, but both seemed to be dependent on type- rather than value- based polymorphism (A string identifier tends to cause issues with ambiguous instances). It would be nice to map the constructor to a string (Say, with Data.Map), but constructors often have different kinds.
Update
So, I went with an approach that isn't exactly relevant to the question I had asked, but it may be useful to someone. I did want to maintain some record types, but most didn't add much value and were getting in my way. The steps I had followed went something like:
Use a different/lower-level DB driver, that returns workable types (eg, [ColumnDef] and [[SQLValue]] instead of tuples and records...).
Create ToJSON instances for SQLValue -- most of the types were covered, except a few ByteString types, and I had to handle the conversion of SQLNull to Null. To maintain compatibility with some record types, my default handler looked like: toJSON = genericToJSON defaultOptions { sumEncoding = UnTaggedValue} The untagged value should allow one to read the JSON into defined data types (eg, Dog / Person ) if desired....
Given that column name is accessible from ColumnDef, I wrote an expression that zips [ColumnDef] and [SqlValue] to a list of Aeson-compatible key-value pairs, eg: toJsPairs :: [ColumnDef] -> [SqlValue] -> [(Text,Value)]
Then, I wrote an expression to fetch the JSON from a table name, which more or less serves as my "universal dispatcher." It references a list of authorized tables, so it's less crazy than it might sound.
The code looked a bit like this (using mysql-haskell).
{-# LANGUAGE OverloadedStrings #-}
import qualified Control.Applicative as App
import Database.MySQL.Base
import qualified System.IO.Streams as Streams
import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson.Encode.Pretty (encodePretty)
import Data.Aeson.Types
import Data.Text.Encoding
import Data.String (fromString)
import Data.ByteString.Internal
import qualified Data.ByteString.Lazy.Internal as BLI
import Data.HashMap.Strict (fromList)
appConnectInfo = defaultConnectInfo {
ciUser = "some_user"
, ciPassword = "some_password"
, ciDatabase = "some_db"
}
instance FromJSON ByteString where
parseJSON (String s) = pure $ encodeUtf8 s
parseJSON _ = App.empty
instance ToJSON ByteString where
toJSON = String . decodeUtf8
instance ToJSON MySQLValue where
toJSON (MySQLNull) = Null
toJSON x = genericToJSON defaultOptions
{ sumEncoding = UntaggedValue } x
-- This expression should fail on dimensional mismatch.
-- It's stupidly lenient, but really dimensional mismatch should
-- never occur...
toJsPairs :: [ColumnDef] -> [MySQLValue] -> [(Text,Value)]
toJsPairs [] _ = []
toJsPairs _ [] = []
toJsPairs (x:xs) (y:ys) = (txt x, toJSON y):toJsPairs xs ys
where
-- Implement any modifications to the key names here
txt = decodeUtf8.columnName
listRecords :: String -> IO BLI.ByteString
listRecords tbl = do
conn <- connect appConnectInfo
-- This is clearly an injection vulnerability.
-- Implemented, however, the values for 'tbl' are intensely
-- vetted. This is just an example.
(defs, is) <- query_ conn $ fromString ( "SELECT * FROM `" ++ tbl ++ "` LIMIT 100")
rcrds <- Streams.toList is
return $ encodePretty $ map (jsnobj defs) rcrds
where
jsnobj :: [ColumnDef] -> [MySQLValue] -> Value
jsnobj defs x = Object $ fromList $ toJsPairs defs x
If what you want to consume at the end is json value - it might make sense to
represent result as json value using aeson library:
{-# LANGUAGE DeriveGeneric #-}
import Data.Aeson
import GHC.Generics
data Dog = Dog Int String deriving (Show, Generic)
data Cat = Cat Int String deriving (Show, Generic)
-- here I'm using instance derived with generics, but you can write one by
-- hands
instance ToJSON Dog
instance ToJSON Cat
-- actions to get stuff from db
getDog :: Monad m => Int -> m Dog
getDog i = return (Dog i (show i))
getCat :: Monad m => Int -> m Cat
getCat i = return (Cat i (show i))
-- dispatcher - picks which action to use
getAnimal :: Monad m => String -> Int -> m (Maybe Value)
getAnimal "dog" i = Just . toJSON <$> getDog i
getAnimal "cat" i = Just . toJSON <$> getCat i
getAnimal _ _ = return Nothing
main :: IO ()
main = do
getAnimal "dog" 2 >>= print
getAnimal "cat" 3 >>= print
getAnimal "chupakabra" 12 >>= print
High energy magic version
class Monad m => MonadAnimal m where
-- basically you want something that fetches extra argumets from HTTP or
-- whatevere, perform DB query and so on.
class Animal a where
animalName :: Proxy a -> String
animalGetter :: MonadAnimal m => m a
locateAnimals :: MonadAnimal m => Q [(String, m Value)]
locateAnimals -- implement using TH (reify function is your friend). It should look for
-- all the animal instances in scope and make a list from them with serialized
-- fetcher.
-- with that in place dispatcher should be easy to implement

Generating random strings from a string-pool using QuickCheck

Consider the problem of generating strings out our a set of possible strings, in such a way that once a string is chosen, it cannot be repeated again. For this task I would like to use QuickCheck's Gen functions.
If I look at the type of the function I'm trying to write, it looks pretty much like a state monad. Since I'm using another monad, namely Gen , inside the state monad. I wrote my first attempt using StateT.
arbitraryStringS :: StateT GenState Gen String
arbitraryStringS =
mapStateT stringGenS get
where:
newtype GenState = St {getStrings :: [String]}
deriving (Show)
removeString :: String -> GenState -> GenState
removeString str (St xs) = St $ delete str xs
stringGenS :: Gen (a, GenState) -> Gen (String, GenState)
stringGenS genStSt =
genStSt >>= \(_, st) ->
elements (getStrings st) >>= \str ->
return (str, removeString str st)
Something that troubles me about this implementation is the fact that I'm not using the first element of stringGenS. Secondly, my end goal is to define a random generator for JSON values, that make use of a resource pool (which contains not only strings). Using StateT led me to implement "stateful" variants of QuickCheck's elements, listOf, etc.
I was wondering whether there's a better way of achieving this, or such a complexity is inherent to defining stateful variants of existing monads.
The combination of StateT and Gen could look like this:
import Control.Monad.State
import Data.List (delete)
import Test.QuickCheck
-- A more efficient solution would be to use Data.Set.
-- Even better, Data.Trie and ByteStrings:
-- https://hackage.haskell.org/package/bytestring-trie-0.2.4.1/docs/Data-Trie.html
newtype GenState = St { getStrings :: [String] }
deriving (Show)
removeString :: String -> GenState -> GenState
removeString str (St xs) = St $ delete str xs
stringGenS :: StateT GenState Gen String
stringGenS = do
s <- get
str <- lift $ elements (getStrings s)
modify $ removeString str
return str
The problem is that as you need the state, you can't run multiple such computations in Gen while sharing the state. The only reasonable thing to do would be to generate multiple random unique strings together (using the same state) as
evalStateT (replicateM 10 stringGenS)
which is of type GenState -> Gen [String].

"Persistently" Impure (IO) Vectors in Haskell, with database-like persistent interface

I have a computation that is best described as iterative mutations on a vector; the final result is the final state of the vector.
The "idiomatic" approach to making this functional, I think, is to simply pass on a new vector object along whenever it is "modified". So your iterative method would be operate_on_vector :: Vector -> Vector, which takes in a vector and outputs the modified vector, which is then fed through the method again.
This method is pretty straightforward and I had no problems implementing it, even being new to Haskell.
Alternatively, one could encapsulate all of this in a State monad and pass along a constantly re-created and modified vector as the state value.
However, I suffer a huge, huge performance cost, as these calculations are pretty intensive, the iterations many (on the order of millions) and the data vectors can get pretty large (on the order of at least thousands of primitives). Re-creating a new vector in memory at every step of the iteration seems pretty costly, data collection or not.
Then I considered how IO works -- it can be seen as basically like State, except the state value is the "World", which is constantly changing.
Maybe I could use something that is like IO to "operate" on a "world"? And the "world" would be the vector in-memory? Sort of like a database query, but everything is in memory.
For example with io you could do
do
putStrLn "enter something"
something <- getLine
putStrLine $ "you entered " ++ something
which can be seen as "performing" putStrLn and "modifying" the World object, returning a new World object and feeding it into the next function, which queryies the world object for a string that is the result of the modification, and then returns another world object after another modification.
Is there anything like that that can do this for mutable vectors?
do
putInVec 0 9 -- index 0, value 9
val <- getFromVec 0
putInVec 0 (val + 1)
, with "impure" "mutable" vectors, instead of passing along a new modified vector at each step.
I believe you can do this using mutable vector and a thin wrapper over Reader + ST (or IO) monad.
It can look like this:
type MyVector = IOVector $x -- Use your own elements type here instead of $x
newtype VectorIO a = VectorIO (ReaderT MyVector IO a) deriving (Monad, MonadReader, MonadIO)
-- You will need GeneralizedNewtypeDeriving extension here
-- Run your computation over an existing vector
runComputation :: MyVector -> VectorIO a -> IO MyVector
runComputation vector (VectorIO action) = runReaderT action vector >> return vector
-- Run your computation over a new vector of the specified length
runNewComputation :: Int -> VectorIO a -> IO MyVector
runNewComputation n action = do
vector <- new n
runComputation vector action
putInVec :: Int -> $x -> VectorIO ()
putInVec idx val = do
v <- ask
liftIO $ write v idx val
getFromVec :: Int -> VectorIO $x
getFromVec idx = do
v <- ask
liftIO $ read v idx
That's really all. You can use VectorIO monad to perform your computations, just like you wanted in your example. If you do not want IO but want pure computations, you can use ST monad; modifications to the code above will be trivial.
Update
Here is an ST-based version:
{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances, MultiParamTypeClasses, Rank2Types #-}
module Main where
import Control.Monad
import Control.Monad.Trans.Class
import Control.Monad.Reader
import Control.Monad.Reader.Class
import Control.Monad.ST
import Data.Vector as V
import Data.Vector.Mutable as MV
-- Your type of the elements
type E = Int
-- Mutable vector which will be used as a context
type MyVector s = MV.STVector s E
-- Immutable vector compatible with MyVector in its type
type MyPureVector = V.Vector E
-- Simple monad stack consisting of a reader with the mutable vector as a context
-- and of an ST action
newtype VectorST s a = VectorST (ReaderT (MyVector s) (ST s) a) deriving Monad
-- Make the VectorST a reader monad
instance MonadReader (MyVector s) (VectorST s) where
ask = VectorST $ ask
local f (VectorST a) = VectorST $ local f a
reader = VectorST . reader
-- Lift an ST action to a VectorST action
liftST :: ST s a -> VectorST s a
liftST = VectorST . lift
-- Run your computation over an existing vector
runComputation :: MyVector s -> VectorST s a -> ST s (MyVector s)
runComputation vector (VectorST action) = runReaderT action vector >> return vector
-- Run your computation over a new vector of the specified length
runNewComputation :: Int -> VectorST s a -> ST s (MyVector s)
runNewComputation n action = do
vector <- MV.new n
runComputation vector action
-- Run a computation on a new mutable vector and then freeze it to an immutable one
runComputationPure :: Int -> (forall s. VectorST s a) -> MyPureVector
runComputationPure n action = runST $ do
vector <- runNewComputation n action
V.unsafeFreeze vector
-- Put an element into the current vector
putInVec :: Int -> E -> VectorST s ()
putInVec idx val = do
v <- ask
liftST $ MV.write v idx val
-- Retrieve an element from the current vector
getFromVec :: Int -> VectorST s E
getFromVec idx = do
v <- ask
liftST $ MV.read v idx

Resources