ListTemplates.hs

{-# 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]
-}