Haskell Control.Lens Traversing Prism - haskell

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

Related

Lens setter analogous to "monoidal" lens getter?

In some cases, the ^. lens getter defaults to mempty if the field being accessed is not present. Example:
let x = Nothing :: Maybe String
x ^. _Just == ""
What is the analogous lens setter with a similar behaviour? Here's what I'm looking for:
data MyRecord = MyRecord { myrecordFoo :: Maybe Int }
instance Monoid MyRecord where
mempty = MyRecord { myRecordFee = Nothing }
$(makeLensesWith abbreviatedFields ''MyRecord)
let x = Nothing :: Maybe MyRecord
x & _Just . foo `someLensSetter` 10 == (Just $ MyRecord { myRecordFoo = 10 })
I've tried playing around with <>~ and <>=, but couldn't get them to work in the way I expect above. Is this even possible? Is there some other standard combinator I should look at? Any custom combinator that can achieve this?

Haskell UUID generation

I am new to Haskell and need help. I am trying to build a new data type that has to be somehow unique, so I decided to use UUID as a unique identifier:
data MyType = MyType {
uuid :: UUID,
elements :: AnotherType
}
in this way, I can do following:
instance Eq MyType where
x == y = uuid x == uuid y
x /= y = not (x == y)
The problem is that all known (to me) UUID generators produce IO UUID, but I need to use it in a pure code as mentioned above. Could you please suggest if there is any way to extract UUID out of IO UUID, or maybe be there is a better way to do what I need in Haskell? Thanks.
UPDATE
Thanks for all the great suggestions and the code example. From what is posted here I can say you cannot break a referential transparency, but there are smart ways how to solve the problem without breaking it and, probably the most optimal one, is listed in the answer below.
There is also one alternative approach that I was able to explore myself based on provided recommendations with the usage of State Monad:
type M = State StdGen
type AnotherType = String
data MyType = MyType {
uuid :: UUID,
elements :: AnotherType
} deriving (Show)
mytype :: AnotherType -> M MyType
mytype x = do
gen <- get
let (val, gen') = random gen
put gen'
return $ MyType val x
main :: IO ()
main = do
state <- getStdGen
let (result, newState) = runState (mytype "Foo") state
putStrLn $ show result
let (result', newState') = runState (mytype "Bar") newState
setStdGen newState'
putStrLn $ show result'
Not sure if it is the most elegant implementation, but it works.
If you're looking at the functions in the uuid package, then UUID has a Random instance. This means that it's possible to generate a sequence of random UUIDs in pure code using standard functions from System.Random using a seed:
import System.Random
import Data.UUID
someUUIDs :: [UUID]
someUUIDs =
let seed = 123
g0 = mkStdGen seed -- RNG from seed
(u1, g1) = random g0
(u2, g2) = random g1
(u3, g3) = random g2
in [u1,u2,u3]
Note that someUUIDs creates the same three "unique" UUIDs every time it's called because the seed is hard-coded.
As with all pure Haskell code, unless you cheat (using unsafe functions), you can't expect to generate a sequence of actually unique UUIDs without explicitly passing some state (in this case, a StdGen RNG) between calls to random.
The usual solution to avoid the ugly boilerplate of passing the generator around is to run at least part of your code within a monad that can maintain the needed state. Some people like to use the MonadRandom package, though you can also use the regular State monad with a StdGen somewhere in the state. The main advantages of MonadRandom over State is that you get some dedicated syntax (getRandom) and can create a monad stack that includes both RandomT and StateT so you can separate your RNG state from the rest of your application state.
Using MonadRandom, you might write an application like:
import Control.Monad.Random.Strict
import System.Random
import Data.UUID
-- monad for the application
type M = Rand StdGen
-- get a generator and run the application in "M"
main :: IO ()
main = do
g <- getStdGen -- get a timestamp-seeded generator
let log = evalRand app g -- run the (pure) application in the monad
putStr log
-- the "pure" application, running in monad "M"
app :: M String
app = do
foo <- myType "foo"
bar <- myType "bar"
-- do some processing
return $ unlines ["Results:", show foo, show bar]
type AnotherType = String
data MyType = MyType {
uuid :: UUID,
elements :: AnotherType
} deriving (Show)
-- smart constructor for MyType with unique UUID
myType :: AnotherType -> M MyType
myType x = MyType <$> getRandom <*> pure x
Note that substantial parts of the application will need to be written in monadic syntax and run in the application M monad. This isn't a big restriction -- most non-trivial applications are going to be written in some monad.

Haskell Type Polymorphism -- Mapping to String

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

How do you fmap a Getter?

As discussed on reddit, you can't just lift a Lens' a b to Lens' (Maybe a) (Maybe b). But for the special case Getter a b, this is obviously possible, since it's isomorphic to a->b. But unlike with Iso, there appears to be no standard function to perform this lift.
What's the preferred way to do that? In cases like
someFunction $ myMap^.at(i).ꜰᴍᴀᴘGᴇᴛ(mySubGetter)
I could of course do
someFunction $ myMap^.at(i) & fmap (^.mySubGetter)
but that doesn't work as well in other applications, as when operating on a state monad.
foo <- use $ myMapInState.at(i).ꜰᴍᴀᴘGᴇᴛ(mySubGetter)
I believe you can accomplish what you want with a prism.
If your values have these types:
myMap :: Map String (Int, String)
myMap = mempty
mySubGetter :: Lens' (Int, String) String
mySubGetter = _2
then you can do:
myVal :: Maybe String
myVal = myMap ^? at "myKey" . _Just . mySubGetter
If you just want to apply a function to a getter you can use the to function from Control.Lens.Getter, you have to manually deal with the sublens though:
someFunction $ myMap ^. at(i) . to (fmap (^. mySubGetter))

How can I express `mapM` with `concat` using Lenses to concatenate results of an IO operation?

I'm trying to figure out a way how to combine traverseOf with >>= in such a way that would allow the following.
TLDR; A simple example in plain Haskell would be something like this, but using lenses deep inside a data structure.
λ> fmap concat $ mapM ((return :: a -> IO a) . const ["he", "he"]) ["foo", "bar", "baz"]
["he","he","he","he","he","he"]
Here's a lengthy explanation with examples
data Foo = Foo [Bar] deriving Show
data Bar = Baz | Qux Int [String] deriving Show
makePrisms ''Foo
makePrisms ''Bar
items :: [Foo]
items = [Foo [Baz], Foo [Qux 1 ["hello", "world"], Baz]]
-- Simple replacement with a constant value
constReplace :: [Foo]
constReplace = over (traverse._Foo.traverse._Qux._2.traverse) (const "hehe") items
-- λ> constReplace
-- [Foo [Baz],Foo [Qux 1 ["hehe","hehe"],Baz]]
-- Doing IO in order to fetch the new value. This could be replacing file names
-- with the String contents of the files.
ioReplace :: IO [Foo]
ioReplace = (traverse._Foo.traverse._Qux._2.traverse) (return . const "hehe") items
-- λ> ioReplace
-- [Foo [Baz],Foo [Qux 1 ["hehe","hehe"],Baz]]
-- Replacing a single value with a list and concatenating the results via bind
concatReplace :: [Foo]
concatReplace = over (traverse._Foo.traverse._Qux._2) (>>= const ["he", "he"]) items
-- λ> concatReplace
-- [Foo [Baz],Foo [Qux 1 ["he","he","he","he"],Baz]]
-- Same as the previous example, but the list comes from an IO action
concatIoReplace :: IO [Foo]
concatIoReplace = (traverse._Foo.traverse._Qux._2) (return . (>>= const ["he", "he"])) items
-- λ> concatIoReplace
-- [Foo [Baz],Foo [Qux 1 ["he","he","he","he"],Baz]]
Now the last example is where the problem is, because I've cheated a little bit by changing around the function that's being applied. In the concatReplace I was able to use >>= (thanks to the helpful guys on #haskell-lens channel) to implement the concatMap-like functionality. But in my real code the function I have is String -> IO [String], which would look something like this
correctConcatIo :: IO [Foo]
correctConcatIo = (traverse._Foo.traverse._Qux._2) (>>= (return . const ["he", "he"])) items
But this example doesn't typecheck anymore. What I need is to basically put together the logic from ioReplace and concatReplace in a way that I would be able to apply a function with the type String -> IO [String] to a data structure containing [String].
You can only replace a String with [String] if it's already in a list (consider trying to stick a [Int] back into _Qux._1), so you have to turn your function into [String]->IO [String] and replace the whole list, using some approach like you've already demonstrated:
concatMapM f l = fmap concat (mapM f l)
doIOStuff s = return ['a':s, 'b':s]
concatIO :: IO [Foo]
concatIO = (traverse._Foo.traverse._Qux._2) (concatMapM doIOStuff) items
You can even compose that concatMapM onto the end to get something with a LensLike type, but it's not flexible enough to use with most of the lens combinators.

Resources