Skip to content

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
MatchOpt is applicative!
{-# LANGUAGE TypeOperators, RankNTypes, DeriveFunctor #-}
-- Response to chapter 9 of http://paolocapriotti.com/assets/applicative.pdf
import Control.Applicative
import Control.Monad (guard)
import Data.Functor.HFree
import Data.Functor.Product
import Data.Monoid (Any(..))
import Data.Maybe (listToMaybe)
----- Code different from the paper -----
type FreeA = HFree Applicative
one :: Option a -> FreeA Option a
one = liftFree
raise :: Applicative g => (f :~> g) -> FreeA f :~> g
raise = rightAdjunct
matchOpt :: String -> String -> FreeA Option a -> Maybe (FreeA Option a)
matchOpt opt value = any2Maybe . raise findMatch
where
any2Maybe (Pair (Const (Any b)) fa) = guard b >> Just fa
findMatch g = case ('-':'-':optName g == opt, optReader g value) of
(True, Just b) -> Pair (Const (Any True)) (pure b)
_ -> Pair (Const (Any False)) (one g)
----- Code from the paper -----
data User = User
{ username :: String
, fullname :: String
, id :: Int
} deriving Show
data Option a = Option
{ optName :: String
, optDefault :: Maybe a
, optReader :: String -> Maybe a
} deriving Functor
userP :: FreeA Option User
userP = User
<$> one (Option "username" Nothing Just)
<*> one (Option "fullname" (Just "") Just)
<*> one (Option "id" Nothing maybeRead)
maybeRead :: Read a => String -> Maybe a
maybeRead = fmap fst . listToMaybe . filter (null . snd) . reads
parserDefault :: FreeA Option a -> Maybe a
parserDefault = raise optDefault
runParser :: FreeA Option a -> [String] -> Maybe a
runParser p (opt : value : args) = do
p' <- matchOpt opt value p
runParser p' args
runParser p [] = parserDefault p
runParser _ _ = Nothing
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.