Haskell Groundhog-Db function types

Question

I'm new to haskell and I'm fiddling around with the Groundhog-ORM library upon a postgreSQL database. Everythings works fine, if I put all my database stuff inside a single function. However, now I want to separate different topics in separate functions.

{-# LANGUAGE GADTs, TypeFamilies, TemplateHaskell, QuasiQuotes, FlexibleInstances, StandaloneDeriving #-}

module Main where

import System.IO
import Database.Groundhog.TH
import Database.Groundhog.Postgresql
import Data.DateTime
import Data.List.Split (splitOn)
import Control.Monad (mapM_, when, unless)
import Control.Monad.IO.Class (liftIO)

postgres_connection_string = "host=localhost port=5432 user=itsme password=unknown dbname=stocks"

data Symbol = Symbol {
    name :: String
} deriving (Show, Eq)

mkPersist defaultCodegenConfig [groundhog|
definitions:
  - entity: Symbol
    dbName: symbols
    schema: stocks
    keys:
      - name: unique_symbol
    constructors:
      - name: Symbol
        uniques:
          - name: unique_symbol
            fields: [name]
|]


ensureSymbol :: (PersistBackend m) => String -> m (Symbol)
ensureSymbol sym = do
    loadedSymbols <- select (NameField ==. sym)
    return (loadedSymbols !! 0)

main = do
    contents <- readFile "src\\inputTable.csv"
    putStrLn ("Read " ++ show (length contents) ++ " Bytes input data.")
    withPostgresqlConn postgres_connection_string . runDbConn $ do
        liftIO $ putStrLn "About to ensure table structures."
        runMigration $ do
          migrate (undefined :: Symbol)
        liftIO $ putStrLn "Checking for the symbol."
        symbol <- ensureSymbol "EURUSD"
        ... [ Some more stuff ] ...

As you can see, I already separated a little function which reads a symbol entity from the database. This example compiles okay.

However, the function is called ensureSymbol and not readSymbol, so the function should read

ensureSymbol :: (PersistBackend m) => String -> m (Symbol)
ensureSymbol sym = do
    loadedSymbols <- select (NameField ==. sym)
    when (null loadedSymbols) (return (Symbol sym))
    unless (null loadedSymbols) (return (loadedSymbols !! 0))

But now I get a bunch of error messages, even in the line

loadedSymbols <- select (NameField ==. sym)

which previously compiled correctly. I assume I need an additional type specifier to make when and unless visible to the function, but I'm not sure.

src\Main.hs:117:40:
    Couldn't match type `Symbol' with `()'
    In the first argument of `select', namely `(NameField ==. sym)'
    In a stmt of a 'do' block:
      loadedSymbols <- select (NameField ==. sym)
    In the expression:
      do { loadedSymbols <- select (NameField ==. sym);
           when (null loadedSymbols) (return (Symbol sym));
           unless (null loadedSymbols) (return (loadedSymbols !! 0)) }

 src\Main.hs:118:40:
    Couldn't match expected type `()' with actual type `Symbol'
    In the first argument of `return', namely `(Symbol sym)'
    In the second argument of `when', namely `(return (Symbol sym))'

src\Main.hs:119:5:
    Couldn't match type `()' with `Symbol'
    Expected type: m Symbol
      Actual type: m ()
    In a stmt of a 'do' block:
      unless (null loadedSymbols) (return (loadedSymbols !! 0))
    In the expression:
      do { loadedSymbols <- select (NameField ==. sym);
           when (null loadedSymbols) (return (Symbol sym));
           unless (null loadedSymbols) (return (loadedSymbols !! 0)) }

Maybe there is a much more elegant way to do this?

Answer 1

when and unless both have the same type:

when, unless :: Monad m => Bool -> m () -> m ()

so the value you pass as the second argument must have type m (). You are passing m Symbol in both cases. It looks like you just want to use if:

ensureSymbol sym = do
    loadedSymbols <- select (NameField ==. sym)
    if (null loadedSymbols) then (return (Symbol sym)) else (return (loadedSymbols !! 0))

or a case:

ensureSymbol sym = do
        loadedSymbols <- select (NameField ==. sym)
        case loadedSymbols of
          [] -> return (Symbol sym)
          s:ss -> return s