I am practising Haskell by trying to make a program that finds .mp3 and .flac metadata and writes it neatly to a file. I've gone this far on my own but I am pretty stumped at what I should be doing. Here is the main chunk of the code here:
builddir xs = do
writeto <- lastest getArgs
let folderl b = searchable <$> (getPermissions b)
let filel c = ((lastlookup mlookup c) &&) <$> ((not <$> folderl c))
a <- listDirectory xs
listdirs <- filterM (folderl) (map ((xs ++ "/") ++) a)
filedirs <- filterM (filel) (map ((xs ++ "/") ++) a)
let tagfiles = mapM (tagsort) filedirs
putStrLn $ concat listdirs
putStrLn $ concat tagfiles
tagsort xs = do
nsartist <- getTags xs artistGetter
nsalbum <- getTags xs albumGetter
artist <- init $ drop 8 $ show nsalbum
album <- init $ drop 7 $ show nsalbum
(artist ++ " - " ++ album)
I know, it's very messy. When run in ghci, I get this:
• Couldn't match expected type ‘[Char]’ with actual type ‘Char’
• In the first argument of ‘(++)’, namely ‘artist’
In a stmt of a 'do' block: artist ++ " - " ++ album
In the expression:
do nsartist <- getTags xs artistGetter
nsalbum <- getTags xs albumGetter
artist <- init $ drop 8 $ show nsalbum
album <- init $ drop 7 $ show nsalbum
....
60 artist ++ " - " ++ album
I'm having trouble understanding why this is happening. Running a similar command in a test program of mine:
main = do
artg <- getTags "/home/spilskinanke/backlogtest/02 - await rescue.mp3" artistGetter
let test = init $ drop 8 $ show artg
print test
this works exactly fine. Prints the string "65daysofstatic" to my terminal in ghci. It clearly is not a Char type. So why is being called a Char in my code?
Also note that before adding any pieces of code that referenced the metadata module I am using (htaglib) this program ran fine in a test. With the tagfiles function and tagsort monad absent, I was able to set an arg for a certain directory, and my test would successfully print a list of FilePaths containing all readable folders, and another list of FilePaths containing all files ending in whatever I desired in mlookup, in this case being .mp3, .mp4, .flac, and .wav. Any help would be appreciated.
You’re mixing up IO and [] in tagsort:
tagsort xs = do
-- Okay, run IO action and bind result to ‘nsartist’
nsartist <- getTags xs artistGetter
-- Similarly for ‘nsalbum’
nsalbum <- getTags xs albumGetter
-- Mistaken: ‘init …’ returns a list, not an ‘IO’ action
artist <- init $ drop 8 $ show nsalbum
album <- init $ drop 7 $ show nsalbum
-- You are also missing a ‘pure’ or ‘return’ here
(artist ++ " - " ++ album)
The fixes are simple: use a let statement instead of a bind statement <-, and add a pure to make an IO String out of the String you have:
tagsort xs = do
nsartist <- getTags xs artistGetter
nsalbum <- getTags xs albumGetter
let artist = init $ drop 8 $ show nsalbum
let album = init $ drop 7 $ show nsalbum
pure (artist ++ " - " ++ album)
Generally speaking, each do block must be in a single monad, until you start learning about using monad transformers to combine different effects. So in an IO block, anything on the right of a binding statement must be an IO action; if you just want to do pure computations, you can use let (or just inline expressions, if you don’t need to bind something to a name). Finally, the last statement in a do block must also be an action in the particular monad—this is often a pure value, just wrapped up in the monad with pure :: Applicative f => a -> f a (or return :: Monad m => a -> m a, which does the same thing but works in slightly fewer contexts because of the more restrictive Monad constraint).
I am trying to get a record by id in Yesod. My code is:
getEditActorR :: Handler Html
getEditActorR = do
actorId <- runInputGet $ ireq intField "id"
actor <- runDB $ get $ Key $ PersistInt64 (fromIntegral actorId)
defaultLayout $ do
$(widgetFile "actor-edit")
The error I get is:
• Couldn't match type ‘PersistEntityBackend record0’
with ‘SqlBackend’
arising from a use of ‘get’
The type variable ‘record0’ is ambiguous
• In the second argument of ‘($)’, namely
‘get $ Key $ PersistInt64 (fromIntegral actorId)’
In a stmt of a 'do' block:
actor <- runDB $ get $ Key $ PersistInt64 (fromIntegral actorId)
In the expression:
do { actorId <- runInputGet $ ireq intField "id";
actor <- runDB $ get $ Key $ PersistInt64 (fromIntegral actorId);
defaultLayout $ do { (do { ... }) } }
How can I fix that?
First thing I did was to run stack ghci.
Then I run :info Actor, where Actor is the name of my PersistEntity.
Among other things, there was:
newtype instance Key Actor = ActorKey {unActorKey :: Int}
So I wrote:
maybeActor <- runDB $ get $ ActorKey actorId
case maybeActor of
Just actor -> defaultLayout $ do
$(widgetFile "actor-edit")
Nothing -> defaultLayout $ do
$(widgetFile "actor-new")
Hi i want create a file that only accept values that exist in a table (with more that 20000 rows) so i have the following code
demoForm :: Maybe Demo -> AForm Handler Demo
demoForm demo = Demo
<$> areq nitField (bfs (MsgName)) (demoFieldOne <$> demo)
<*> areq intField (bfs (MsgName)) (demoFieldTwo <$> demo)
where
errorMessage :: Text
errorMessage = "the company no exist!"
nitField = check validateNit textField
validateNit nit
| companiesMatch nit = Left errorMessage
| otherwise = Right nit
companiesMatch name = do
entities <- runDB $ selectList [CompanyName ==. name] []
return (null entities)
but I get the error Couldn't match expected type ‘Bool’with actual type ‘m0 (HandlerT site0 IO Bool)’ so how can get the bool value from the monad or exist a better way to do this validations?
thanks #Michael Snoyman you are rigth I just have to use checkM
demoForm :: Maybe Demo -> AForm Handler Demo
demoForm demo = Demo
<$> areq nitField (bfs (MsgName)) (demoFieldOne <$> demo)
<*> areq intField (bfs (MsgName)) (demoFieldTwo <$> demo)
where
nitField = checkM validateNit textField
validateNit input = do
mbNit <- runDB $ selectList [CompanyName ==. input] []
return $ case null mbNit of
True -> Left (MsgErrNit :: AppMessage)
False -> Right input
How do I dynamically generate forms with a varying number of input fields?
The closest I managed is:
listEditForm :: [String] -> Html -> MForm App App (FormResult Text, Widget)
listEditForm xs = renderDivs $ mconcat [ areq textField (String.fromString x) Nothing | x <- xs]
but this has the result type Text and not [Text] as intended, owning to the coincidence that Text is an instance of Monoid, e.g. it fails with Int.
I have a working alternate attempt, which combines several forms, but somehow it only works for this toy example, while the real attempt fails strangely. Anyhow, I don't think this is the correct approach:
data MapPair = MapPair { mpKey :: T.Text, mpValue :: Maybe T.Text }
editForm mmp = renderTable $ MapPair
<$> areq textField "Key" (mpKey <$> mmp)
<*> aopt textField "Value" (mpValue <$> mmp)
pair2mp (v,k) = MapPair { mpKey = v, mpValue = Just k }
getEditR = do
sess <- getSession
let sesslist = Map.toList $ Map.map (decodeUtf8With lenientDecode) sess
forms <- forM sesslist (\a -> generateFormPost $ editForm $ Just $ pair2mp a)
defaultLayout [whamlet|
<h1>Edit Value Pairs
$forall (widget,enctype) <- forms
<form method=post action=#{EditR} enctype=#{enctype}>
^{widget}
<input type=submit>
|]
postEditR = do
sess <- getSession
let sesslist = Map.toList $ Map.map (decodeUtf8With lenientDecode) sess
forM_ sesslist (\a -> do
((res,_),_) <- runFormPost $ editForm $ Just $ pair2mp a
case res of
(FormSuccess (MapPair {mpKey=mk, mpValue=(Just mv)})) -> setSession mk mv
_ -> return ()
)
defaultLayout [whamlet|ok|]
Duh, it is actually easy using monadic forms (see code below).
My major headache is the extra text fields to make sure that the handler which receives the answer may also infer the corresponding question. Maybe I can hide those text fields, make them uneditable, or find another way around that (but I don't know much about Html yet).
listEditMForm :: [(String,Int)] -> Html -> MForm App App (FormResult [(FormResult Int, FormResult Text)], Widget)
listEditMForm xs extra = do
ifields <- forM xs (\(s,i) -> mreq intField (String.fromString s) (Just i))
tfields <- forM xs (\(s,i) -> mreq textField (String.fromString s) (Just $ pack s))
let (iresults,iviews) = unzip ifields
let (tresults,tviews) = unzip tfields
let results = zip iresults tresults
let views = zip iviews tviews
let widget = [whamlet|
#{extra}
<h1>Multi Field Form
$forall (iv,tv) <- views
Field #
#{fvLabel iv}: #
^{fvInput tv} #
^{fvInput iv}
<div>
|]
return ((FormSuccess results), widget)
There are also still some ugly things that I have no clue about, like always wrapping the result always in an outermost FormSuccess constructor, but I guess that really depends on each use-case (e.g. a single FormFailure or FormMissing should probably make the whole form fail/missing as well, but maybe in some case this is not wanted.)
All the zipping and unzipping can probably be done more neatly, but I guess in my case I just create a combined field textintField. I think I know how to do it, but it would be neat if there were a function to combine fields.
The tricky thing with having a dynamic number of fields is that the number of rows/fields need to be known when the form is parsed in the handler.
Let's say we have a regular form that looks like this:
type Form m a b =
(MonadHandler m, m ~ HandlerFor App) =>
Maybe a ->
Html ->
MForm m (FormResult b, Widget)
nameAndAgeForm :: Form m (Text, Int) (Text, Int)
nameAndAgeForm mPair extra = do
let nameSettings =
FieldSettings
{ fsLabel = "name"
, fsTooltip = Nothing
, fsId = Nothing
, fsName = Nothing
, fsAttrs = []
}
(nameResult, nameField) <- mreq textField nameSettings (fst <$> mPair)
let ageSettings =
FieldSettings
{ fsLabel = "age"
, fsTooltip = Nothing
, fsId = Nothing
, fsName = Nothing
, fsAttrs = []
}
(ageResult, ageField) <- mreq intField ageSettings (snd <$> mPair)
let result = (,) <$> nameResult <*> ageResult
let widget = [whamlet|age: ^{fvInput nameField}, age: ^{fvInput ageField}^{extra}|]
pure (result, widget)
NOTE it's important that fsName = Nothing in all of the fields or they will collide with themselves when we try to repeat the form in a list.
We can turn it into a form of lists of pairs with a function with that has the following signature Form m a b -> Form m [a] [b].
We can write such a function if we use a trick to get around the problem that the number of fields must be known when parsing. We can send the number of rows as the first field to be parsed.
listifyForm :: Form m a b -> Form m [a] [b]
listifyForm form items csrf = do
let countSettings =
FieldSettings
{ fsLabel = "rowCount"
, fsTooltip = Nothing
, fsId = Nothing
, fsName = Just "listifiedFormRowCount"
, fsAttrs = []
}
(rowCountResult, rowCountField) <- mreq hiddenField countSettings (length <$> items)
case (rowCountResult, items) of
(FormSuccess rowCount, _) -> constructForms rowCountField $ replicate rowCount Nothing
(FormMissing, Just items') -> constructForms rowCountField $ Just <$> items'
(FormFailure err, _) -> pure (FormFailure err, [whamlet|Something went wrong with the form. Do all the fields have unique ID's?|])
(FormMissing, _) -> pure (FormMissing, [whamlet|Something went wrong with the form|])
where
constructForms rowCountField mItems =
fmap ([whamlet|^{csrf}^{fvInput rowCountField}|] <>) . bimap sequenceA mconcat . unzip
<$> traverse (flip form mempty) mItems
Now we can convert the nameAndAgeForm into a nameAndAgeListForm:
nameAndAgeListForm :: Form m [(Text, Int)] [(Text, Int)]
nameAndAgeListForm = listifyForm nameAndAgeForm
That can then be called like this in the handler that displays the form:
((_, namesAndAgesWidget), _) <- runFormPost $ nameAndAgeListForm $ Just [("Alice", 12), ("Bob", 34)]
And like this in the handler that handles the input:
((result, _), _) <- runFormPost $ nameAndAgeListForm Nothing
I'm getting the following error when trying to compile my Yesod project (built out from the scaffolding).
No instance for (PersistBackend (GGHandler Scheduler Scheduler) IO)
arising from a use of `checkDateStatus'
Possible fix:
add an instance declaration for
(PersistBackend (GGHandler Scheduler Scheduler) IO)
In the first argument of `checkM', namely `checkDateStatus'
In the expression: checkM checkDateStatus
In the expression:
checkM checkDateStatus
$ (jqueryDayField
(def {jdsChangeYear = True, jdsYearRange = "2011:2012"}))
I believe this is because Haskell's type inference is failing. If this is the case, all I need to do is to give an accurate definition for checkDateStatus. If not a push in the right direction would be welcome. If I'm right, I'm still stuck as to what the type definition of checkDateStatus should be. I've been getting away with depending on type inference. Included below is the code I think is relevant. If I am missing something, please inform.
getManagerR :: Handler RepHtml
getManagerR = do
((res, widget), enctype) <- runFormGet productForm
let findTestId = 1
res' = prepST res
scheduledTest = makeScheduledTest res'
dataInsert <- runDB $ insert scheduledTest
defaultLayout [whamlet|
<p>Result:#{show res}
<form enctype=#{enctype}>
^{widget}
|]
productForm :: Html
-> Form Scheduler Scheduler (FormResult SelectedProduct, Widget)
productForm extra = do
pInfo <- liftIO getUIdata
let products = V.toList $ V.map productACC $ fst pInfo
versions = V.toList $ V.map versionsACC $ snd pInfo
(productRes, productView) <- mreq (radioField products) "Placeholder" Nothing
versionInfo <- mapM generateVersionSelectFields versions
(dateRes, dateView) <- mreq requestedDayField "Schedule" Nothing
-- (dateRes, dateView) <- mreq (jqueryDayField def
-- { jdsChangeYear = True
-- , jdsYearRange = "2011:2012"
-- }) "Schedule" Nothing
let versionRes = map fst versionInfo
versionViews = map snd versionInfo
widget = do
toWidget [whamlet|
#{extra}
<p>
^{fvInput productView}
$forall versionView <- versionViews
^{fvInput versionView}
^{fvInput dateView}
<input type=submit value="Request Test">
|]
return (makeSelected productRes versionRes dateRes, widget)
requestedDayField = checkM checkDateStatus $ (jqueryDayField def
{ jdsChangeYear = True
, jdsYearRange = "2011:2012"
})
errorMessage :: Text
errorMessage = "I can't go for that, no can do."
checkDateStatus date = do
maybeTaken <- getBy $ UniqueStartDate date
case maybeTaken of
Nothing -> return $ Left errorMessage
otherwise -> return $ Right date
You're missing a runDB in front of the getBy.