public
Last active

MatchOpt is applicative!

  • Download Gist
matchOpt.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64
{-# 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

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.