How can I convert the below example to use an external file instead of the embedded lazy text quasi quotes?
{-# LANGUAGE QuasiQuotes, OverloadedStrings #-}
import Text.Shakespeare.Text
import qualified Data.Text.Lazy.IO as TLIO
import Data.Text (Text)
import Control.Monad (forM_)
data Item = Item
{ itemName :: Text
, itemQty :: Int
}
items :: [Item]
items =
[ Item "apples" 5
, Item "bananas" 10
]
main :: IO ()
main = forM_ items $ \item -> TLIO.putStrLn
[lt|You have #{show $ itemQty item} #{itemName item}.|]
This is from the yesod online book.
You can use the textFile function, along the lines of $(textFile "some-file").
Related
Starting with "A Simple Example" from the Pandoc documentation, I want to add citation processing functionality. The docs for Text.Pandoc.Citeproc show a function processCitations which supposedly processes citations. Yet given simple org-mode input, and a citation [#test2022], it doesn't seem to work. It compiles and runs just fine, but the output of the code below is: <p><span class="spurious-link" target="url"><em>testing</em></span> [#test2022]</p>, i.e., the citation isn't actually processed. What am I doing wrong? And how can I get this to process my citation?
import Text.Pandoc
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Text.Pandoc.Filter
import Text.Pandoc.Citeproc
main :: IO ()
main = do
result <- runIO $ do
doc <- readOrg def (T.pack "#+bibliography: test.bib\n [[url][testing]]\n[#test2022]")
processed <- processCitations doc
writeHtml5String def processed
html <- handleError result
TIO.putStrLn html
For reference, here's my test.bib bibtex file:
#Book{test2022,
author = {Barus, Foobius},
title = {The Very Persistent Foo or Bar},
publisher = {Foobar Publications, Inc},
year = {2022}
}
I figured this out myself, eventually. Turns out you have to set some extensions, and some options, and set the metadata for the document:
{-# LANGUAGE OverloadedStrings #-}
import Text.Pandoc
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Text.Pandoc.Filter
import Text.Pandoc.Citeproc
import qualified Data.Map as M
import Text.Pandoc.Builder (setMeta)
main :: IO ()
main = do
let exts = extensionsFromList [ Ext_citations ]
let readerOptions = def{ readerExtensions = exts}
let writerOptions = def{ writerExtensions = exts}
result <- runIO $ do
doc <- readMarkdown readerOptions (T.pack "Testing testing\n[#test2022]\n")
let doc' = setMeta (T.pack "bibliography") (T.pack "test.bib") doc :: Pandoc
processed <- processCitations doc'
writeHtml5String writerOptions processed
html <- handleError result
TIO.putStrLn html
I need to get all the keys in a given object
this is how I managed to do it.
{-# LANGUAGE DeriveGeneric #-}
import System.Environment
import Data.Aeson
import Data.Foldable
import GHC.Generics
import qualified Data.HashMap.Strict as Hashmap
data Person = Person {
name :: String,
age::Int
} deriving (Generic,Show)
instance ToJSON Person
main=do
let p = Person "random" 100
let obj = decode(encode p)::Maybe Object
case obj of
(Just x) -> do
let keysOfObject = Hashmap.keys x
print keysOfObject
_ -> print "failed to decode"
output: ["age","name"]
Is there a better(easier) way of doing this
Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 1 year ago.
Improve this question
I've tried to code a typed version of the first homework exercise. It compiles but fails to render in the playground...
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
import Control.Monad hiding (fmap)
import GHC.Generics (Generic)
import Data.Aeson (FromJSON, ToJSON)
import Data.Map as Map
import Data.Text (Text)
import Data.Void (Void)
import Plutus.Contract hiding (when)
import PlutusTx (Data (..))
import qualified PlutusTx
import PlutusTx.Prelude hiding (Semigroup(..), unless)
import Ledger hiding (singleton)
import Ledger.Constraints as Constraints
import qualified Ledger.Scripts as Scripts
import qualified Ledger.Typed.Scripts as Scripts
import Ledger.Ada as Ada
import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage, ToSchema)
import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions)
import Playground.Types (KnownCurrency (..))
import Prelude (Semigroup (..))
import Text.Printf (printf)
newtype DuoBoolRedeemer = DuoBoolRedeemer (Bool, Bool)
deriving (Generic, ToSchema)
PlutusTx.unstableMakeIsData ''DuoBoolRedeemer
{-# INLINABLE mkValidator #-}
-- This should validate if and only if the two Booleans in the redeemer are equal!
mkValidator :: () -> DuoBoolRedeemer -> ValidatorCtx -> Bool
mkValidator _ (DuoBoolRedeemer (b1,b2)) _ = traceIfFalse "wrong redeemer" $ b1 == b2
data Typed
instance Scripts.ScriptType Typed where
type instance DatumType Typed = ()
type instance RedeemerType Typed = DuoBoolRedeemer
inst :: Scripts.ScriptInstance Typed
inst = Scripts.validator #Typed
$$(PlutusTx.compile [|| mkValidator ||])
$$(PlutusTx.compile [|| wrap ||])
where
wrap = Scripts.wrapValidator #() #DuoBoolRedeemer
validator :: Validator
validator = Scripts.validatorScript inst
valHash :: Ledger.ValidatorHash
valHash = Scripts.validatorHash validator
scrAddress :: Ledger.Address
scrAddress = ScriptAddress valHash
type GiftSchema =
BlockchainActions
.\/ Endpoint "give" Integer
.\/ Endpoint "grab" DuoBoolRedeemer
give :: (HasBlockchainActions s, AsContractError e) => Integer -> Contract w s e ()
give amount = do
let tx = mustPayToTheScript () $ Ada.lovelaceValueOf amount
ledgerTx <- submitTxConstraints inst tx
void $ awaitTxConfirmed $ txId ledgerTx
logInfo #String $ printf "made a gift of %d lovelace" amount
grab :: forall w s e. (HasBlockchainActions s, AsContractError e) => DuoBoolRedeemer -> Contract w s e ()
grab bs = do
utxos <- utxoAt scrAddress
let orefs = fst <$> Map.toList utxos
lookups = Constraints.unspentOutputs utxos <>
Constraints.otherScript validator
tx :: TxConstraints Void Void
tx = mconcat [mustSpendScriptOutput oref $ Redeemer $ PlutusTx.toData bs | oref <- orefs]
ledgerTx <- submitTxConstraintsWith #Void lookups tx
void $ awaitTxConfirmed $ txId ledgerTx
logInfo #String $ "collected gifts"
endpoints :: Contract () GiftSchema Text ()
endpoints = (give' `select` grab') >> endpoints
where
give' = endpoint #"give" >>= give
grab' = endpoint #"grab" >>= grab
mkSchemaDefinitions ''GiftSchema
mkKnownCurrencies []
I don't understand why it fails. In the playground, for the "grab" action I have the message "Unsuported non record constructor". I think the problem is with ToSchema which may only accept reccords, but if I don't use it, I have an error message requiring it... I don't understand.
I'm no expert, but can you try a:
.\/ Endpoint "grab" (Bool, Bool)
Given that the simulator, imho, only expects simpler things
I'd like to define a constraint on a field so reserved words are not valid. How can I accomplish this in Yesod?
{-# LANGUAGE TemplateHaskell #-}
module Sid where
import Control.Exception
import Data.List
import Database.Persist.TH
import Data.Aeson.TH
import Text.Show
import Text.Read
import Data.Text
data Sid = Sid Text
deriving (Show, Read)
reserved :: [Text]
reserved = ["abc","def"]
allowedSid :: Text -> Sid
allowedSid a = (assert (notElem a reserved)) Sid a
derivePersistField "allowedSid"
deriveJSON defaultOptions ''allowedSid
I'd do this in normal Haskell instead: create a newtype wrapper with some smart constructors. This would look something like:
newtype Sid = Sid Text
mkSid :: Text -> Maybe Sid
mkSid t = if t `elem` reserved then Nothing else Just t
Put this code in a module, and don't export the Sid data constructor.
Trying to use acid-state in Snap, and I hit a roadblock.
Here is what I got so far.
First my acid-state related objects (it's a dummy book with a isbn number):
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}
module Models where
import Prelude hiding ((.), id)
import Control.Category ((.))
import Control.Monad.Reader (asks)
import Data.ByteString (ByteString)
import Data.SafeCopy (base, deriveSafeCopy)
import qualified Data.Text as T
import Data.Typeable (Typeable)
import Data.Acid (Update, Query, makeAcidic)
import Control.Monad.Reader (ask)
import Control.Applicative ((<$>))
import Data.Data (Data)
data Book = Book { isbn :: String }
deriving (Eq, Ord, Read, Data, Show, Typeable)
$(deriveSafeCopy 0 'base ''Book)
-- Retrieve the book's isbn
queryIsbn :: Query Book String
queryIsbn = isbn <$> ask
$(makeAcidic ''Book ['queryIsbn])
And then my actual attempt at integrating it with Snap. As you can see, I am having trouble defining __ doQuery__ function, that should return a string isbn:
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
module Application where
import Control.Monad.Trans.Class (lift)
import Data.Text.Encoding (decodeUtf8)
import Text.XmlHtml (Node(TextNode),Node (Element),
getAttribute, setAttribute, nodeText)
import Data.ByteString (ByteString)
import Data.Maybe
import Snap.Core
import Snap.Snaplet
import Snap.Snaplet.Heist (Heist, HasHeist(heistLens), heistInit,
addSplices, liftHeist, render)
import Snap.Util.FileServe
import Text.Templating.Heist (HeistT, Template, getParamNode)
import Data.Lens.Template
import Models
import Data.Acid.Advanced (query')
import Data.Acid (AcidState, openLocalState, closeAcidState, IsAcidic, query)
import Data.Text (pack)
import Control.Monad.IO.Class (liftIO, MonadIO)
import Snap (snapletValue)
import Data.Lens.Common (getL, (^$), (^.), Lens)
import Control.Monad.Reader (ask, asks)
import Control.Applicative ((<$>))
import Data.Typeable (typeOf)
import Prelude hiding ((.), id)
import Control.Category ((.), id)
------------------------------------------------------------------------------
type AppHandler = Handler App App
--------------
-- Acid
---------------
-- Used for holding data for the snapplet
data Acid st = Acid { _state :: AcidState st }
-- Initializer function for the snapplet
seedBook = Book "9213-23123-2311"
acidInit :: SnapletInit b (Acid Book)
acidInit = makeSnaplet "storage" "Snaplet providing storage functionality" Nothing initializer
--The 'm' is the type variable of the MonadSnaplet type class. 'b' is the base state, and 'v' is the state of the current "view" snaplet (or simply, current state).
initializer :: Initializer b v (Acid Book)
initializer = do
st <- liftIO (openLocalState seedBook)
--onUnload (closeAcidState st)
return $ Acid st
-----------------------
-- Snap Global State
--------------------
data App = App
{ _heist :: Snaplet (Heist App),
_acid :: Snaplet (Acid Book)
}
makeLens ''App
----------------------------------------------------------------------------------
instance HasHeist App where
heistLens = subSnaplet heist
-----------------------------------------------
-- | Initialize app
-----------------------------------------------
appInit :: SnapletInit App App
appInit = makeSnaplet "app" "Website" Nothing $ do
h <- nestSnaplet "" heist $ heistInit "templates"
a <- nestSnaplet "isbn" acid (acidInit)
addRoutes routes --see below
addSplices [ ("menuEntry", liftHeist menuEntrySplice) ]
return $ App h a
------------------------------------------------
-- | The application's routes.
------------------------------------------------
routes :: [(ByteString, Handler App App ())]
routes = [ ("/books", handleBooks)
, ("/contact", render "contact")
, ("/isbn", liftIO doQuery >>= writeBS )
, ("", serveDirectory "static")
]
-- Is this Function signature possible? Or must it run inside Snap or other monad?
doQuery :: IO ByteString
doQuery = do -- ???????????
--somehow retrieve acid store from snaplet
--run queryIsbn on it
--return isbn string
return "BLAH"
handleBooks :: Handler App App ()
handleBooks = render "books"
Any help on what I am missing would be greatly appreciated. If something is not clear, please let me know and I'll update the question.
MathematicalOrchid is correct, the simplest answer to your problem is to use liftIO on the openLocalState call.
But from a broader view, what you're doing here has already been done for you by the snaplet-acid-state package, so I would recommend that you just use that. The repository also includes an example application demonstrating how to use it.
I have no idea about the packages you're using, but it looks like the problem is simply that openLocalState is an IO action, but your type signature requires it to be an Initializer action.
Fixing it might be as simple as stuffing a call to liftIO in there. I'm not really sure though... I don't know which module each of these types comes from.