I have a data similar to, but a bit more nested and of course named differently:
data AppModel = AppModel
{ _foo :: Maybe String
} deriving (Eq, Show)
I would like to pass it to the Monomer textField
textField :: WidgetEvent e => ALens' s Text -> WidgetNode s e
textField field = textField_ field def
I found it can be lensed with _Just prism, but when appling it in the way it was suggested https://stackoverflow.com/a/44624359/11684473
textField $ foo . _Just . packed
It fails with:
No instance for (Applicative (Control.Lens.Internal.Context.Pretext (->) Text Text)) arising from a use of ‘_Just’
**What will be the proper way to expose the maybe value in the textField?
Related
I am following this tutorial, from which the below example comes: https://github.com/hansroland/reflex-dom-inbits/blob/master/tutorial.md
bodyElement :: MonadWidget t m => m ()
bodyElement = el "div" $ do
el "h2" $ text "Dropdown"
text "Select country "
dd <- dropdown 2 (constDyn countries) def
el "p" $ return ()
let selItem = result <$> value dd
dynText selItem
countries :: Map.Map Int T.Text
countries = Map.fromList [(1, "France"), (2, "Switzerland"), (3, "Germany"), (4, "Italy"), (5, "USA")]
result :: Int -> T.Text
result key = "You selected: " <> fromJust (Map.lookup key countries)
I want replace constDyn countries from the above with a function that takes the type (?) constructors of a sum type and uses them as the elements of the drop down.
For example, if I have the below sum type, I want the drop down to display "Workout" and "Run". And if I later add, say, Solo_WatchPracticeTape, the dropdown would automatically add "Watch Practice Tape".
data SoloPersonPracticeType =
Solo_Workout
| Solo_Run
I infer that I need to make a function that associates each sum type with a string, then another function that turns all of those things into something traversable that can be taken in by constDyn. But I do not see how to implement this.
EDIT:
I am trying this, but it is still unfinished:
displaySoloPersonPracticeType :: SoloPersonPracticeType -> [Char]
displaySoloPersonPracticeType Solo_Workout = "Workout"
displaySoloPersonPracticeType Solo_Run = "Run"
deriving instance Enum SoloPersonPracticeType
deriving instance Bounded SoloPersonPracticeType
instance Universe SoloPersonPracticeType where
universe = [minBound..]
But I still do not understand how to feed this into constDyn in the bodyElement function.
Classes like Universe and Enum are generally the tool you want for this. You effectively want a way to generate a list from these instances and that's pretty easy:
[(e, show e) | e <- [minBound..]]
Here show presumes your type has a Show instance. You could as easily replace that with your own custom "showy" thing:
showMyType :: MyType -> Text
showMyType = \case
MyType_A -> "A"
MyType_B -> "B"
...
Finally, all you need is to pass this entire list as a Dynamic t (Map MyType Text) to dropdown like this: constDyn (Map.fromList [(e, showMyType e) | e <- [minBound..]])
I am new to Haskell, so maybe I am missing some fundamental concepts here (or maybe failed to find the appropriate extension). I was wondering if there was a way to optimize or further abstract the following scenario. This code seems very redundant.
Let's say I have the following data classes:
data Person = Person
{ personName :: !String
, personAge :: !Int
} deriving Show
data Dog = Dog
{ dogName :: !String
, dogAge :: !Int
} deriving Show
Let's say I have a service and I'm only concerned with outputing records as strings. In reality, the strings will probably be JSON and the records fetched from the DB, but let's take a simpler case. I basically need a URL token to fetch an appropriate object (say, the string "dog" will get me a Dog, or even just the Haskell "show" string, without expressly declaring it as (value)::Dog).
I have attempted to implement this in several ways...the only thing that seems to work is the following:
data Creature = DogC Dog
| PersonC Person
deriving Show
fromString :: String -> Maybe Creature
fromString "dog" = Just $ DogC $ Dog "muffin" 8
fromString "person" = Just $ PersonC $ Person "John" 22
fromString _ = Nothing
main :: IO ()
main = do
putStrLn $ show $ fromString "dog"
I'm not entirely fond of the new type, nor the list of fromString declarations. And to benefit from the original data declarations, I would probably need to write a similarly tedious expression (eg, "fromCreature") to revert Creature back into my original types. This information might change, so I would probably need TH for a few of the declarations...
Is there a way around some of this? I fiddled with GADTs and classes, but both seemed to be dependent on type- rather than value- based polymorphism (A string identifier tends to cause issues with ambiguous instances). It would be nice to map the constructor to a string (Say, with Data.Map), but constructors often have different kinds.
Update
So, I went with an approach that isn't exactly relevant to the question I had asked, but it may be useful to someone. I did want to maintain some record types, but most didn't add much value and were getting in my way. The steps I had followed went something like:
Use a different/lower-level DB driver, that returns workable types (eg, [ColumnDef] and [[SQLValue]] instead of tuples and records...).
Create ToJSON instances for SQLValue -- most of the types were covered, except a few ByteString types, and I had to handle the conversion of SQLNull to Null. To maintain compatibility with some record types, my default handler looked like: toJSON = genericToJSON defaultOptions { sumEncoding = UnTaggedValue} The untagged value should allow one to read the JSON into defined data types (eg, Dog / Person ) if desired....
Given that column name is accessible from ColumnDef, I wrote an expression that zips [ColumnDef] and [SqlValue] to a list of Aeson-compatible key-value pairs, eg: toJsPairs :: [ColumnDef] -> [SqlValue] -> [(Text,Value)]
Then, I wrote an expression to fetch the JSON from a table name, which more or less serves as my "universal dispatcher." It references a list of authorized tables, so it's less crazy than it might sound.
The code looked a bit like this (using mysql-haskell).
{-# LANGUAGE OverloadedStrings #-}
import qualified Control.Applicative as App
import Database.MySQL.Base
import qualified System.IO.Streams as Streams
import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson.Encode.Pretty (encodePretty)
import Data.Aeson.Types
import Data.Text.Encoding
import Data.String (fromString)
import Data.ByteString.Internal
import qualified Data.ByteString.Lazy.Internal as BLI
import Data.HashMap.Strict (fromList)
appConnectInfo = defaultConnectInfo {
ciUser = "some_user"
, ciPassword = "some_password"
, ciDatabase = "some_db"
}
instance FromJSON ByteString where
parseJSON (String s) = pure $ encodeUtf8 s
parseJSON _ = App.empty
instance ToJSON ByteString where
toJSON = String . decodeUtf8
instance ToJSON MySQLValue where
toJSON (MySQLNull) = Null
toJSON x = genericToJSON defaultOptions
{ sumEncoding = UntaggedValue } x
-- This expression should fail on dimensional mismatch.
-- It's stupidly lenient, but really dimensional mismatch should
-- never occur...
toJsPairs :: [ColumnDef] -> [MySQLValue] -> [(Text,Value)]
toJsPairs [] _ = []
toJsPairs _ [] = []
toJsPairs (x:xs) (y:ys) = (txt x, toJSON y):toJsPairs xs ys
where
-- Implement any modifications to the key names here
txt = decodeUtf8.columnName
listRecords :: String -> IO BLI.ByteString
listRecords tbl = do
conn <- connect appConnectInfo
-- This is clearly an injection vulnerability.
-- Implemented, however, the values for 'tbl' are intensely
-- vetted. This is just an example.
(defs, is) <- query_ conn $ fromString ( "SELECT * FROM `" ++ tbl ++ "` LIMIT 100")
rcrds <- Streams.toList is
return $ encodePretty $ map (jsnobj defs) rcrds
where
jsnobj :: [ColumnDef] -> [MySQLValue] -> Value
jsnobj defs x = Object $ fromList $ toJsPairs defs x
If what you want to consume at the end is json value - it might make sense to
represent result as json value using aeson library:
{-# LANGUAGE DeriveGeneric #-}
import Data.Aeson
import GHC.Generics
data Dog = Dog Int String deriving (Show, Generic)
data Cat = Cat Int String deriving (Show, Generic)
-- here I'm using instance derived with generics, but you can write one by
-- hands
instance ToJSON Dog
instance ToJSON Cat
-- actions to get stuff from db
getDog :: Monad m => Int -> m Dog
getDog i = return (Dog i (show i))
getCat :: Monad m => Int -> m Cat
getCat i = return (Cat i (show i))
-- dispatcher - picks which action to use
getAnimal :: Monad m => String -> Int -> m (Maybe Value)
getAnimal "dog" i = Just . toJSON <$> getDog i
getAnimal "cat" i = Just . toJSON <$> getCat i
getAnimal _ _ = return Nothing
main :: IO ()
main = do
getAnimal "dog" 2 >>= print
getAnimal "cat" 3 >>= print
getAnimal "chupakabra" 12 >>= print
High energy magic version
class Monad m => MonadAnimal m where
-- basically you want something that fetches extra argumets from HTTP or
-- whatevere, perform DB query and so on.
class Animal a where
animalName :: Proxy a -> String
animalGetter :: MonadAnimal m => m a
locateAnimals :: MonadAnimal m => Q [(String, m Value)]
locateAnimals -- implement using TH (reify function is your friend). It should look for
-- all the animal instances in scope and make a list from them with serialized
-- fetcher.
-- with that in place dispatcher should be easy to implement
I'm not sure if I'm barking up the wrong tree here, but I have an Aeson FromJSON definition that looks rather bulky and I was wondering if it could be turned into something more concise. I want to short-circuit the parsing of the entire object if the nested parsing of the URI fails.
data Link = Link { link :: URI
, tags :: [String]
} deriving (Show, Typeable, Eq)
instance FromJSON Link where
parseJSON :: Value -> Parser Link
parseJSON (Object o) = do
linkStr <- o .: "link"
tags' <- o .: "tags"
case parseURI linkStr of
Just l -> return $ Link l tags'
Nothing -> mzero
parseJSON _ = mzero
The type of parseURI is parseURI :: String -> Maybe URI and both Maybe and Parser have MonadPlus instances. Is there a way to compose the two directly and remove the ugly case statement at the end?
Applicative parsers are usually more concise and you can compose the result of parseURI using maybe mzero return which converts a Nothing into an mzero.
instance FromJSON Link where
parseJSON :: Value -> Parser Link
parseJSON (Object o) = Link
<$> (maybe mzero return . parseURI =<< o .: "link")
<*> o .: "tags"
parseJSON _ = mzero
Pattern matching works, but this only works inside do notation not explicit >>= due to the extra desugaring that goes on:
instance FromJSON Link where
parseJSON (Object o) = do
Just link' <- o .: "link"
tags' <- o .: "tags"
return $ Link link' tags'
parseJSON _ = mzero
> -- Note that I used link :: String for my testing instead
> decode "{\"link\": \"test\", \"tags\": []}" :: Maybe Link
Just (Link {link = "test", tags=[]})
> decode "{\"tags\": []}" :: Maybe Link
Nothing
What's going on here is that a failed pattern match on the left hand side of a <- is calling fail. Looking at the source for Parser tells me that fail is calling out to failDesc, which is also used by the implementation of mzero, so in this case you're safe. In general it just calls fail, which can do any number of things depending on the monad, but for Parser I'd say it makes sense.
However, #shang's answer is definitely better since it doesn't rely on implicit behavior.
Today I wanted to solve next problem.
Assume that we have typeclass DataWithDefault defined as
class DataWithDefault a where
defaultValue :: a
And we have data Example defined as
data Example =
Example { field1 :: Text
, field2 :: Text
} deriving (Show)
instance DataWithDefault Example where
defaultValue = Example "Hello" "World"
instance FromJSON Example where
parseJSON (Object v) =
Example <$> v .:? "field1" .!= field1 defaultValue
<*> v .:? "field2" .!= field2 defaultValue
parseJSON _ = mzero
instance ToJSON Example where
toJSON (Example f1 f2) =
object [ "field1" .= f1
, "field2" .= f2
]
I know that Aeson uses Generics to derive FromJSON and ToJSON instances automatically, but I can't figure out how to make it derive FromJSON instance with default values for fields that are not represented in given json. Is it possible to do using generics? Actually I don't ask you a final solution, but maybe some clue?
Update
Let me add more information about the problem.
Suppose now that you need to update your Example data and now it defined as
data Example =
Example { field1 :: Text
, field2 :: Text
, field3 :: Int
} deriving (Show)
So you want to update DataWithDefault instance declaration
instance DataWithDefault Example where
defaultValue = Example "Hello" "World" 12
And what I want to do is not to write
instance FromJSON Example where
parseJSON (Object v) =
Example <$> v .:? "field1" .!= field1 defaultValue
<*> v .:? "field2" .!= field2 defaultValue
<*> v .:? "field3" .!= field3 defaultValue
parseJSON _ = mzero
And want to derive such instance definition automatically. And more importantly, I want to do it not only for Example, but for DataWithDefault a.
Update 2
The point of combining .:? and .!= is to get as much as possible fields from given json and set every missing field to it's default value. So when we pass
{ "field1" : "space", "field2" : "ship" }
I want my new example be not field1 = Hello; field2 = World; field3 = 12, but field1 = space; field2 = ship; field3 = 12.
Instead of making Aeson do it, just use a newtype for what they were designed for:
newtype DefaultJSON a = DefaultJSON { unDefaultJSON :: a }
instance (FromJSON a, DataWithDefault a) => FromJSON (DefaultJSON a) where
parseJSON v = DefaultJSON <$> (parseJSON v <|> pure defaultValue)
Then you can do
> decode "{}" :: Maybe (DefaultJSON Example)
Just (DefaultJSON {unDefaultJSON = (Example {field1 = "Hello", field2 = "World"}})
This is a little different than what you asked, it provides a default value in case parsing fails, but not a default value for each field in case that individual field is missing.
I have a deeply nested data structure, and I'm using Control.Lens.* to simplify accessing its values in a state monad.
So consider the following:
data Config = Config { _foo :: Maybe Int
, _bar :: Int
}
$(makeLenses ''Config)
How do I operate "functorially" over the Maybe? I'd like to write an idiomatic getter that does:
config = Config (Just 1) 0
config^.foo.to fmap (+1) == Just 2
Better still, how would we handle the case when Config is nested deeper?
data Config = { _foo :: Maybe Foo }
data Foo = Foo { _bar :: Bar }
data Bar = Bar Int
$(makeLenses ''Bar)
$(makeLenses ''Foo)
Can we use the accessors foo and bar to Maybe return a modified Bar?
You'll want to use a Prism to (maybe) go into the the Just branch.
>>> let config' = config & foo . _Just .~ (+1)
in config' ^. foo
Just 2
And then this Prism will compose just the same as other lenses, forming Traversals.
foo . _Just . bar . _Bar :: Traversal' Config Int
Take a look at some tutorials I wrote on lens that spend a little time examining how Lens and Prism relate:
https://www.fpcomplete.com/user/tel/a-little-lens-starter-tutorial
https://www.fpcomplete.com/user/tel/lens-aeson-traversals-prisms