I followed a tutorial on creating a basic Gi-Gtk application.
Now I want to react to a button press by setting the source of an Image to a String which I randomly choose from a constant List of Strings:
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Data.GI.Base
import System.Random
import qualified GI.Gtk as Gtk
import Control.Monad.Random
akkorde = ["C11.png","C13.png","C69.png","C6.png","C7#11.png","C7#9.png","C7b13.png","C7b9.png","C7.png","C9.png","Cadd9.png","Cj7.png"]
selectAcc:: (MonadRandom m) => m [Char]
selectAcc = do
let n = length akkorde
i <- getRandomR (0, n-1)
return (akkorde !! i)
main :: IO ()
main = do
name <- selectAcc
Gtk.init Nothing
win <- Gtk.windowNew Gtk.WindowTypeToplevel
Gtk.windowSetTitle win "accordtrainer"
Gtk.onWidgetDestroy win Gtk.mainQuit
#resize win 640 480
img <- Gtk.imageNewFromFile ("../" ++ name)
box <- new Gtk.Box [#orientation := Gtk.OrientationVertical ]
#add box img
#add win box
msg <- new Gtk.Label[#label := ( "")]
#packStart box msg True False 10
btn <- new Gtk.Button [#label := "Click me!"]
#packStart box btn False False 10
on btn #clicked ( Gtk.imageSetFromFile img (do { name <- selectAcc; return ("../" ++ name) }))
Gtk.widgetShowAll win
Gtk.main
the Problem arises at the line
on btn #clicked ( Gtk.imageSetFromFile img (do { name <- selectAcc; return ("../" ++ name) }))
I think Gtk.imageSetFromFile expects a Maybe[Char] but currently its only getting [Char]
ghc says:
app/Main.hs:38:62: error:
• No instance for (MonadRandom Maybe)
arising from a use of ‘selectAcc’
the Just constructor should give me a maybe type
on btn #clicked ( Gtk.imageSetFromFile img (Just(do { name <- selectAcc; return ("../" ++ name) })))
but then I get a type missmatch
• Couldn't match type ‘[Char]’ with ‘Char’
Expected type: Maybe [Char]
Actual type: Maybe [[Char]]
the chain of errors/"fixes" continues
I think Im doing something fundamentally wrong but I dont know how to do this the "correct" way if you know how I should write this line or a better way to get to the randomly selected string please respond
You're already working with mtl-style monad constraints which are even more advanced than normal monads, so don't worry about not understanding everything.
The simplified type of imageSetFromFile is:
imageSetFromFile :: Image -> Maybe [Char] -> IO ()
So it expects you to provide a Maybe [Char] as input where a Nothing presumably removes the image and a Just someFile sets the image to that file location.
The function that you are using has the type:
selectAcc:: MonadRandom m => m [Char]
This means that m here needs to be some monad which can generate random numbers. You can find instances of MonadRandom by typing this in GHCi:
ghci> import Control.Monad.Random
ghci> :i MonadRandom
type MonadRandom :: (* -> *) -> Constraint
class Monad m => MonadRandom m where
getRandomR :: Random a => (a, a) -> m a
getRandom :: Random a => m a
getRandomRs :: Random a => (a, a) -> m [a]
getRandoms :: Random a => m [a]
{-# MINIMAL getRandomR, getRandom, getRandomRs, getRandoms #-}
-- Defined in ‘Control.Monad.Random.Class’
instance (RandomGen g, Monad m) => MonadRandom (RandT g m)
-- Defined in ‘Control.Monad.Trans.Random.Lazy’
instance [safe] MonadRandom IO
-- Defined in ‘Control.Monad.Random.Class’
At the bottom you see two instances: something with RandT (a monad transformer) and another one with IO. However, imageSetFromFile requires a Maybe [Char] as argument, so neither will immediately work. But you can in this case generate the random name right before calling imageSetFromFile in the IO monad:
on btn #clicked $ do
name <- selectAcc
Gtk.imageSetFromFile img (Just ("../" ++ name))
Related
In our haskell code base, business logic is interlaved with tracing and logging code. This can obscure the business logic and make it harder to understand and debug. I am looking for ideas how to reduce the code footprint of logging and tracing to make the business logic stick out more.
Our code currently mostly looks roughly like this:
someFunction a b cs =
withTaggedSpan tracer "TRACE_someFunction" [("arg_b", show b)] $ do
logDebug logger $ "someFunction start: " <> show (trimDownC <$> cs)
result <- do ... some business logic ...
if isError result then
logError logger $ "someFunction error: " <> show result
else
logDebug logger $ "someFunction success: " <> show (trimDownResult result)
One observation is that whe mostly trace the entire function body and log at beginning and end. This should allow combining tracing and logging into single helper and automatically extract function name and names of captured values via meta programming. I have used AST transforming compile time macros and runtime introspection in other languges before but not Haskell.
What are good ways to do this using Template Haskell, HasCallStack or other options?
(Cross posted at https://www.reddit.com/r/haskell/comments/gdfu52/extracting_context_for_tracinglogging_via_haskell/)
Let's assume for simplicity that the functions in your business logic are of the form:
_foo :: Int -> String -> ReaderT env IO ()
_bar :: Int -> ExceptT String (ReaderT env IO) Int
That is, they return values in a ReaderT transformer over IO, or perhaps also throw errors using ExceptT. (Actually that ReaderT transformer isn't required right now, but it'll come in handy later).
We could define a traced function like this:
{-# LANGUAGE FlexibleInstances #-}
import Data.Void (absurd)
import Control.Monad.IO.Class
import Control.Monad.Reader -- from "mtl"
import Control.Monad.Trans -- from "transformers"
import Control.Monad.Trans.Except
traced :: Traceable t => Name -> t -> t
traced name = _traced name []
type Name = String
type Arg = String
class Traceable t where
_traced :: Name -> [Arg] -> t -> t
instance Show r => Traceable (ReaderT env IO r) where
_traced msg args t = either absurd id <$> runExceptT (_traced msg args (lift t))
instance (Show e, Show r) => Traceable (ExceptT e (ReaderT env IO) r) where
_traced msg args t =
do
liftIO $ putStrLn $ msg ++ " invoked with args " ++ show args
let mapExits m = do
e <- m
case e of
Left err -> do
liftIO $ putStrLn $ msg ++ " failed with error " ++ show err
return $ Left err
Right r -> do
liftIO $ putStrLn $ msg ++ " exited with value " ++ show r
return $ Right r
mapExceptT (mapReaderT mapExits) t
instance (Show arg, Traceable t) => Traceable (arg -> t) where
_traced msg args f = \arg -> _traced msg (args ++ [show arg]) (f arg)
This solution is still a bit unsatisfactory because, for functions that call other functions, we must decide at the outset if we want the traced version of the called functions or not.
One thing we could try—although more invasive to the code—is to put our functions in a record, and make the environment of the ReaderT equal to that same record. Something like this:
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
import GHC.Generics
-- from "red-black-record"
import Data.RBR (FromRecord (..), IsRecordType, ToRecord (..))
data MyAPI = MyAPI
{ foo :: Int -> String -> ReaderT MyAPI IO (),
bar :: Int -> ExceptT String (ReaderT MyAPI IO) Int,
baz :: Bool -> ExceptT String (ReaderT MyAPI IO) ()
}
deriving (Generic, FromRecord, ToRecord)
An then use some generics utility library (here red-black-record) to write a function that says: "if every function in your record is Traceable, I will give you another record where all the functions are traced":
import Data.Kind
import Data.Proxy
import Data.Monoid (Endo(..))
import GHC.TypeLits
import Data.RBR
( I (..),
KeyValueConstraints,
KeysValuesAll,
Maplike,
cpure'_Record,
liftA2_Record,
)
traceAPI ::
( IsRecordType r t,
Maplike t,
KeysValuesAll (KeyValueConstraints KnownSymbol Traceable) t
) =>
r ->
r
traceAPI =
let transforms =
cpure'_Record (Proxy #Traceable) $
\fieldName -> Endo (traced fieldName)
applyTraced (Endo endo) (I v) = I (endo v)
in fromRecord . liftA2_Record applyTraced transforms . toRecord
-- small helper function to help invoke the functions in the record
call :: MonadReader env m => (env -> f) -> (f -> m r) -> m r
call getter execute = do
f <- asks getter
execute f
Alternatively, in order to avoid magic, such function could we written by hand for each particular API record.
Putting it to work:
main :: IO ()
main = do
let api =
traceAPI $
MyAPI
{ foo = \_ _ ->
do liftIO $ putStrLn "this is foo",
bar = \_ ->
do
liftIO $ putStrLn "this is bar"
return 5,
baz = \_ ->
do
call foo $ \f -> lift $ f 0 "fooarg"
call bar $ \f -> f 23
throwE "oops"
}
flip runReaderT api $ runExceptT $ baz api False
pure ()
-- baz invoked with args ["False"]
-- foo invoked with args ["0","\"fooarg\""]
-- this is foo
-- foo exited with value ()
-- bar invoked with args ["23"]
-- this is bar
-- bar exited with value 5
-- baz failed with error "oops"
Pure functions are deterministic. If you know what went into them, you can always reproduce the result. Thus, you shouldn't need a lot of logging inside the main parts of a functional code base.
Log the impure actions only, and architect your code into a pure core with a small imperative shell. Log only the impure actions that take place in the shell. I've described the technique in a blog post here.
I am writing a Sudoku generator/solver in Haskell as a learning exercise.
My solve function takes in a UArray but returns a State Int (UArray ...) so that it can also return the maximum difficulty level that it found while solving.
This is my function so far (still in the very experimental early stage):
import Control.Monad.State (State, put)
import Control.Monad.Trans.Class (lift)
import Data.Array.MArray (thaw)
import Data.Array.ST (runSTUArray)
import Data.Array.Unboxed (UArray)
-- ...
type Cell = Word16
solve :: UArray (Int, Int) Cell -> State Int (UArray (Int, Int) Cell)
solve grid = do
return $ runSTUArray $ do
arr <- thaw grid
lift $ put 42
return arr
It does not really do anything with the mutable array yet. I am simply trying to get it to type check with the put 42, but currently get the following error:
• Couldn't match kind ‘*’ with ‘* -> *’
When matching the kind of ‘ST’
• In a stmt of a 'do' block: lift $ put 42
In the second argument of ‘($)’, namely
‘do arr <- thaw grid
lift $ put 42
return arr’
In the second argument of ‘($)’, namely
‘runSTUArray
$ do arr <- thaw grid
lift $ put 42
return arr’
|
128 | lift $ put 42
| ^^^^^^^^^^^^^
runSTUArray ... is a pure value, it does not know anything about "outer monad". And State cares about how you use it, you cannot pass it opaquely into ST.
What you could do:
Option1: change the whole program to move more logic to ST side. Instead of State you'd use STRef then:
solve :: ST s (STRef Int) -> ST s (UArray (Int, Int) Cell) -> ST s ()
...
Option2: manually extract it and pass it to ST, then get back and put explicitly. But there is complication. runSTUArray does not allow getting another value together with the array. I don't know how it can be done safely with current array functions. Unsafely you could re-implement better runSTUArray which can pass another value. You could also add fake cells and encode the new state there.
The way to export another value exists in the vector package, there is (in new versions) createT function which can take not bare vector but a structure containing it (or even several vectors). So, overall, your example would be like:
import Control.Monad.State (State, put, get)
import Data.Word (Word16)
import qualified Data.Vector.Unboxed as DVU
type Cell = Word16
solve :: DVU.Vector Cell -> State Int (DVU.Vector Cell)
solve grid = do
oldState <- get
let (newState, newGrid) = DVU.createT (do
arr <- DVU.thaw grid
pure (oldState + 42, arr))
put newState
pure newGrid
vectors are one-dimensional only, unfortunately
solve grid has form return $ .... This means that State Int (UArray (Int, Int) Cell) is just specialized Monad m => m (UArray (Int, Int) Cell) - the ... does not have access to the features of this specific monad, it's just a UArray (Int, Int) Cell value that you return.
I was able to get a slight variation to compile and run after changing the State monad to a tuple (Int, Grid):
import Control.Monad.ST (ST, runST)
import Data.Array.MArray (freeze, thaw, writeArray)
import Data.Array.ST (STUArray)
import Data.Array.Unboxed (UArray)
import Data.Word (Word16)
type Cell = Word16
type Grid = UArray (Int, Int) Cell
solve :: Grid -> (Int, Grid)
solve grid =
runST $ do
mut <- thaw grid :: ST s (STUArray s (Int, Int) Cell)
writeArray mut (0, 0) 0 -- test that I can actually write
frozen <- freeze mut
return (42, frozen)
This works fine for my application.
I am making a maze generator and wish to visualize the maze by printing. I have a wall type and a function that generates a random maze of those walls.
import qualified Data.Graph.Inductive as Graph
import Data.Graph.Inductive (Gr, prettyPrint)
data WeightedWall = WeightedWall (Int, Int, Int) Orientation deriving (Eq)
weightedGrid :: MonadRandom m => Int -> Int -> Gr () (m WeightedWall)
However, when I call prettyPrint(weightedGrid 10 10), I get this error:
Ambiguous type variable ‘m0’ arising from a use of ‘prettyPrint’
prevents the constraint ‘(Show
(m0 WeightedWall))’ from being solved.
Probable fix: use a type annotation to specify what ‘m0’ should be.
What am I missing in my code to fix this?
You will want your pretty printer to have type:
prettyPrint :: WeightedWall -> String
Then, you will need to pluck a WeightedWall from your MonadRandom instance, pass it to prettyPrint, and then print the String in the IO monad.
The getRandomR function is a member of the MonadRandom typeclass, so it doesn't tell us which MonadRandom instance you are using. I'm going to assume IO since it kills two birds with one stone (the random source and the printing). Your main function could look as follows:
main :: IO ()
main = do
ww <- weightedGrid 10 10 -- pluck weighted wall from MonadRandom instance IO
putStrLn $ prettyPrint ww
I ended up doing:
pp :: WeightedWall -> String
pp (WeightedWall (a, b, c) _) = show a ++ " " ++ show b ++ " " ++ show c
main :: IO ()
main = do
ww <- mapM Data.Graph.Inductive.edgeLabel $ labEdges (weightedGrid 10 10)
forM_ (map pp ww) putStrLn
1) I need to pass a field constructor parameter to a function. I made some tests but i was unable to do so. Is it possible? Otherwise, is it possible with lens package?
2) Is it possible in a MonadState to modify a field using modify? (I made a few attempts, but without success. For example: modify (second = "x") does not work.
import Control.Monad.State
data Test = Test {first :: Int, second :: String} deriving Show
dataTest = Test {first = 1, second = ""}
test1 = runStateT modif1 dataTest -- OK
test2 = runStateT (modif2 "!") dataTest -- OK
test3 = runStateT (modif3 second) dataTest -- WRONG
-- modif1 :: StateT Test IO ()
modif1 = do
st <- get
r <- lift getLine
put $ st {second = "x" ++ r}
-- modif2 :: String -> StateT Test IO ()
modif2 s = do
stat <- get
r <- lift getLine
put $ stat {second = "x" ++ r ++ s}
-- modif3 :: ???? -> StateT Test IO ()
modif3 fc = do
stat <- get
r <- lift getLine
put $ stat {fc = "x" ++ r}
-- When i try to load the module, this is the result:
-- ghc > Failed:
-- ProvaRecord.hs:33:16:`fc' is not a (visible) constructor field name
As you said, you're probably looking for lenses. A lens is a value that allows to read, set or modify a given field. Usually with Control.Lens, you define fields with underscores and you use makeLenses to create full-featured lenses.
There are many combinators that allow lenses to be used together within MonadState. In your case we can use %=, which in this case would be specialized to type
(MonadState s m) => Lens' s b -> (b -> b) -> m ()
which modifies a state value using a given lens and a function that operates on the inside value.
Your example could be rewritten using lenses as follows:
{-# LANGUAGE TemplateHaskell, RankNTypes #-}
import Control.Lens
import Control.Monad.State
data Test = Test { _first :: Int
, _second :: String
}
deriving Show
-- Generate `first` and `second` lenses.
$(makeLenses ''Test)
-- | An example of a universal function that modifies any lens.
-- It reads a string and appends it to the existing value.
modif :: Lens' a String -> StateT a IO ()
modif l = do
r <- lift getLine
l %= (++ r)
dataTest :: Test
dataTest = Test { _first = 1, _second = "" }
test :: IO Test
test = execStateT (modif second) dataTest
Here is my code:
...
import System.Random ( RandomGen, next, split )
import qualified Data.Array.MArray as MAI
import Data.Array.ST.Safe( STUArray )
import Control.Monad.ST.Safe(ST)
import qualified Control.Monad.Random as CMR
import Control.Monad.Trans.Class( lift )
data GraphEdgeYaml = GraphEdgeYaml {
specie1:: NodeName,
specie2 :: NodeName,
sign :: Int,
speed :: Int
}
type LinksSTA s = STUArray s Int GraphEdgeYaml
-- Change a simple link
swapLink :: RandomGen g =>
LinksSTA s
-> g
-> ST s g
swapLink graph generator =
let
swap_op :: CMR.RandT g (ST s) ()
swap_op = do
(low_limit, high_limit) <- lift $ MAI.getBounds graph
idx_value <- CMR.getRandomR (low_limit, high_limit)
return ()
in do
(_, new_generator) <- CMR.runRandT swap_op generator
return new_generator
and here is the error message that I get:
hs/SignMatrixBuild/Randomize.hs:43:26:
Could not deduce (RandomGen g1)
arising from a use of `CMR.getRandomR'
from the context (RandomGen g)
bound by the type signature for
swapLink :: RandomGen g => LinksSTA s -> g -> ST s g
at hs/SignMatrixBuild/Randomize.hs:(38,1)-(47,28)
Possible fix:
add (RandomGen g1) to the context of
the type signature for swap_op :: CMR.RandT g1 (ST s1) ()
or the type signature for
swapLink :: RandomGen g => LinksSTA s -> g -> ST s g
In a stmt of a 'do' block:
idx_value <- CMR.getRandomR (low_limit, high_limit)
In the expression:
do { (low_limit, high_limit) <- lift $ MAI.getBounds graph;
idx_value <- CMR.getRandomR (low_limit, high_limit);
return () }
In an equation for `swap_op':
swap_op
= do { (low_limit, high_limit) <- lift $ MAI.getBounds graph;
idx_value <- CMR.getRandomR (low_limit, high_limit);
return () }
How do I fix this?
One way to fix it is to bring the type variables s and g into scope using the ScopedTypeVariables extension, the other is to simply omit the local type signature on swap_op.
If the local signature is omitted, the type can be inferred -- that leaves, however, the problem of the constraint
MAI.MArray (STUArray s) GraphEdgeYaml (ST s)
that is needed. There are two options,
change the array type to STArray
use STUArrays indeed
If you change the array type to STArray, no constraint is needed (since there is an instance MArray (STArray s) e (ST s) that covers all element types), and without the local type signature it compiles without problems.
If you want to keep the STUArrays, the function can only be used where an instance is in scope. It is best, usually, to provide such instances either where the class is defined (not an option here) or where the type is defined (that would be this module).
So then you should write an
instance MAI.MArray (STUArray s) GraphEdgeYaml (ST s)
in that module, with that instance, the constraint would be fulfilled and need not be placed on the function. Note, however, that writing such an instance is not trivial.
Alternatively, you could add the constraint to the signature and load off the burden of defining an (orphan) instance to the user of swapLink.
I don't know what a NodeName is, but whether GraphEdgeYaml is an unboxable type seems doubtful. I would therefore recommend switching to STArrays.