PureScript - Access Properties of a NewType - purescript

Consider the following code sample, which creates a new type to represent a customer model:
module Main where
import Effect (Effect)
import Effect.Console ( logShow )
import Prelude (Unit,(+),(/),(*),(-), (<>),discard)
newtype Customer
= Customer
{ firstname :: String
}
sample :: Customer
sample = Customer
{ firstname : "Average"
}
first :: Customer -> String
first a = _.firstname a
main = do
logShow ( first sample )
The expected output would be the value Average, which is equal to sample.name, but instead an error is produced:
Could not match type
{ firstname :: t0
| t1
}
with type
Customer
while checking that type Customer
is at least as general as type { firstname :: t0
| t1
}
while checking that expression a
has type { firstname :: t0
| t1
}
in value declaration first
where t0 is an unknown type
t1 is an unknown type
This is a good error, but doesn't explain how to actually access this value.
How do you access the value of an object created as a newType?

You have to do
first :: Customer -> String
first (Customer a) = _.firstname a
Since newtype is really, a new type.

One another way is to derive Newtype instance for that particular newtype, which exposes certain functions that will let you work on the data wrapped by the newtype.
derive instance newtypeCustomer :: Newtype Customer _
first :: Customer -> String
first = (_.firstname <<< unwrap)

Related

Is there better way to unwrap record from sum type?

I have a sum type with record param, records have the same prop of the same type (tag :: String), and I need to get its value from passed T type value. So I do with case pattern matching:
data T = T1 { tag :: String, ... } | T2 { tag :: String, ...} | T3 {tag :: String, ...}
fun :: T -> String
fun t = case t of
T1 { tag } -> tag
T2 { tag } -> tag
T3 { tag } -> tag
I wonder if there is a more simple, less verbose way to do this?
If all your cases always have this field, and its semantics is the same in all cases (otherwise why would you have a function that conflates them?), then a cleaner design would be to bring it out of the cases:
type T = { tag :: String, theCase :: TCase }
data TCase = T1 { ... } | T2 { ... } | T3 { ... }
fun :: T -> String
fun = _.tag

Getting "An infinite type was inferred for an expression" for query'/request from Halogen

In my component:
data Query a = SetImageUrl Int String a
Main (app) component:
eval :: Query ~> H.ParentDSL State Query ChildQuery ChildSlot Void m
eval = case _ of
HandleItemChange groupId (LIS.ActiveChanged selected) next -> do
let apReq = AP.SetImageUrl groupId (imageUrl selected)
_ <- H.query' CP.cp2 AvatarPictureSlot (H.request apReq)
pure next
Compiler says:
[1/1 InfiniteType] src/App.purs:85:57
85 _ <- H.query' CP.cp2 AvatarPictureSlot (H.request apReq)
^^^^^
An infinite type was inferred for an expression:
t0 -> t0
while trying to match type t0 -> t0
with type t0
while checking that expression apReq
has type (t0 -> t0) -> t1 t0
in value declaration app
where t0 is an unknown type
t1 is an unknown type
I think slots and child paths are alright, because render function compiles and works correctly.
How to fix this error? I checked several times against guide, but I simply don't see any difference and the compiler message is super unhelpful (for me).
Solution from github:
_ <- H.query' CP.cp2 AvatarPictureSlot (H.action apReq)
For queries not returning anything one should use H.action not H.request.

Purescript types for buildQueryString function

I am new to Purescript and I am trying to write a function that
can take any record value and iterate over the fields and values and build
a querystring.
I am thinking something like:
buildQueryString :: forall a. PropertyTraversible r => r -> String
which I want to use like this:
buildQueryString {name: "joe", age: 10} -- returns: "name=joe&age=10"
Is there a way to write something like that in Purescript with existing idioms or do I have to create my own custom Type Class for this?
I'm sure that it can be shorter, but here is my implementation based on purescript-generic-rep (inspired by genericShow). This solution uses typeclasses - it seems to be standard approach with generic-rep:
module Main where
import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Data.Foldable (intercalate)
import Data.Generic.Rep (class Generic, Constructor(..), Field(..), Product(..), Rec(..), from)
import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
class EncodeValue a where
encodeValue ∷ a → String
instance encodeValueString ∷ EncodeValue String where
encodeValue = id
instance encodeValueInt ∷ EncodeValue Int where
encodeValue = show
class EncodeFields a where
encodeFields :: a -> Array String
instance encodeFieldsProduct
∷ (EncodeFields a, EncodeFields b)
⇒ EncodeFields (Product a b) where
encodeFields (Product a b) = encodeFields a <> encodeFields b
instance encodeFieldsField
∷ (EncodeValue a, IsSymbol name)
⇒ EncodeFields (Field name a) where
encodeFields (Field a) =
[reflectSymbol (SProxy :: SProxy name) <> "=" <> encodeValue a]
buildQueryString
∷ ∀ a l n.
Generic n (Constructor l (Rec a))
⇒ (EncodeFields a)
⇒ n
→ String
buildQueryString n =
build <<< from $ n
where
build (Constructor (Rec fields)) = intercalate "&" <<< encodeFields $ fields
newtype Person =
Person
{ name ∷ String
, age ∷ Int
}
derive instance genericPerson ∷ Generic Person _
joe ∷ Person
joe = Person { name: "joe", age: 10 }
main :: forall e. Eff (console :: CONSOLE | e) Unit
main = do
log <<< buildQueryString $ joe
buildQueryString expects value of type with single constructor which contains a record (possibly just newtype) because it is impossible to derive a Generic instance for "unwrapped" Record type.
If you want to handle also Array values etc. then encodeValue should probably return values of type Array String.
This is possible with purescript-generics but it only works on nominal types, not on any record. But it saves you boilerplate, since you can just derive the instance for Generic, so it would work with any data or newtype without further modification.
Downside is, you have to make some assumptions about the type: like it only contains one record and the record does not contain arrays or other records.
Here is a hacky demonstration how it would work:
data Person = Person
{ name :: String
, age :: Int
}
derive instance genericPerson :: Generic Person
joe = Person { name: "joe", age: 10 }
build :: GenericSpine -> String
build (SRecord arr) = intercalate "&" (map (\x -> x.recLabel <> "=" <> build (x.recValue unit)) arr)
build (SProd _ arr) = fromMaybe "TODO" $ map (\f -> build (f unit)) (head arr)
build (SString s) = s
build (SInt i) = show i
build _ = "TODO"
test = build (toSpine joe)
purescript-generics-rep is newer, so possibly there is a better solution, maybe even on any record. I have not tried that (yet).

Opaleye newtype

One of the fields in my datatype for a table in my PostgreSQL database is a newtype wrapping UUID called ItemId.
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Data.DateTime (DateTime)
import Data.UUID
import GHC.Generics
import qualified Opaleye as O
import Data.Text (pack, Text)
newtype ItemId = ItemId UUID
deriving (Show, Eq, Generic)
toItemId :: UUID -> ItemId
toItemId = ItemId
fromItemId :: ItemId -> UUID
fromItemId (ItemId x) = x
data Item' id name desc num most
= Item {
_itemId :: id,
_itemName :: name,
_itemDesc :: desc,
_numTimesOrdered :: num,
_mostRecentOrder :: most
}
type ItemRead = Item' ItemId Text Text Int DateTime
type ItemWrite = Item' (Maybe ItemId) Text Text (Maybe Int) (Maybe DateTime)
type ItemColRead = Item' (O.Column O.PGUuid)
(O.Column O.PGText)
(O.Column O.PGText)
(O.Column O.PGInt4)
(O.Column O.PGTimestamptz)
type ItemColWrite = Item' (Maybe (O.Column O.PGUuid))
(O.Column O.PGText)
(O.Column O.PGText)
(Maybe (O.Column O.PGInt4))
(Maybe (O.Column O.PGTimestamptz))
$(makeAdaptorAndInstance "pItem" ''Item')
itemTable :: O.Table ItemColWrite ItemColRead
itemTable = O.Table "items" (pItem Item { _itemId = O.optional "id"
, _itemName = O.required "name"
, _itemDesc = O.required "desc"
, _numTimesOrdered = O.optional "numTimesOrdered"
, _mostRecentOrder = O.optional "mostRecentOrder"
})
itemToPG :: ItemWrite -> ItemColWrite
itemToPG = pItem Item { _itemId = const Nothing
, _itemName = O.pgStrictText
, _itemDesc = O.pgStrictText
, _numTimesOrdered = const Nothing
, _mostRecentOrder = const Nothing
}
However, when I compile my project, GHC throws:
/home/gigavinyl/Projects/ordermage/src/Api/Item.hs:34:3: error:
• No instance for (O.QueryRunnerColumnDefault O.PGUuid ItemId)
arising from a use of ‘O.runInsertManyReturning’
• In the second argument of ‘(<$>)’, namely
‘O.runInsertManyReturning con itemTable [itemToPG item] _itemId’
In the second argument of ‘($)’, namely
‘listToMaybe
<$> O.runInsertManyReturning con itemTable [itemToPG item] _itemId’
In the expression:
liftIO
$ listToMaybe
<$> O.runInsertManyReturning con itemTable [itemToPG item] _itemId
where src/Api/Item.hs is:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
module Api.Item where
import Control.Monad.IO.Class (liftIO)
import Data.Maybe (listToMaybe)
import Database.PostgreSQL.Simple (Connection)
import Models.Item
import Queries.Item
import Servant
import qualified Opaleye as O
type ItemApi =
Get '[JSON] [ItemRead] :<|>
Capture "itemId" ItemId :> Get '[JSON] (Maybe ItemRead) :<|>
ReqBody '[JSON] ItemWrite :> Post '[JSON] (Maybe ItemId)
itemServer :: Connection -> Server ItemApi
itemServer con =
getItems con :<|>
getItemById con :<|>
postItem con
getItems :: Connection -> Handler [ItemRead]
getItems con = liftIO $ O.runQuery con itemsQuery
getItemById :: Connection -> ItemId -> Handler (Maybe ItemRead)
getItemById con itemID = liftIO $ listToMaybe <$> O.runQuery con (itemByIdQuery itemID)
postItem :: Connection -> ItemWrite -> Handler (Maybe ItemId)
postItem con item = liftIO $ listToMaybe <$>
O.runInsertManyReturning con itemTable [itemToPG item] _itemId
I'm still fairly new to Haskell but the issue appears to be that Opaleye doesn't know how to convert ItemId into a PGUuid but I know it can convert UUID to PGUuid. How would I go about writing the instance to allow Opaleye to do this conversion?
the issue appears to be that Opaleye doesn't know how to convert ItemId into a PGUuid but I know it can convert UUID to PGUuid
It's the other way round. It's trying to convert a Column PGUuid into an ItemId and it only knows how to convert it into a UUID. One approach is to add the instance yourself:
instance O.QueryRunnerColumnDefault O.PGUuid ItemId where
queryRunnerColumnDefault =
O.queryRunnerColumn id ItemId queryRunnerColumnDefault
Another approach would be to make ItemId polymorphic:
newtype ItemId' a = ItemId a
$(makeAdaptorAndInstance "pItemId" ''ItemId')
and then you can use it on both the Haskell side and Opaleye side without having to write the extra instance.

Purescript Reuse Argonaut JSON Decoding for Affjax Respondeable

I'm trying to fetch some JSON data from a Haskell server, but I'm having trouble with the Respondeable instance, as well as just Affjax in general. I've defined EncodeJson + DecodeJson with Data.Argonaut.Generic.Aeson (GA), but I can't figure out how to fit that in with the Respondeable instance and it's fromResponse function.
It gives me the error "Could not match type Foreign with type Json" but is it possible to reuse my decodeJson instance without having to create anything else by hand? Maybe by creating an IsForeign instance, but using GA.decodeJson in that? I'm just not sure how to go about doing it. I've seen how it's done in https://github.com/purescript/purescript-foreign/blob/master/examples/Complex.purs by hand, but I have complex types that need to match up with my Haskell JSON output, and it's going to be a huge pain to do it manually.
I'm using purescript 10.7, Affjax 3.02, and argonaut 2.0.0, and argonaut-generic-codecs 5.1.0. Thanks!
testAffjax :: forall eff. Aff (ajax :: AJAX | eff) (Answer)
testAffjax = launchAff do
res <- affjax $ defaultRequest { url = "/", method = Left GET }
pure res.response
data Answer = Answer {
_answer :: String
, _isCorrect :: Boolean
, _hint :: String
}
{- PROBLEM -}
instance respondableAnswer :: Respondable Answer where
responseType = Tuple Nothing JSONResponse
fromResponse = GA.decodeJson {- Error here -}
derive instance genericAnswer :: Generic Answer
instance showAnswer :: Show Answer where
show = gShow
instance encodeAnswer :: EncodeJson Answer where
encodeJson = GA.encodeJson
instance decodeAnswer :: DecodeJson Answer where
decodeJson = GA.decodeJson
What you're looking for is a function that adapts a JSON decoder:
decodeJson :: forall a. Json -> Either String a
To return using F rather than Either. F is a synonym defined in Data.Foreign for Except MultipleErrors a. To do that we need to:
Translate our String error into a MultipleErrors
Convert from Either to Except
MultipleErrors is another synonym defined in Data.Foreign, this time for NonEmptyList ForeignError. Looking at ForeignError there's a constructor also called ForeignError that lets us provide some string message. That leaves us with the need to create a NonEmptyList, which is pretty easy:
remapError = pure <<< ForeignError
NonEmptyList is Applicative, so we can create a one-element list with pure.
To go from Either to Except is also straightforward. Again looking at the definitions in Pursuit we can see:
newtype ExceptT m e a = ExceptT (m (Either e a))
type Except = ExceptT Identity
So ExceptT is just a fancy Either already, giving us:
eitherToExcept = ExceptT <<< pure
The pure here is to lift Either e a into m (Either e a), which for Except m ~ Identity.
So now we can take this stuff, and make a general "decode JSON for Affjax responses" function:
decodeJsonResponse :: forall a. DecodeJson a => Json -> F a
decodeJsonResponse =
ExceptT <<< pure <<< lmap (pure <<< ForeignError) <<< decodeJson
The only other thing that happened in here is we used lmap to map over the left part of the Either, to do the error-message-type-conversion bit.
We can now use Kleisli composition ((<=<)) to chain this decodeJsonResponse together with the original fromResponse that will do the initial ResponseContent -> F Json:
instance respondableAnswer :: Respondable Answer where
responseType = Tuple (Just applicationJSON) JSONResponse
fromResponse = decodeJsonResponse <=< fromResponse
Here's the full example using your Answer type:
module Main where
import Prelude
import Control.Monad.Aff (Aff)
import Control.Monad.Except (ExceptT(..))
import Data.Argonaut (class DecodeJson, class EncodeJson, Json, decodeJson)
import Data.Argonaut.Generic.Argonaut as GA
import Data.Bifunctor (lmap)
import Data.Foreign (F, ForeignError(..))
import Data.Generic (class Generic, gShow)
import Data.Maybe (Maybe(..))
import Data.MediaType.Common as MediaType
import Data.Tuple (Tuple(..))
import Network.HTTP.Affjax as AX
import Network.HTTP.Affjax.Response as AXR
testAffjax :: forall eff. Aff (ajax :: AX.AJAX | eff) Answer
testAffjax = _.response <$> AX.get "/"
newtype Answer = Answer
{ _answer :: String
, _isCorrect :: Boolean
, _hint :: String
}
derive instance genericAnswer :: Generic Answer
instance showAnswer :: Show Answer where
show = gShow
instance encodeAnswer :: EncodeJson Answer where
encodeJson = GA.encodeJson
instance decodeAnswer :: DecodeJson Answer where
decodeJson = GA.decodeJson
instance respondableAnswer :: AXR.Respondable Answer where
responseType = Tuple (Just MediaType.applicationJSON) AXR.JSONResponse
fromResponse = decodeJsonResponse <=< AXR.fromResponse
decodeJsonResponse :: forall a. DecodeJson a => Json -> F a
decodeJsonResponse =
ExceptT <<< pure <<< lmap (pure <<< ForeignError) <<< decodeJson