Skip to content

Instantly share code, notes, and snippets.

@deemp
Last active July 27, 2022 03:44
Show Gist options
  • Save deemp/f3b24c371bb6736e0a1288943c846736 to your computer and use it in GitHub Desktop.
Save deemp/f3b24c371bb6736e0a1288943c846736 to your computer and use it in GitHub Desktop.
{-# LANGUAGE DeriveDataTypeable #-}
module ListTemplate where
import Data.Data
import Data.HashMap.Strict
import Prelude hiding (lookup)
data A = A deriving (Data, Typeable, Show)
data C = C deriving (Data, Typeable, Show)
data T = P A | Q C deriving (Data, Typeable, Show)
template :: String
template = "P _"
defaults :: [T]
defaults = [P A, Q C]
defaultsMap :: HashMap String T
defaultsMap = fromList $ (\k -> (show $ toConstr k, k)) <$> defaults
safeHead :: [a] -> Maybe a
safeHead [] = Nothing
safeHead xs = Just $ head xs
data Problem = EmptyTemplate | NoSuchTemplate deriving Show
getMatch :: String -> Either Problem T
getMatch s = res
where
l = lookup <$> (safeHead . words) s <*> Just defaultsMap
res =
case l of
Just (Just p) -> Right p
Just _ -> Left NoSuchTemplate
Nothing -> Left EmptyTemplate
{-
>>>getMatch <$> ["P _", "Q _", "R",""]
[Right (P A),Right (Q C),Left NoSuchTemplate,Left EmptyTemplate]
-}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment