Running join on Maybe Relation - database

I have a model
Assignment
blah Text
....
and a model
File
assignmentId AssignmentId Maybe
...
and I want to get all the files associated with an assignment in a join query. I have tried Esqueleto and runJoin with selectOneMany but haven't had any luck, so I am considering not using a join, or using rawSql. That really doesn't seem like a good idea, but I can't figure this out. Is there any support for that feature?

Update, working example:
{-# LANGUAGE PackageImports, OverloadedStrings, ConstraintKinds #-}
module Handler.HTest where
import Import
import "esqueleto" Database.Esqueleto as Esql
import "monad-logger" Control.Monad.Logger (MonadLogger)
import "resourcet" Control.Monad.Trans.Resource (MonadResourceBase)
import qualified Data.List as L
getFilesByAssignment :: (PersistQuery (SqlPersist m), MonadLogger m
, MonadResourceBase m) =>
Text -> SqlPersist m [Entity File]
getFilesByAssignment myAssign = do
result <- select $
from $ \(assign `InnerJoin` file) -> do
on (just (assign ^. AssignmentId)
Esql.==. file ^. FileAssignmentId)
where_ (assign ^. AssignmentBlah Esql.==. val myAssign)
return (assign, file)
return $ map snd (result :: [(Entity Assignment, Entity File)])
(.$) = flip ($)
getTestR :: Handler RepHtml
getTestR = do
entFiles <- runDB $ getFilesByAssignment "test"
defaultLayout $ do
setTitle "Test page"
entFiles .$ map (show . unKey . entityKey)
.$ L.intercalate ", "
.$ toHtml
.$ toWidget

Related

readCol = map fromSql non type-variable argument

:i fromSql
fromSql ::
convertible-1.1.1.0:Data.Convertible.Base.Convertible SqlValue a =>
SqlValue -> a
-- Defined in ‘Database.HDBC.SqlValue’
If I run e.g map fromSql (EXAMPLESQL) it outputs ok. But if I redefine it as readCol = map fromSql I get the error:
readCol = map fromSql
<interactive>:23:1: error:
• Non type-variable argument
in the constraint: convertible-1.1.1.0:Data.Convertible.Base.Convertible
SqlValue b
(Use FlexibleContexts to permit this)
• When checking the inferred type
readCol :: forall b.
convertible-1.1.1.0:Data.Convertible.Base.Convertible SqlValue b =>
[SqlValue] -> [b]
How to solve this?
I used the solution from this:
In ghci you can set FlexibleContexts like this:
:set -XFlexibleContexts
In the source file, at the beginning, you should use:
{-# LANGUAGE FlexibleContexts #-}

Haskell fetchName from X11 library does not return the name of the window

Having the following Haskell code:
import Control.Concurrent
import Data.Time.Clock
import Debug.Trace
import Graphics.X11
import Graphics.X11.Xlib.Extras
main :: IO ()
main = do
d <- openDisplay ""
loop d
loop :: Display -> IO ()
loop d = do
time <- getCurrentTime
(w, _) <- getInputFocus d
maybeName <- fetchName d w
windowAttrs <- getWindowAttributes d w
print $ show time ++ " Name: " ++ show maybeName ++ " Width: " ++ show (wa_width windowAttrs)
threadDelay 1000000
loop d
The window title returned by fetchName is always Nothing.
Haskell X11 library is a wrapper around Xlib
Possibly related issues:
The width of the window is either correct or it has the value 1.
XFetchName always returns 0
It looks like fetchName isn't always filled in. Instead you need to use the _NET_WM_NAME property:
import Control.Concurrent
import Data.Time.Clock
import Debug.Trace
import Graphics.X11
import Graphics.X11.Xlib.Extras
main :: IO ()
main = do
d <- openDisplay ""
loop d
loop :: Display -> IO ()
loop d = do
time <- getCurrentTime
(w, _) <- getInputFocus d
a <- internAtom d "_NET_WM_NAME" False
p <- getTextProperty d w a
ps <- wcTextPropertyToTextList d p
windowAttrs <- getWindowAttributes d w
print $ show time ++ " Name: " ++ show ps ++ " Width: " ++ show (wa_width windowAttrs)
threadDelay 1000000
loop d
This is what XMonad does:
https://github.com/xmonad/xmonad/blob/8b055621e92e7ade127043e968f50713c15a00a0/src/XMonad/ManageHook.hs#L71-L80
In the end I had to adapt Brian's answer to the more complete definition from XMonad (because of exceptions being thrown by some windows):
import Control.Exception.Extensible (SomeException (..),
bracket)
import qualified Control.Exception.Extensible as E
import Graphics.X11
import Graphics.X11.Xlib.Extras
getWindowTitle :: Display -> IO String
getWindowTitle d = do
(w, _) <- getInputFocus d
let getProp =
(internAtom d "_NET_WM_NAME" False >>= getTextProperty d w)
`E.catch` \(SomeException _) -> getTextProperty d w wM_NAME
extract prop = do l <- wcTextPropertyToTextList d prop
return $ if null l then "" else head l
bracket getProp (xFree . tp_value) extract `E.catch` \(SomeException _) -> return ""

Haskell parse a string into array of arrays

I Need to parse a String into Array of Arrays. String is splited in Arrays by "\n" char. And each of that Array is splited by "," or ";" signs.
Example: 4;5\n6,7 -----> [[4,5][6,7]]
import qualified Text.Parsec as P (char,runP,noneOf,many,(<|>),eof)
import Text.ParserCombinators.Parsec
import Text.Parsec.String
import Text.Parsec.Char
import Text.PrettyPrint.HughesPJ
import Data.Maybe
newtype CSV = CSV [Row] deriving (Show,Eq)
type Row = [String]
parseCSV :: Parser CSV
parseCSV = do
return $ CSV (endBy (sepBy (many (noneOf ",\n")) (Text.Parsec.Char.char ',')) (Text.Parsec.Char.char '\n'))
runParsec :: Parser a -> String -> Maybe a
runParsec parser input = case P.runP parser () "" input of
Left _ -> Nothing
Right a -> Just a
But when I try to run the Code I get error because of wrong data types
Here is a solution that parses runParsec parseCSV "4;5\n6,7\n" into Just (CSV [["4","5"],["6","7"]]).
parseCSV :: Parser CSV
parseCSV = CSV <$> csv
where
csv = row `endBy` char '\n'
row = many (noneOf ",;\n") `sepBy` oneOf ",;"

inline-c : "`Type` cannot be marshalled in a foreign call"

Setting
A C enum type rendered into Haskell by c2hs, complete with Storable instance which compiles correctly (TypesC2Hs.chs). I import this unqualified into the module I have assigned for the inline-c context (Internal.hs). Both the .hs module generated by c2hs and Internal.hs are imported by InlineC.hs, the other inline-c module that holds the quasiquotes wrapping the C calls.
TypesC2Hs.hs -------------
| |
V V
Internal.hs -------> InlineC.hs
Question
InlineC.hs complains that this type cannot be marshalled: "Unacceptable argument type in foreign declaration: ‘DMBoundaryType’ cannot be marshalled in a foreign call When checking declaration:"
What is going on? This is the first time inline-c gives me type of this error.
I should note that other types that do not need to be dereferenced directly, e.g. newtype DM = DM (Ptr DM) deriving Storable, work fine with the above approach.
Thanks in advance
TypesC2Hs.chs
{# enum DMBoundaryType as DMBoundaryType {underscoreToCase} deriving (Eq, Show) #}
instance Storable DMBoundaryType where
sizeOf _ = {# sizeof DMBoundaryType #}
alignment _ = {# alignof DMBoundaryType #}
peek = peek
poke = poke
Internal.hs
{-# LANGUAGE QuasiQuotes, TemplateHaskell ,GeneralizedNewtypeDeriving, StandaloneDeriving ,DeriveDataTypeable, DataKinds, OverloadedStrings #-}
module Internal where
import TypesC2Hs
import qualified Language.C.Inline as C
import qualified Language.C.Types as CT
import Language.C.Inline.Context
import qualified Language.Haskell.TH as TH
import Data.Monoid ((<>), mempty)
import qualified Data.Map as Map
ctx :: Context
ctx = baseCtx <> funCtx <> vecCtx <> bsCtx <> pctx where
pctx = mempty {ctxTypesTable = typesTable}
typesTable :: Map.Map CT.TypeSpecifier TH.TypeQ
typesTable = Map.fromList
[ (CT.TypeName "DMBoundaryType", [t| DMBoundaryType |]) ]
InlineC.hs
dmdaCreate1d0' cc bx m dof s =
withPtr ( \ dm -> [C.exp|int{DMDACreate1d($(int c),
$(DMBoundaryType bx),
$(PetscInt m),
$(PetscInt dof),
$(PetscInt s),
NULL,
$(DM* dm))}|] )
where c = unComm cc
C enum is not marshallable foreign type, that is what compiler tries to tell you. To work around it, pass it as a CInt using fromEnum (looks like c2hs now supports it via hooks, but I never tried it.)

How do I read (and parse) a file and then append to the same file without getting an exception?

I am trying to read from a file correctly in Haskell but I seem to get this error.
*** Exception: neo.txt: openFile: resource busy (file is locked)
This is my code.
import Data.Char
import Prelude
import Data.List
import Text.Printf
import Data.Tuple
import Data.Ord
import Control.Monad
import Control.Applicative((<*))
import Text.Parsec
( Parsec, ParseError, parse -- Types and parser
, between, noneOf, sepBy, many1 -- Combinators
, char, spaces, digit, newline -- Simple parsers
)
These are the movie fields.
type Title = String
type Director = String
type Year = Int
type UserRatings = (String,Int)
type Film = (Title, Director, Year , [UserRatings])
type Period = (Year, Year)
type Database = [Film]
This is the Parsing of all the types in order to read correctly from the file
-- Parse a string to a string
stringLit :: Parsec String u String
stringLit = between (char '"') (char '"') $ many1 $ noneOf "\"\n"
-- Parse a string to a list of strings
listOfStrings :: Parsec String u [String]
listOfStrings = stringLit `sepBy` (char ',' >> spaces)
-- Parse a string to an int
intLit :: Parsec String u Int
intLit = fmap read $ many1 digit
-- Or `read <$> many1 digit` with Control.Applicative
stringIntTuple :: Parsec String u (String , Int)
stringIntTuple = liftM2 (,) stringLit intLit
film :: Parsec String u Film
film = do
-- alternatively `title <- stringLit <* newline` with Control.Applicative
title <- stringLit
newline
director <- stringLit
newline
year <- intLit
newline
userRatings <- stringIntTuple
newline
return (title, director, year, [userRatings])
films :: Parsec String u [Film]
films = film `sepBy` newline
This is the main program (write "main" in winghci to start the program)
-- The Main
main :: IO ()
main = do
putStr "Enter your Username: "
name <- getLine
filmsDatabase <- loadFile "neo.txt"
appendFile "neo.txt" (show filmsDatabase)
putStrLn "Your changes to the database have been successfully saved."
This is the loadFile function
loadFile :: FilePath -> IO (Either ParseError [Film])
loadFile filename = do
database <- readFile filename
return $ parse films "Films" database
the other txt file name is neo and includes some movies like this
"Blade Runner"
"Ridley Scott"
1982
("Amy",5), ("Bill",8), ("Ian",7), ("Kevin",9), ("Emma",4), ("Sam",7), ("Megan",4)
"The Fly"
"David Cronenberg"
1986
("Megan",4), ("Fred",7), ("Chris",5), ("Ian",0), ("Amy",6)
Just copy paste everything include a txt file in the same directory and test it to see the error i described.
Whoopsy daisy, being lazy
tends to make file changes crazy.
File's not closed, as supposed
thus the error gets imposed.
This small guile, by loadFile
is what you must reconcile.
But don't fret, least not yet,
I will show you, let's get set.
As many other functions that work with IO in System.IO, readFile doesn't actually consume any input. It's lazy. Therefore, the file doesn't get closed, unless all its content has been consumed (it's then half-closed):
The file is read lazily, on demand, as with getContents.
We can demonstrate this on a shorter example:
main = do
let filename = "/tmp/example"
writeFile filename "Hello "
contents <- readFile filename
appendFile filename "world!" -- error here
This will fail, since we never actually checked contents (entirely). If you get all the content (for example with printing, length or similar), it won't fail anymore:
main = do
let filename = "/tmp/example2"
writeFile filename "Hello "
content <- readFile filename
putStrLn content
appendFile filename "world!" -- no error
Therefore, we need either something that really closes the file, or we need to make sure that we've read all the contents before we try to append to the file.
For example, you can use withFile together with some "magic" function force that makes sure that the content really gets evaluated:
readFile' filename = withFile filename ReadMode $ \handle -> do
theContent <- hGetContents handle
force theContent
However, force is tricky to achieve. You could use bang patterns, but this will evaluate the list only to WHNF (basically just the first character). You could use the functions by deepseq, but that adds another dependency and is probably not allowed in your assignment/exercise.
Or you could use any function that will somehow make sure that all elements are evaluated or sequenced. In this case, we can use a small trick and mapM return:
readFile' filename = withFile filename ReadMode $ \handle -> do
theContent <- hGetContents handle
mapM return theContent
It's good enough, but you would use something like pipes or conduit instead in production.
The other method is to make sure that we've really used all the contents. This can be done by using another parsec parser method instead, namely runParserT. We can combine this with our withFile approach from above:
parseFile :: ParsecT String () IO a -> FilePath -> IO (Either ParseError a)
parseFile p filename = withFile filename ReadMode $ \handle ->
hGetContents handle >>= runParserT p () filename
Again, withFile makes sure that we close the file. We can use this now in your loadFilm:
loadFile :: FilePath -> IO (Either ParseError [Film])
loadFile filename = parseFile films filename
This version of loadFile won't keep the file locked anymore.
The problem is that readFile doesn't actually read the entire file into memory immediately; it opens the file and instantly returns a string. As you "look at" the string, behind the scenes the file is being read. So when readFile returns, the file it still open for reading, and you can't do anything else with it. This is called "lazy I/O", and many people consider it to be "evil" precisely because it tends to cause problems like the one you currently have.
There are several ways you can go about fixing this. Probably the simplest is to just force the whole string into memory before continuing. Calculating the length of the string will do that — but only if you "use" the length for something, because the length itself is lazy. (See how this rapidly becomes messy? This is why people avoid lazy I/O.)
The simplest thing you could try is printing the number of films loaded right before you try to append to the database.
main = do
putStr "Enter your Username: "
name <- getLine
filmsDatabase <- loadFile "neo.txt"
putStrLn $ "Loaded " ++ show (length filmsDatabase) ++ " films."
appendFile "neo.txt" (show filmsDatabase)
putStrLn "Your changes to the database have been successfully saved."
It's kind of evil that what looks like a simple print message is actually fundamental to making the code work though!
The other alternative is to save the new database under a different name, and then delete the old file and rename the new one over the top of the old one. This does have the advantage that if the program were to crash half way through saving, you haven't just lost all your stuff.

Resources