Using a promoted data constructor as a phantom parameter - haskell

In Maguire's Thinking with Types, p. 29, there's an example of how to use a promoted data constructor as a phantom parameter. Here's a module that I wrote based on the example in the book.
{-# LANGUAGE DataKinds #-}
module Main where
import Data.Maybe
import Data.Proxy
-- | The only purpose of this constructor is to give us access to its
-- promoted data constructors.
data UserType = DummyUser | Admin
-- | Give some users an administration token.
data User = User
{ userAdminToken :: Maybe (Proxy 'Admin),
name :: String
}
doSensitiveThings :: Proxy 'Admin -> IO ()
doSensitiveThings _ = putStrLn "you did something sensitive"
trustedUser :: User
trustedUser = User (Just (Proxy :: Proxy Admin)) "Trust me"
main = do
doSensitiveThings (fromJust . userAdminToken $ trustedUser)
I understand that this makes it impossible to call doSensitiveThings without an administration token. But I feel I'm missing something important.
How is the code above better than the code below?
module Main where
import Data.Maybe
data Admin = Admin
data User a = User String
doSensitiveThings :: User Admin -> IO ()
doSensitiveThings _ = putStrLn "you did something sensitive"
trustedUser :: User Admin
trustedUser = User "Trust me"
untrustedUser :: User ()
untrustedUser = User "Don't trust me"
main = do
doSensitiveThings trustedUser
-- doSensitiveThings untrustedUser -- won't compile

Well, now there's no such thing as "a User". A User Admin and a User () now have different types, so you cannot treat them the same as e.g. elements of a list:
users :: [User] -- ill-kinded!
users = [User "untrusted" :: User (), User "trusted" :: User Admin] -- ill-typed!
You also can no longer branch based on whether a user is an admin or not (remember that Haskell is type-erased!):
displayActions :: User a -> [String]
displayActions (User name) =
["Delete My Account (" ++ name ++ ")"] ++ (if isAdmin u then ["Delete Someone Else's Account"] else [])
isAdmin :: User a -> Bool -- this function can take either User Admin or User ()...
isAdmin = ??? -- ...but how's it supposed to branch on that?
So maybe try
data SomeUser = SomeAdmin (User Admin) | SomeNormalUser (User ())
But now we're basically doing the same thing in your first example (where User Admin becomes the token type instead of Proxy Admin) except it's just worse. There's just a lot code noise.
name :: SomeUser -> String -- having to write your own accessor functions over pattern matching/record fields; ew
name (SomeAdmin (User x)) = x
name (SomeNormalUser (User x)) = x -- ugly pattern matching and same code twice; ew
isAdmin :: SomeUser -> Bool
isAdmin (SomeAdmin _) = True
isAdmin _ = False
displayActions :: SomeUser -> [String] -- having both SomeUser and User instead of just one type and having to know which one to use in any given situation; ew
displayActions u =
["Delete My Account (" ++ name u ++ ")"] ++ (if isAdmin u then ["Delete Someone Else's Account"] else [])
I do see something wrong with the original, and I believe it's what confused you. The "only" "good thing" in the original code is the existence of the token type. Using Proxy with a type parameter to construct the token type instead of doing
data AdminToken = AdminToken
is (IMO) pointless and confusing (both for understanding the technique and also in the resulting code). The type parameter is irrelevant to what makes the idea good, and you gain nothing by keeping the type parameter and not the token. I consider the following to be an actual improvement to the original while keeping its good idea.
data User = { userAdminToken :: Maybe AdminToken; userName :: String }
isAdmin :: User -> Bool
isAdmin = isJust . userAdminToken
displayActions :: User -> [String]
displayActions u
["Delete My Account (" ++ userName u ++ ")"] ++ (if isAdmin u then ["Delete Someone Else's Account"] else [])

With the original code, you can write:
trustedUser = User (Just Proxy) "trusted"
untrustedUser = User Nothing "untrusted"
twoUsers :: [User] -- or Map Username User or whatever
twoUsers = [trustedUser, untrustedUser]
You can't make a similar twoUsers list with the second code snippet, because your trusted and untrusted users have different types.

Related

How to carry a value across function call chains

Let's say I have the following data structure and functions:
data Settings = Settings { dbName :: String } deriving Show
-- username to user id lookup
getUserId :: Settings -> String -> Int
getUserId settings username = 1
-- checks permission for a given user id
hasPermission :: Settings -> Int -> Bool
hasPermission settings userId = True
I'd like to be able to chain getUserId and hasPermission with some syntactic sugar without having to carry instance of Settings as I chain the function calls. Something like this:
main = do
let _permission = Settings{dbName="prod"} >>= getUserId "bob" >> hasPermission
print _permission
This (obviously) does not work.
Any go-to patterns for this this?
The simplest way to address such concerns is, in my opinion, to use partial application, like this:
main = do
let settings = Settings { dbName="prod" }
let getUserId' = getUserId settings
let hasPermission' = hasPermission settings
let _permission = hasPermission' $ getUserId' "bob"
print _permission
If you put the 'common' argument last, however, you can also use the built-in reader monad instance:
main :: IO ()
main = do
let getPermission = (flip getUserId) "bob" >>= (flip hasPermission)
print $ getPermission $ Settings { dbName="prod" }
Here getPermission is a local function with the type Settings -> Bool. Typically, I consider the first option (partial application) to be simpler and easier to understand.
There is a feature called implicit parameters, which has somewhat gone out of style lately, but I believe it is still supported, which offers a nice solution for this.
{-# LANGUAGE ImplicitParams #-}
data Settings = Settings { dbName :: String } deriving Show
getUserId :: (?settings :: Settings) => String -> Int
getUserId username = 1
hasPermission :: (?settings :: Settings) => Int -> Bool
hasPermission userId = True
main = do
let ?settings = Settings { dbName = "prod" }
print $ hasPermission (getUserId "bob")
See also the implicit configurations paper, which explores this problem in quite some depth, and its corresponding library, reflection.

Extract value from Maybe in do block

Hi I have a piece of code where I retrieving a Maybe User where User is my own type.
getUserById :: Int -> IO (Maybe User)
getUserById id = let userId = id in do
conn <- createConnection
(columnDef, inputStream) <- query conn selectByIdQuery [One $ MySQLInt32 (intToInt32 userId)]
maybeMySQLValue <- Streams.read inputStream
return (transformToUser <$> maybeMySQLValue)
But the key is that the function that call this functions expect a IO User and not a IO Maybe User
getUserById :: Int -> IO User
Any advice about how to extract in the do block the value from the Maybe?
I´m trying this but still does not work
user <- extractMaybeUser (transformToUser <$> maybeMySQLValue)
return user
extractMaybeUser :: Maybe User -> User
extractMaybeUser maybeUser = case maybeUser of
Just value -> value
Nothing -> User 1 "default User"
Regards
user <- extractMaybeUser (transformToUser <$> maybeMySQLValue)
The reason why this code might not work is that extractMaybeUser has return type of User:
extractMaybeUser :: Maybe User -> User
There is no monadic value to extract from using <-, so what about just wrapping in IO the user we get from extractMaybeUser?
return (extractMaybeUser (transformToUser <$> maybeMySQLValue))
It will at least have IO User type

Reader Monad - explanation of trivial case

I have been trying to get to grips with the reader monad and came across this tutorial. In it, the author presents this example:
example2 :: String -> String
example2 context = runReader (greet "James" >>= end) context
where
greet :: String -> Reader String String
greet name = do
greeting <- ask
return $ greeting ++ ", " ++ name
end :: String -> Reader String String
end input = do
isHello <- asks (== "Hello")
return $ input ++ if isHello then "!" else "."
I know that this is a trivial example that shows the mechanics, but I am trying to figure out why it would be better than doing something like:
example3 :: String -> String
example3 = end <*> (greet "James")
where
greet name input = input ++ ", " ++ name
end input = if input == "Hello" then (++ "!") else (++ ".")
Reader isn't often used by itself in real code. As you have observed, it's not really better than just passing an extra argument to your functions. However, as part of a monad transformer it is an excellent way to pass configuration parameters through your application. Usually this is done by adding a MonadReader constraint to any function that needs access to configuration.
Here's an attempt at a more real-world example:
data Config = Config
{ databaseConnection :: Connection
, ... other configuration stuff
}
getUser :: (MonadReader Config m, MonadIO m) => UserKey -> m User
getUser x = do
db <- asks databaseConnection
.... fetch user from database using the connection
then your main would look something like:
main :: IO ()
main = do
config <- .... create the configuration
user <- runReaderT (getUser (UserKey 42)) config
print user
dfeuer, chi and user2297560 are right in that "Reader isn't often used by itself in real code". It is worth noting, though, that there is next to no essential difference between what you do in the second snippet in the question and actually using Reader as a monad: the function functor is just Reader without the wrappers, and the Monad and Applicative instances for both of them are equivalent. By the way, outside of highly polymorphic code1, the typical motivation for using the function Applicative is making code more pointfree. In that case, moderation is highly advisable. For instance, as far as my own taste goes, this...
(&&) <$> isFoo <*> isBar
... is fine (and sometimes it might even read nicer than the pointful spelling), while this...
end <*> greet "James"
... is just confusing.
Footnotes
For instance, as Carl points out in a comment, it and the related instances can be useful in...
[...] places where you have code that's polymorphic in a type constructor and your use case is passing an argument in. This can come up when using the polymorphic types offered by lenses, for instance.

How to get a value from the yesod settings.yml file

I'm using the yesod scaffold. I'm struggeling a bit with how to get a value from the settings.yml file,
The relevant part of the settings.yml file looks like this,
Default: &defaults
host: "*4" # any IPv4 host
port: 3000
approot: "http://localhost:3000"
admins: ["someEmail#gmail.com", "someOtherEmail#gmail.com"]
And then in my Foundation.hs file I have a method to check if the users email (using googleauth) matches a pre-specified email,
admins = ["someEmail#gmail.com", "someOtherEmail#gmail.com"]
isAdmin (Just (Entity _ user)) | elem (userIdent user) admins = Authorized
| otherwise = AuthenticationRequired
isAdmin Nothing = AuthenticationRequired
My goal is to replace the admins function with the one from the the settings.yml file because it seems more appropriate.
Any help on doing this would be greatly appreciated!
EDIT:
Okay, I've come as far as fetching the newly made "extra" with the following method,
admins = do
madmins <- extraAdmins getExtra
case madmins of
Nothing -> return Nothing
Just admins -> return admins
But the GHC throws this at me,
Foundation.hs:161:28:
Couldn't match expected type `Extra'
with actual type `Handler Extra'
In the first argument of `extraAdmins', namely `getExtra'
In a stmt of a 'do' block: madmins <- extraAdmins getExtra
In the expression:
do { madmins <- extraAdmins getExtra;
case madmins of {
Nothing -> return Nothing
Just admins -> return admins } }
Is there a way to convert it from Handler Extra to Extra, or am I simply doing it the wrong way?
At the end of the Settings.hs file in the scaffolding, there's the definition of Extra and how to parse it:
data Extra = Extra
{ extraCopyright :: Text
, extraAnalytics :: Maybe Text -- ^ Google Analytics
} deriving Show
parseExtra :: DefaultEnv -> Object -> Parser Extra
parseExtra _ o = Extra
<$> o .: "copyright"
<*> o .:? "analytics"
You can add the extra data you want to this structure and parse it there. From the rest of your app, you can access this value with getExtra (defined in Foundation.hs).
You're a bit confused about the types of getExtra and extraAdmins.
I'm guessing they're like this:
getExtra :: Handler Extra
extraAdmins :: Extra -> [Text] -- maybe?
If so, something like this should work:
isAdmin :: User -> Handler Bool
isAdmin u = do
extra <- getExtra
return $ userIdent u `elem` extraAdmins extra

Is Form Field conversion possible in yesod?

Would it be possible to give checkM the following type instead:
checkM :: RenderMessage master msg =>
(a -> GHandler sub master (Either msg b)) ->
Field sub master a -> Field sub master b
The reason is the following:
I have a form that asks for a user name. Using checkM, I immediately look up in the database whether the entered user exists:
userField = checkM userexists textField
userexists input = do
mbuser <- runDB $ getBy $ UniqueName input
return $ case mbuser of
Nothing -> Left ("This user does not exist!" :: Text)
(Just (Entity uid _)) -> Right input
-- I would like to write "return Right uid" above!
However, I can only return input::Text, so right after the form has accepted the user input, I need to do another database lookup for the same name to get the database key for that user, which is what I really wanted.
(This example is largely simplified. Essentially, I want to get the database keys for a series of different user inputs (all in one form), which I can only ask as TextFields, or not?)
The reason the type signature looks that way is that there are two aspects to a Field: how you parse it, and how you render it. checkM only changes how you parse the field, but the rendering function (fieldView) remains unmodified. Therefore, the value needs to keep the same type.
The simplest way I can think of to get the behavior you want is to have a function which can get a value of the old type from a value of the new type. That way, given a new value, we can just apply that function to it and get the old value for rendering purposes. Here's what the code would look like:
checkM' :: RenderMessage master msg
=> (a -> GHandler sub master (Either msg b))
-> (b -> a)
-> Field sub master a
-> Field sub master b
checkM' f inv field = field
{ fieldParse = \ts -> do
e1 <- fieldParse field ts
case e1 of
Left msg -> return $ Left msg
Right Nothing -> return $ Right Nothing
Right (Just a) -> fmap (either (Left . SomeMessage) (Right . Just)) $ f a
, fieldView = \i n a eres req -> fieldView field i n a (fmap inv eres) req
}
So in your case, you could use it by changing the last line in userexists to:
(Just (Entity uid _)) -> Right (input, uid)
and then defining userField as
userField = checkM' userexists fst textField
I think a function like checkM makes sense to include in yesod-form, but hopefully with a better name ;).

Resources