How do I create, and distinguish, global options using 'optparse-applicative'? - haskell

In my Haskell executable, created using optparse-applicative, I would like to have a global option for --version alongside the global --help option that is available from all subcommands. However the example provided (see below) for adding a --version option to to a CLI with subcommands results in a --version option that is inconsistently available
$ cli create --version
Invalid option `--version'
Usage: cli create NAME
Create a thing
$ cli delete --version
0.0
and never shows up in help for subcommands
$ cli create -h
Usage: cli create NAME
Create a thing
Available options:
NAME Name of the thing to create
-h,--help Show this help text
$ cli delete -h
Usage: cli delete
Delete the thing
Available options:
-h,--help Show this help text
The behavior I would like is for --version to be available globally and to all subcommands:
$ cli create -h
Usage: cli create NAME
Create a thing
Available options:
NAME Name of the thing to create
--version Show version
-h,--help Show this help text
$ cli delete -h
Usage: cli delete
Delete the thing
Available options:
--version Show version
-h,--help Show this help text
$ cli create --version
0.0
$ cli delete --version
0.0
It's not clear from the documentation how to achieve this.
In fact, I'd ideally like to be able to clearly group options in the help output:
$ cli create -h
Usage: cli create NAME
Create a thing
Arguments:
NAME Name of the thing to create
Global options:
--version Show version
-h,--help Show this help text
$ cli delete -h
Usage: cli delete
Delete the thing
Global options:
--version Show version
-h,--help Show this help text
Is there a way to achieve this using optparse-applicative?
{-#LANGUAGE ScopedTypeVariables#-}
import Data.Semigroup ((<>))
import Options.Applicative
data Opts = Opts
{ optGlobalFlag :: !Bool
, optCommand :: !Command
}
data Command
= Create String
| Delete
main :: IO ()
main = do
(opts :: Opts) <- execParser optsParser
case optCommand opts of
Create name -> putStrLn ("Created the thing named " ++ name)
Delete -> putStrLn "Deleted the thing!"
putStrLn ("global flag: " ++ show (optGlobalFlag opts))
where
optsParser :: ParserInfo Opts
optsParser =
info
(helper <*> versionOption <*> programOptions)
(fullDesc <> progDesc "optparse subcommands example" <>
header
"optparse-sub-example - a small example program for optparse-applicative with subcommands")
versionOption :: Parser (a -> a)
versionOption = infoOption "0.0" (long "version" <> help "Show version")
programOptions :: Parser Opts
programOptions =
Opts <$> switch (long "global-flag" <> help "Set a global flag") <*>
hsubparser (createCommand <> deleteCommand)
createCommand :: Mod CommandFields Command
createCommand =
command
"create"
(info createOptions (progDesc "Create a thing"))
createOptions :: Parser Command
createOptions =
Create <$>
strArgument (metavar "NAME" <> help "Name of the thing to create")
deleteCommand :: Mod CommandFields Command
deleteCommand =
command
"delete"
(info (pure Delete) (progDesc "Delete the thing"))

As far as I know, this (in particular, the categorized help text) isn't really easy to do with optparse-applicative, since it isn't quite the pattern that they were planning for with global arguments. If you are okay with using program --global-options command --local-options (which is a fairly standard pattern) instead of program command --global-and-local-options, then you can use the approach shown in the linked example:
$ ./optparse-sub-example
optparse-sub-example - a small example program for optparse-applicative with
subcommands
Usage: optparse [--version] [--global-flag] COMMAND
optparse subcommands example
Available options:
-h,--help Show this help text
--version Show version
--global-flag Set a global flag
Available commands:
create Create a thing
delete Delete the thing
$ ./optparse-sub-example --version create
0.0
$ ./optparse-sub-example --version delete
0.0
$ ./optparse-sub-example --global-flag create HI
Created the thing named HI
global flag: True
$ ./optparse-sub-example --global-flag delete
Deleted the thing!
global flag: True
(Note: I would advise going with this approach, since "global options before the command" is fairly standard).
If you also want the global options to be available in every subcommand, you will have a few issues.
As far as I know, there is no way to affect the help text output in order to group them separately inside the individual command help texts.
You will need some custom subparser-like function that adds your global options & merges them with any global options before the command.
For #2, one way to restructure the example to support this might be something along these lines:
To start with, standard boilerplate and imports:
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ApplicativeDo #-}
import Data.Monoid
import Data.Semigroup ((<>))
import Options.Applicative
import Options.Applicative.Types
Opts are explicitly split into optGlobals and optCommand, making it easy to deal with all of the global options at once if more are available:
data Opts = Opts
{ optGlobals :: !GlobalOpts
, optCommand :: !Command
}
data GlobalOpts = GlobalOpts { optGlobalFlag :: Bool }
GlobalOpts should be a Semigroup and a Monoid, since we need to merge options seen at various different points (before the command, after the command, etc.). It should also be possible, with suitable alterations to mysubparser below, to require global options to be given only after commands and omit this requirement.
instance Semigroup GlobalOpts where
-- Code for merging option parser results from the multiple parsers run
-- at various different places. Note that this may be run with the default
-- values returned by one parser (from a location with no options present)
-- and the true option values from another, so it may be important
-- to distinguish between "the default value" and "no option" (since "no
-- option" shouldn't override another value provided earlier, while
-- "user-supplied value that happens to match the default" probably should).
--
-- In this case this doesn't matter, since the flag being provided anywhere
-- should be enough for it to be considered true.
(GlobalOpts f1) <> (GlobalOpts f2) = GlobalOpts (f1 || f2)
instance Monoid GlobalOpts where
-- Default values for the various options. These should probably match the
-- defaults used in the option declarations.
mempty = GlobalOpts False
As before, a Command type to represent the different possible commands:
data Command
= Create String
| Delete
The real magic: mysubparser wraps hsubparser to add global options and deal with merging them. It takes the parser for global options as an argument:
mysubparser :: forall a b. Monoid a
=> Parser a
-> Mod CommandFields b
-> Parser (a, b)
mysubparser globals cmds = do
To start with, it runs the global parser (to catch any globals given before a command):
g1 <- globals
It then uses hsubparser to get a command parser, and modifies it to also parse global options:
(g2, r) <- addGlobals $ hsubparser cmds
Finally, it merges the two global option sets, and returns the parsed global options and the command parser result:
pure (g1 <> g2, r)
where
The addGlobals helper function:
addGlobals :: forall c. Parser c -> Parser (a, c)
If NilP was given, we just use mempty to get the default option set:
addGlobals (NilP x) = NilP $ (mempty,) <$> x
The important case: if we have an OptP around an Option that uses a CommandReader, the globals parser is added to every command parser:
addGlobals (OptP (Option (CmdReader n cs g) ps)) =
OptP (Option (CmdReader n cs $ fmap go . g) ps)
where go pi = pi { infoParser = (,) <$> globals <*> infoParser pi }
In all other cases, either just use the default option set, or merge option sets from recursive Parsers as appropriate:
addGlobals (OptP o) = OptP ((mempty,) <$> o)
addGlobals (AltP p1 p2) = AltP (addGlobals p1) (addGlobals p2)
addGlobals (MultP p1 p2) =
MultP ((\(g2, f) -> \(g1, x) -> (g1 <> g2, f x)) <$> addGlobals p1)
(addGlobals p2)
addGlobals (BindP p k) = BindP (addGlobals p) $ \(g1, x) ->
BindP (addGlobals $ k x) $ \(g2, x') ->
pure (g1 <> g2, x')
Modifications to the main function are fairly minimal, and mostly related to using the new GlobalOpts. Once a parser for GlobalOpts is available, passing it to mysubparser is quite easy:
main :: IO ()
main = do
(opts :: Opts) <- execParser optsParser
case optCommand opts of
Create name -> putStrLn ("Created the thing named " ++ name)
Delete -> putStrLn "Deleted the thing!"
putStrLn ("global flag: " ++ show (optGlobalFlag (optGlobals opts)))
where
optsParser :: ParserInfo Opts
optsParser =
info
(helper <*> programOptions)
(fullDesc <> progDesc "optparse subcommands example" <>
header
"optparse-sub-example - a small example program for optparse-applicative with subcommands")
versionOption :: Parser (a -> a)
versionOption = infoOption "0.0" (long "version" <> help "Show version")
globalOpts :: Parser GlobalOpts
globalOpts = versionOption <*>
(GlobalOpts <$> switch (long "global-flag" <> help "Set a global flag"))
programOptions :: Parser Opts
programOptions =
uncurry Opts <$> mysubparser globalOpts (createCommand <> deleteCommand)
createCommand :: Mod CommandFields Command
createCommand =
command
"create"
(info createOptions (progDesc "Create a thing"))
createOptions :: Parser Command
createOptions =
Create <$>
strArgument (metavar "NAME" <> help "Name of the thing to create")
deleteCommand :: Mod CommandFields Command
deleteCommand =
command
"delete"
(info (pure Delete) (progDesc "Delete the thing"))
Notice that mysubparser should be a quite generic/reusable component.
This exhibits behavior closer to what you wanted:
$ ./optparse-sub-example create --global-flag HI
Created the thing named HI
global flag: True
$ ./optparse-sub-example --global-flag create HI
Created the thing named HI
global flag: True
$ ./optparse-sub-example --global-flag delete
Deleted the thing!
global flag: True
$ ./optparse-sub-example delete --global-flag
Deleted the thing!
global flag: True
$ ./optparse-sub-example delete
Deleted the thing!
global flag: False
$ ./optparse-sub-example delete --version
0.0
$ ./optparse-sub-example create --version
0.0

Related

How does optparse-applicative bash autocompletion work?

I'm building a brainfuck compiler. The executable accepts two commands $ brainfuck compile ... and $ brainfuck run. I want the executable to auto complete when pressing tab. E.g. writing $ brainfuck com and then pressing tab should generate $ brainfuck compile.
data Command = Compile CompileArgs | Run RunArgs
deriving (Show)
main :: IO ()
main = execute =<< execParser opts
where
opts = info (helper <*> argsParser) fullDesc
execute :: Command -> IO ()
execute (Compile args) = compile args
execute (Run args) = run args
argsParser :: Parser Command
argsParser = subparser (compileCommand <> runCommand)
where
compileCommand = command "compile" $ info compileOptions $ progDesc "Compile brainfuck to an executable"
runCommand = command "run" $ info runOptions $ progDesc "Execute brainfuck code"
There is a section on optparse's github page here, but I don't really understand it.
The function completeWith :: Options.Applicative.Builder.Internal.HasCompleter f => [String] -> Mod f a looks quite similar to command :: String -> ParserInfo a -> Mod CommandFields a which I'm already using. So I figured I could use it and just combine them with <> but it turns out that CommandFields is not an instance of HasCompleter.
How are you supposed to get the auto completion to work?
After RTFM'ing a bit I found out how to configure the auto completion.
completeWith is applied when constructing the parsers for the individual arguments.
Like so:
data CompileArgs = CompileArgs
{
debug :: Bool,
optimizations :: OptimizationLevel,
file :: String
}
deriving (Show, Read)
compileArgsParser :: Parser CompileArgs
compileArgsParser = CompileArgs
<$> switch (
long "debug" <>
help "Outputs object and assembly files")
<*> option auto (
long "optimization-level" <>
value All <>
metavar "LEVEL" <>
help "all | none, default: all" <>
completeWith ["all", "none"])
<*> argument str (
metavar "FILE" <>
help "brainfuck source code" <>
action "file")
<**> helper
action is an instruction to bash on how auto complete. "file" means auto complete with any file or directory. See this page for more info.
In order for these auto completions to kick in you need to generate a script and make sure that script is sourced. By convention it's placed under /etc/bash_completion.d/ when using bash.
brainfuck --bash-completion-script `which brainfuck` | sudo tee /etc/bash_completion.d/brainfuck
in my case where my program is called brainfuck.
I have not tested this, but after reading the documentation, it seems to me that by calling execParser in main, your program automatically supports the required options for command complete. You just need to run your program with --bash-completion-script as documented to generate a shell script, and then load that script to bash.

Using pandoc as a library to make a PDF

Part of a project I am working on involves creating a PDF, using Pandoc. I have the part of the program which makes a PDF. To figure out how to do this, I am trying to modify fuel.hs from JGM BayHack 2014.
However, I am having difficulty. I have the following function:
export :: (MonadIO m) => Pandoc -> m (Either BL.ByteString BL.ByteString)
export = liftIO . makePDF "xelatex" writeLaTeX def { writerStandalone = True }
In the body of my modified fuel.hs,
pdfbytes <- export letter
print pdfbytes
I get the following output:
$ stack runghc fuel.hs
Run from outside a project, using implicit global project config
Using resolver: lts-3.7 from implicit global project's config file: /home/stevejb/.stack/global/stack.yaml
Left "! Emergency stop.\n<*> /tmp/tex2pdf.8283/input.tex\n \nNo pages of output.\nTranscript written on /tmp/tex2pdf.8283/input.log.\n"
"Fail"
However, the log file that is being referenced does not exist. I am not sure how to debug this. I have xelatex installed.
With great help from #haskell IRC, I was able to get it working. The key was to add my own LaTeX template. Thus, one can use the following:
export :: (MonadIO m) => String -> Pandoc -> m (Either BL.ByteString BL.ByteString)
export tmpl pdoc = liftIO $ makePDF "xelatex" writeLaTeX (def { writerStandalone = True, writerTemplate = tmpl}) pdoc
getLetter = do
json <- BL.readFile "cng_fuel_chicago.json"
let letter = case decode json of
Just stations -> createLetter [s | s <- stations,
"Voyager" `elem` cardsAccepted s]
Nothing -> error "Could not decode JSON"
return $ letter
main :: IO ()
main = do
letter <- getLetter
temp <- readFile "template.tex"
let str_should_have_something = writeLaTeX (def {writerStandalone = True, writerTemplate = temp}) letter
print str_should_have_something
mybytes <- export temp letter
case mybytes of Right b -> BL.writeFile "mypdf.pdf" b
Left _ -> putStrLn "Export error"
To get a template, you can use Pandoc in standalone mode from the shell:
pandoc -D latex > template.tex
Also, there may be an issue with Pandoc installed using stack, using cabal, and using the system package manger, in terms of finding the default templates. I am not sure exactly how all of this interacts.
Fully contained gist here.

Automatically reloading variable state into GHCi when re-loading a file

When I'm developing some data analyses pipelines in haskell, it often would be useful to preload variable state into GHCi upon loading.
What I end up doing now is copy and pasting parts of a script line-by-line in emacs just to test and check the output of some intermediate processing. I can't even bulk copy-paste code because the line breaks don't get transferred (at least in emacs Interactive-Haskell mode)
Is there a way to do this?
EDIT: simply loading/reloading a .hs file doesn't do the trick because afaik there's no way to have "<-" bindings at the top level.
I suggest you take a look at foreign-store. It allows you to refer to variables by numbers, which persists through reloads. Here is an example:
λ: :set -XScopedTypeVariables
λ: import Foreign.Store
λ: st <- newStore "example"
Loading package foreign-store-0.2 ... linking ... done.
λ: readStore st
"example"
λ: st
Store 0
λ: :r
Ok, modules loaded: none.
λ: st
<interactive>:8:1:
Not in scope: ‘st’
Perhaps you meant ‘fst’ (imported from Prelude)
λ: Just (st :: Store String) <- lookupStore 0
λ: readStore st
"example"
Alternatively, you can also put all your definitions in a single hs file and only reload that. You can use unsafePerformIO to get around the restriction that you cannot use <- at the top-level. I think that is ok in this case, since your only using it for interactive anyway:
module Example where
import System.IO.Unsafe
example :: String
example = "example"
file :: String
file = unsafePerformIO $ readFile "/tmp/example.hs"
There are two main ways to do this:
Use the :l [filename] GHCi command to reload a file without exiting GHCi.
Write the variables in your ~/.ghci file, which will be loaded when GHCi is opened.
If you don't know what to put into ~/.ghci, here's what I have in mine:
:set prompt "\955 "
:set prompt2 "| "
:def hoogle \x -> return $ ":!hoogle --info \"" ++ x ++ "\""
let f `on` x = \a b -> (f a) `x` (f b)
let break (f,g) = \a -> (f a, f g)

A simple way of parsing a program arguments

I've seen some approaches about parsing program arguments. They seem to be too complicated. I need a simple solution. But I also want to be able (preferably, not necessarily) to refer to the arguments by name. So if a command like looks like this:
./MyApp --arg1Name arg1Value --arg2Name arg2Value
then I'd like to treat them as args["arg1Name"] and args["arg2Name"] to get their values. I know that's not a valid Haskell code, though. What I have now is not much:
main = do
[args] <- getArgs
I repeat, I'd like a simple solution, preferably without involving any third-party haskell libraries.
optparse-applicative is great for argument parsing, and very easy to use! Writing your own argument parser will be much more difficult to get right, change, extend, or otherwise manage than if you take 10 minutes to write a parser with optparse-applicative.
Start by importing the Options.Applicative module.
import Options.Applicative
Next create a data type for your command-line configuration.
data Configuration = Configuration
{ foo :: String
, bar :: Int
}
Now for the workhorse, we create a parser by using the combinators exported from optparse-applicative. Read the documentation on Options.Applicative.Builder for the full experience.
configuration :: Parser Configuration
configuration = Configuration
<$> strOption
( long "foo"
<> metavar "ARG1"
)
<*> option
( long "bar"
<> metavar "ARG2"
)
Now we can execute our Parser Configuration in an IO action to get at our command-line data.
main :: IO ()
main = do
config <- execParser (info configuration fullDesc)
putStrLn (show (bar config) ++ foo config)
And we're done! You can easily extend this parser to support a --help argument to print out usage documentation (make a new parser with helper <*> configuration and pass it to info), you can add default values for certain arguments (include a <> value "default" clause in the arguments to strOption or option), you can support flags, or sub-parsers or generate tab-completion data.
Libraries are a force multiplier! The investment you make in learning the basics of a good library will pay dividends in what you're able to accomplish, and tasks will often be easier (and quicker!) with the proper tool than with a "fast" solution thrown together out of duct tape.
How about just parsing them in pairs and adding them to a map:
simpleArgsMap :: [String] -> Map String String
simpleArgsMap [] = Map.empty
simpleArgsMap (('-':'-':name):value:rest)
= Map.insert name value (simpleArgsMap rest)
simpleArgsMap xs = error $ "Couldn't parse arguments: " ++ show xs
A simple wrapper program to show this working:
module Args where
import System.Environment ( getArgs )
import Control.Applicative ( (<$>) )
import qualified Data.Map as Map
import Data.Map ( Map )
main = do
argsMap <- simpleArgsMap <$> getArgs
print $ Map.lookup "foo" argsMap

How to use MultiPiece

I'm completely new to Yesod (and not very experienced in haskell) and I'm trying to build my first handler. I scraffolded my app using default parameters (I'm using Yesod 0.9.4.1 version and choose postgresql in scraffolding) and now I'm trying to retrieve some data from a table using selectList. I defined a new table (let's call it Foo) in models config file:
Foo
xStart Int
yStart Int
and want to pass a list of FooId's and some other Foo attributes so I defined a route:
/foos/#Int/#Int/*FooId FoosReturnR GET
and a handler:
module Handler.FoosReturn where
import Import
selectWindowSize :: Int
selectWindowSize = 10000
getFoosReturnR :: Int -> Int -> [FooId] -> Handler RepPlain
getFoosReturnR x y withoutIds = do
foos <- runDB $ selectList [FooId /<-. withoutIds,
FooXStart <. x + selectWindowSize,
FooXStart >=. x - selectWindowSize,
FooYStart <. y + selectWindowSize,
FooYStart >=. y - selectWindowSize] []
return $ RepPlain $ toContent $ show foos
I imported the handler in Application.hs and added it to cabal file and now when I'm trying to run it I receive an error saying that FooId is not an instance of MultiPiece - but when I try to make it an instance there is an error saying that FooId is a type synonym and cannot be an instance of MultiPiece - how to resolve this problem?
EDIT:
Daniel: well, actually I don't know what exactly is FooId - it's a part of Yesod's magic which I don't fully understand so far - it's generated automatically from the table definition - but it's a some kind of a number.
Because I don't know how to use MultiPiece I switched to simpler solution and modified:
route: /foos/#Int/#Int/#String FoosReturnR GET
handler: [added also some logging]
module Handler.FoosReturn where
import Import
import Data.List.Split
import qualified Data.Text.Lazy as TL
selectWindowSize :: Int
selectWindowSize = 10000
getFoosReturnR :: Int -> Int -> String -> Handler RepPlain
getFoosReturnR x y withoutIds = do
app <- getYesod
liftIO $ logLazyText (getLogger app) ("getFoosReturnR('" `TL.append` (TL.pack $ (show x) ++ "', '" ++ (show y) ++ "', '" ++ withoutIds ++ "') "))
foos <- runDB $ selectList [FooId /<-. (map (\a -> read a :: FooId) $ splitOn "," withoutIds),
FooXStart <. x + selectWindowSize,
FooXStart >=. x - selectWindowSize,
FooYStart <. y + selectWindowSize,
FooYStart >=. y - selectWindowSize] []
return $ RepPlain $ toContent $ show foos
and now it is compiling but when I browse to: http://localhost:3000/sectors/1/1/1,2 I get a page containing only:
Internal Server Error
Prelude.read: no parse
Well, I don't fully understand what is FooId here - how to create such a list of FooId's from list of strings containing numbers?
And of course a solution of how to make the FooId an instance of MultiPiece is most wanted.
EDIT:
Daniel and svachalek, thanks for your posts - I tried your (Daniel's) solution but then I was receiving errors saying that [FooId] is expected (as in the handler function declaration) but FooId type was given and this lead me to the following solution:
data FooIds = FooIds [FooId] deriving (Show, Read, Eq)
instance MultiPiece FooIds where
toMultiPiece (FooIds fooList) = map (Data.Text.pack . show) fooList
fromMultiPiece texts =
if length (filter isNothing listOfMaybeFooId) > 0
then Nothing
else Just $ FooIds $ map fromJust listOfMaybeFooId
where
listOfMaybeFooId = map constructMaybeFooId texts
constructMaybeFooId :: Text -> Maybe FooId
constructMaybeFooId x = case reads (Data.Text.unpack x) :: [(FooId,String)] of
[(foo,_)] -> Just foo
_ -> Nothing
of course I changed the route to: /foos/#Int/#Int/*FooIds FoosReturnR GET
and the handler to:
getFoosReturnR :: Int -> Int -> FooIds -> Handler RepPlain
getFoosReturnR coordX coordY (FooIds withoutIds) = do
and now I don't get any errors during compilation nor runtime, and the only not satisfying thing is that I always receive Not Found as a result, even if I supply parameters that should give me some results - so now I have to figure out how to determine what SQL was exactly sent to the database
EDIT:
Now I see that the "Not Found" is connected to the problem and that the above edit is not a solution - when I browse to localhost:3000/foos/4930000/3360000 then I get the results (but then the FooIds is empty) - but when I add something like: localhost:3000/sectors/4930000/3360000/1 then I always get "Not Found" - so it's still not working..
Wish I could help, but yesod has something to do with web applications, as far as I know, hence I've never really looked at it. So I can just try a stab in the air, maybe I hit something.
Hayoo leads to
class MultiPiece s where
fromMultiPiece :: [Text] -> Maybe s
toMultiPiece :: s -> [Text]
in Yesod.Dispatch. Since FooId seems to have a Read instance and probably a Show instance, you could try
{-# LANGUAGE TypeSynonymInstances #-}
-- maybe also FlexibleInstances
instance MultiPiece FooId where
toMultiPiece foo = [Text.pack $ show foo]
fromMultiPiece texts =
case reads (unpack $ Text.concat texts) :: [(FooId,String)] of
[(foo,_)] -> Just foo
_ -> Nothing
I have no idea whether that is close to the right thing, and I would have posted it as a comment, but it's too long and there's not much formatting in comments. If it doesn't help I will delete it to not give the impression your question already has an answer when it hasn't.
The problem is solved:)
You could either use my implementation from one of the last edits of the question and browse to URL like: http://localhost:3000/foos/4930000/3360000/Key {unKey = PersistInt64 3}/Key {unKey = PersistInt64 4}
The Key type derives Read but not in a very friendly (and expected) way:)
Or change the implementation of fromMultiPiece to:
instance MultiPiece FooIds where
toMultiPiece (FooIds fooList) = map (Data.Text.pack . show) fooList
fromMultiPiece texts =
if length (filter isNothing listOfMaybeFooId) > 0
then Nothing
else Just $ FooIds $ map fromJust listOfMaybeFooId
where
listOfMaybeFooId = map constructMaybeFooId texts
constructMaybeFooId :: Text -> Maybe FooId
constructMaybeFooId x = case TR.decimal x of
Left err -> Nothing
Right (el,_) -> Just $ Key (PersistInt64 el)
and use URLs like: http://localhost:3000/foos/4930000/3360000/1/2
Many thanks to David McBride from the Yesod Web Framework Google Group
EDIT: the above solution had only one disadvantage - using the PersistInt64 type - it's not a good practice to use such a details of implementation, but it can be repaired by using fromPersistValue and toPersistValue functions from Database.Persist as follows:
instance MultiPiece FooIds where
toMultiPiece (FooIds fooList) = map (persistValuetoText . unKey) fooList
where
persistValuetoText x = case fromPersistValue x of
Left _ -> Data.Text.pack ""
Right val -> Data.Text.pack $ show (val::Int)
fromMultiPiece texts =
if length (filter isNothing listOfMaybeFooId) > 0
then Nothing
else Just $ FooIds $ map fromJust listOfMaybeFooId
where
listOfMaybeFooId = map constructMaybeFooId texts
constructMaybeFooId :: Text -> Maybe FooId
constructMaybeFooId x = case TR.decimal x of
Left _ -> Nothing
Right (el,_) -> Just $ Key (toPersistValue (el :: Int))
Again, big thanks to David McBride also for this!
I'm also fairly new to Yesod and I gave in and added -XTypeSynonymInstances to the ghc-options in my .cabal file, and so far it's made life a lot easier for me. I'm not sure if it's the most elegant answer to this particular problem, but otherwise I predict you'll run into that instance-of-alias error pretty frequently. P.S. try id = (Key (PersistInt 64 n))

Resources