I am trying to get back a value that is in a json feed (via Aeson) directly inside a StateT stacked on IO:
{-# LANGUAGE DeriveGeneric #-}
module MyFeed where
import Data.Aeson
import Network.URI (parseURI, URI(..))
import Data.Maybe (fromJust)
import Data.Text (Text, unpack)
import Control.Monad.State
import Network.HTTP
import GHC.Generics
import Control.Applicative
import Network.HTTP.Conduit (simpleHttp)
import qualified Data.ByteString.Lazy as B
type Feed a = StateT MyIndex IO a
data MyIndex = MyIndex {
index :: Int
}
data FooBar = Foo | Bar
data MyFeed = MyFeed {
idx :: !Text,
key :: !Text
} deriving (Show,Generic)
instance FromJSON MyFeed
instance ToJSON MyFeed
getJSON :: String -> IO B.ByteString
getJSON url = simpleHttp url
getFeed :: String -> IO (Maybe MyFeed)
getFeed url = (decode <$> getJSON url) :: IO (Maybe MyFeed)
getIndex :: FooBar -> Feed MyIndex
getIndex fb = do
cursor <- get
let newCursor = case fb of
Foo -> do myFeed <- liftIO $ getFeed "http://echo.jsontest.com/key/value/idx/1"
let i = read $ unpack $ idx $ fromJust myFeed
return $ cursor { index = i }
Bar -> return cursor
put newCursor
return newCursor
In the Foo case I fetch the feed as expected but when the required value is returned I get:
src/MyFeed.hs:47:10:
Couldn't match expected type ‘MyIndex’
with actual type ‘m0 MyIndex’
Relevant bindings include
newCursor :: m0 MyIndex (bound at src/MyFeed.hs:40:7)
In the first argument of ‘return’, namely ‘newCursor’
In a stmt of a 'do' block: return newCursor
The Actual Type looks still in a Monad context (do {...}). Is there a way to take it out or I am using a wrong approach?
The error was due to the fact I used:
let newCursor = case fb of
instead of
newCursor <- case fb of
For this reason the final value never get "unwrapped" from its monad context.
Related
I need to start up my very simple webapp with Haskell's Scotty and I just can't seem to get the IO () ReaderT stuff workinng. I am basing this off of another example I found online, and am pretty new to Monads and Haskell overall.
My IDE is throwing this error:
Couldn't match expected type ‘IO t0’
with actual type ‘(m0 Network.Wai.Internal.Response
-> IO Network.Wai.Internal.Response)
-> IO ()’
• Probable cause: ‘Home.main’ is applied to too few arguments
In the expression: Home.main
When checking the type of the IO action ‘main’
It is also throwing this one but I think it should get fixed once I fixed the other one
Ambiguous occurrence ‘main’
It could refer to either ‘Home.main’,
imported from ‘Platform.Home’ at Main.hs:16:1-28
or ‘Main.main’, defined at Main.hs:28:1
I am leaving here the needed code, if there is anything else I should show please let me know.
In "Main.hs":
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Main
( main
) where
import Control.Monad (join)
import Control.Applicative ((<$>))
import Core.Item.Controller (routes)
import Core.Item.Controller as ItemController
import Core.Item.Service as ItemService
import Core.Item.DAO as ItemDAO
import Platform.Postgres as Postgres
import Platform.Home as Home
import Data.Maybe (fromMaybe)
import Network.Wai.Middleware.RequestLogger (logStdoutDev)
import Network.Wai.Middleware.Static (addBase, noDots, staticPolicy, (>->))
import System.Environment (lookupEnv)
import Text.Read (readMaybe)
import Web.Scotty (middleware, scotty)
import Language.Haskell.TH (Type(AppT))
import ClassyPrelude
main :: IO ()
main = do
pgEnv <- Postgres.init
let runner app = flip runReaderT pgEnv $ unAppT app
Home.main runner
type Environment = Postgres.Env
newtype AppT a = AppT
{ unAppT :: ReaderT Environment IO a
} deriving (Applicative, Functor, Monad, MonadIO, MonadReader Environment)
instance ItemController.Service AppT where
getItem = ItemService.getItem
getItems = ItemService.getItems
createItem = ItemService.createItem
instance ItemService.ItemRepo AppT where
findItems = ItemDAO.findItems
addItem = ItemDAO.addItem
instance ItemService.TimeRepo AppT where
currentTime = liftIO getCurrentTime
In "Postgres.hs"
type Env = Pool Connection
type Postgres r m = (MonadReader r m, Has Env r, MonadIO m)
init :: IO Env
init = do
pool <- acquirePool
migrateDb pool
return pool
And this is my "Home.hs":
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ConstraintKinds #-}
module Platform.Home
( main
) where
import ClassyPrelude (MonadIO, LText, fromMaybe, readMay)
import Web.Scotty.Trans
import Network.HTTP.Types.Status
import Network.Wai.Handler.WarpTLS (runTLS, tlsSettings)
import Network.Wai.Handler.Warp (defaultSettings, setPort)
import Network.Wai (Response)
import Network.Wai.Middleware.Cors
import qualified Core.Item.Controller as ItemController
import System.Environment (lookupEnv)
type App r m = (ItemController.Service m, MonadIO m)
main :: (App r m) => (m Response -> IO Response) -> IO ()
main runner = do
port <- acquirePort
mayTLSSetting <- acquireTLSSetting
case mayTLSSetting of
Nothing ->
scottyT port runner routes
Just tlsSetting -> do
app <- scottyAppT runner routes
runTLS tlsSetting (setPort port defaultSettings) app
where
acquirePort = do
port <- fromMaybe "" <$> lookupEnv "PORT"
return . fromMaybe 3000 $ readMay port
acquireTLSSetting = do
env <- (>>= readMay) <$> lookupEnv "ENABLE_HTTPS"
let enableHttps = fromMaybe True env
return $ if enableHttps
then Just $ tlsSettings "secrets/tls/certificate.pem" "secrets/tls/key.pem"
else Nothing
routes :: (App r m) => ScottyT LText m ()
routes = do
-- middlewares
middleware $ cors $ const $ Just simpleCorsResourcePolicy
{ corsRequestHeaders = "Authorization":simpleHeaders
, corsMethods = "PUT":"DELETE":simpleMethods
}
options (regex ".*") $ return ()
-- errors
defaultHandler $ \str -> do
status status500
json str
-- feature routes
ItemController.routes
-- health
get "/api/health" $
json True
Actually, the errors are related. In Main.hs, change the import of Home to:
import qualified Platform.Home as Home
^^^^^^^^^-- add this
and it should fix both errors. The following minimal example gives the same pair of errors:
-- contents of Home.hs
module Home where
main :: (Int -> Int) -> IO ()
main = undefined
-- contents of Main.hs
import Home
main = Home.main id
but works if you change import Home to import qualified Home.
The issue appears to be that GHC tries to type-check Home.main as the program's main function (perhaps simply because it was the first one defined, having been imported before the definition of Main.main in the body of the module), and it generates this extra error message because Home.main's type doesn't match the required signature of IO t for a main function. This happens before it gets around to noticing that there are two definitions of main (i.e., the "ambiguous occurrence" error), and it's typechecked the wrong one.
I'm struggling to compile the following program:
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.URLEncoded
import Reflex.Dom
url :: T.Text
url = T.pack "parm1=one&parm2=two"
main = do
mainWidget body
body :: MonadWidget t m => m ()
body = el (T.pack "div") $ do
-- let t = (T.pack "this program works if you replace the line below with this")
t <- fmap (T.pack . fromMaybe "" . Data.URLEncoded.lookup "parm2") (importString (T.unpack url))
text t
however this similar version works with vanilla ghc
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.URLEncoded
url :: T.Text
url = T.pack "parm1=one&parm2=two"
main = do
body
body = do
t <- fmap (T.pack . fromMaybe "" . Data.URLEncoded.lookup "parm2") (importString (T.unpack url))
T.putStrLn t
The compiler says something is ambiguous and I'm not really sure how to implement these to work.
The type variable ‘e0’ is ambiguous
Relevant bindings include body :: m () (bound at reflex.hs:14:1)
These potential instances exist:
instance [safe] Control.Monad.Error.Class.MonadError e (Either e)
-- Defined in ‘Control.Monad.Error.Class’
...plus 13 instances involving out-of-scope types
instance [safe] Control.Monad.Error.Class.MonadError
GHC.IO.Exception.IOException IO
-- Defined in ‘Control.Monad.Error.Class’
instance [safe] (Monad m, Control.Monad.Trans.Error.Error e) =>
Control.Monad.Error.Class.MonadError
e (Control.Monad.Trans.Error.ErrorT e m)
-- Defined in ‘Control.Monad.Error.Class’
FYI: I haven't fully grasped Monads yet and easily get scared with these errors. Help!
In the ghc version, importString is operating in the context of an IO monad do statement . importString is capable of returning a value in the IO monad so the compiler is happy
In the ghcjs version, importString is operating in the context of an m monad do statement (m is specified in the declaration of body ). importString has no way to return a value in the m monad so the compiler complains.
You can get around this by using liftIO to change an IO monad value to a m monad value. Here's your code with this change and a few other changes that I made to help myself understand the code.
import Data.Maybe
import qualified Data.Text as T
import Data.URLEncoded as DU
import Reflex.Dom
import Control.Monad.Trans as CMT
url :: T.Text
url = T.pack "parm1=one&parm2=two"
main = do
mainWidget body
body :: MonadWidget t m => m ()
body = el (T.pack "div") $ do
let istr = CMT.liftIO $ DU.importString (T.unpack url)
t <- fmap (T.pack . fromMaybe "" . DU.lookup "parm2") istr
text t
I'm testing some HTTP requests in haskell and have the below methods:
import qualified Data.ByteString.Lazy as LAZ
import Language.Haskell.TH.Ppr
import System.IO
import Data.Word (Word8)
request :: IO LAZ.ByteString
request = do
response <- simpleHttp "https://www.url.com"
return (response)
exampleFunctionOne:: IO LAZ.ByteString -> IO LAZ.ByteString
exampleFunctionOne bytes = do
html <- bytes
let bytesToChars = bytesToString $ LAZ.unpack html
let x = exampleFunctionTwo bytesToChars
bytes
exampleFunctionTwo :: [Char] -> [Char]
exampleFunctionTwo chars = --Do stuff...
main = do
exampleFunctionOe $ request
My questions are:
Is there a more straight forward way to convert the ByteString to [Char]? Currently I've having to convert to perform (ByteString -> Word8) and then (Word8 -> Char)
Am I correct in saying the 'return ()' statement in my request function is simply re-applying the monad context (in this case IO) to the value I've extracted (response <- simpleHttp)? Or does it have an additional purpose?
To answer your first question, note that there's a different "unpack" in Data.ByteString.Lazy.Char8 with the signature you want:
unpack :: ByteString -> String
It's not unusual for people to import both modules:
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString.Lazy.Char8 as C
and mix and match functions from each.
To answer your second question, yes that's more or less it. For example:
redund = do x <- getLine
y <- return x
z <- return y
u <- return z
return u
is all equivalent to redund = getLine with a bunch of re-wrapping and extracting of pure values into an out of an IO monad.
Continuing my exploration of conduit and aeson, how would I go about using my own data type in stead of Value in this (slightly modified) code snippet from the Yesod book.
{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}
import Network.Wai (Response, responseLBS, Application, requestBody)
import Network.HTTP.Types (status200, status400)
import Network.Wai.Handler.Warp (run)
import Data.Aeson.Parser (json)
import Data.Conduit.Attoparsec (sinkParser)
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (Value(..), encode, object, (.=))
import Control.Exception (SomeException)
import Data.ByteString (ByteString)
import Data.Conduit (ResourceT, ($$))
import Control.Exception.Lifted (handle)
import qualified Data.HashMap.Strict as M
import Data.Aeson.TH (deriveJSON)
-- I ADDED THIS
data JSONRequest = JSONRequest {
command :: ByteString,
params :: M.HashMap ByteString ByteString
}
deriveJSON id ''JSONRequest
-- END OF WHAT I ADDED
main :: IO ()
main = run 3000 app
app :: Application
app req = handle invalidJson $ do
value <- requestBody req $$ sinkParser json
newValue <- liftIO $ dispatch value
return $ responseLBS
status200
[("Content-Type", "application/json")]
$ encode newValue
invalidJson :: SomeException -> ResourceT IO Response
invalidJson ex = return $ responseLBS
status400
[("Content-Type", "application/json")]
$ encode $ object
[ ("message" .= show ex)
]
-- Application-specific logic would go here.
dispatch :: Value -> IO Value
dispatch = return
Basically, I want to change the type of dispatch to JSONRequest -> IO JSONRequest. How do I tell the parser to use my own derived instance of fromJSON?
I tried just adding a type declaration, praying for polymorphic return type on json, but I realised it is strictly for Value.
Just looking at the types, don't you just need to fmap your fromJSON over the result coming from json? With a suitable signature for dispatch we just need:
-- import Data.Aeson
app :: Application
app req = handle invalidJson $ do
result <- requestBody req $$ sinkParser (fmap fromJSON json)
next_result <- liftIO $ dispatch result
return $ responseLBS status200 [("Content-Type", "application/json")]
$ encode next_result
dispatch :: Result JSONRequest -> IO JSONRequest
dispatch (Error str) = undefined
dispatch (Success jsonreq) = return jsonreq
But maybe it's a little clearer written thus:
-- import Data.Aeson
-- import qualified Data.Attoparsec as Atto
toRequest :: Value -> Result JSONRequest
toRequest = fromJSON -- specialized now to your fromJSON
jsonRequestParser :: Atto.Parser (Result JSONRequest)
jsonRequestParser = fmap toRequest json
app :: Application
app req = handle invalidJson $ do
result <- requestBody req $$ sinkParser jsonRequestParser
next_result <- liftIO $ dispatch result
return $ responseLBS status200 [("Content-Type", "application/json")]
$ encode next_result
dispatch :: Result JSONRequest -> IO JSONRequest
dispatch (Error str) = undefined
dispatch (Success jsonreq) = return jsonreq
I left the parser returning a Result JSONRequest so dispatch is handling Error cases too, which might mean you need your exception handling somehow?
I have a parser which parses to an ast which contains Text values. I
am trying to use this parser with quasiquoting, but the implementation
of Data for Text is incomplete. I've attached a smallish test case, when I try to compile Text.hs I get:
Text.hs:17:9:
Exception when trying to run compile-time code:
Data.Text.Text.toConstr
Code: Language.Haskell.TH.Quote.quoteExp expr " test "
Is there a way to get this working?
I read through the discussion here: http://www.haskell.org/pipermail/haskell-cafe/2010-January/072379.html
It seems that no-one has found a proper solution to this issue? Also, I tried the Data instance given there and it didn't work, I have no idea how to fix it (or how to use it since the text package already has a Data instance for Text). I don't really understand a lot of the generics stuff and how it works.
The only solution I have so far is to give up using Text in the ast and go back to using String.
{-# LANGUAGE DeriveDataTypeable #-}
module Syntax where
import Data.Data
import Data.Text
data Expr = Iden Text
| Num Integer
| AntiIden Text
deriving (Eq,Show,Data,Typeable)
---------------------
module Parser where
import Control.Applicative
import Control.Monad.Identity
import qualified Data.Text as T
import Text.Parsec hiding (many, optional, (<|>), string, label)
import Text.Parsec.Language
import qualified Text.Parsec.Token as P
import Text.Parsec.Text ()
import Syntax
parseExpr :: T.Text -> Either ParseError Expr
parseExpr s =
runParser expr () "" s
expr :: ParsecT T.Text () Identity Expr
expr =
whiteSpace >> choice
[do
_ <- char '$'
AntiIden <$> identifier
,Num <$> natural
,Iden <$> identifier
]
identifier :: ParsecT T.Text () Identity T.Text
identifier = T.pack <$> P.identifier lexer
natural :: ParsecT T.Text () Identity Integer
natural = P.natural lexer
lexer :: P.GenTokenParser T.Text () Identity
lexer = P.makeTokenParser langDef
whiteSpace :: ParsecT T.Text () Identity ()
whiteSpace = P.whiteSpace lexer
langDef :: GenLanguageDef T.Text st Identity
langDef = P.LanguageDef
{ P.commentStart = "{-"
, P.commentEnd = "-}"
, P.commentLine = "--"
, P.nestedComments = True
, P.identStart = letter <|> char '_'
, P.identLetter = alphaNum <|> oneOf "_"
, P.opStart = P.opLetter langDef
, P.opLetter = oneOf "+-*/<>="
, P.reservedOpNames= []
, P.reservedNames = []
, P.caseSensitive = False
}
-------------------
module Quasi where
import Language.Haskell.TH.Quote
import Language.Haskell.TH
import Data.Generics
import qualified Data.Text as T
import Syntax
import Parser (parseExpr)
expr :: QuasiQuoter
expr = QuasiQuoter {quoteExp = prs
,quotePat = undefined
,quoteType = undefined
,quoteDec = undefined}
where
prs :: String -> Q Exp
prs s = p s
>>= dataToExpQ (const Nothing
`extQ` antiExpE
)
p s = either (fail . show) return (parseExpr $ T.pack s)
antiExpE :: Expr -> Maybe ExpQ
antiExpE v = fmap varE (antiExp v)
antiExp :: Expr -> Maybe Name
antiExp (AntiIden v) = Just $ mkName $ T.unpack v
antiExp _ = Nothing
----------------------------
-- test.hs:
{-# LANGUAGE QuasiQuotes #-}
import Syntax
import Quasi
test,test1,test2 :: Expr
-- works
test = [expr| 1234 |]
-- works
test1 = let stuff = Num 42
in [expr| $stuff |]
-- doesn't work
test2 = [expr| test |]
main :: IO ()
main = putStrLn $ show test2
Solution: add this function using extQ to the dataToExpQ call:
handleText :: T.Text -> Maybe ExpQ
handleText x =
-- convert the text to a string literal
-- and wrap it with T.pack
Just $ appE (varE 'T.pack) $ litE $ StringL $ T.unpack x
Add an extQ for handleText where handleText explicitly takes Text to an ExpQ, rather than going through generic machinery.
Here's one for Strings, for example, that renders them more efficiently than as explicit cons cells:
handleStr :: String -> Maybe (TH.ExpQ)
handleStr x = Just $ TH.litE $ TH.StringL x