From f0ad3abb87d540c75a397a722ca5310d6d16cec9 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Mon, 18 Jan 2016 11:36:09 +0000 Subject: Made attributes more lenient yet --- spec/src/Thermoprint/Printout/BBCode/Attribute.hs | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) (limited to 'spec/src/Thermoprint/Printout/BBCode/Attribute.hs') diff --git a/spec/src/Thermoprint/Printout/BBCode/Attribute.hs b/spec/src/Thermoprint/Printout/BBCode/Attribute.hs index 60815c8..538cca2 100644 --- a/spec/src/Thermoprint/Printout/BBCode/Attribute.hs +++ b/spec/src/Thermoprint/Printout/BBCode/Attribute.hs @@ -7,7 +7,7 @@ module Thermoprint.Printout.BBCode.Attribute ) where import Data.Text (Text) -import qualified Data.Text as T (unpack) +import qualified Data.Text as T (unpack, empty) import Data.Map (Map) import qualified Data.Map as Map (lookup) @@ -18,6 +18,8 @@ import qualified Data.CaseInsensitive as CI import Text.Read (readMaybe) import Data.Maybe (fromMaybe) +import Control.Applicative (Alternative(..)) + -- | We build our own version of 'Read' so we can override the presentation used -- -- We provide a default implementation for 'Read a => Attribute a' @@ -28,6 +30,10 @@ class Attribute a where instance Attribute Integer -lookupAttr :: Attribute a => CI Text -> a -> Map (CI Text) Text -> a --- ^ Extract an attribute by name -lookupAttr t def attrs = fromMaybe def $ Map.lookup t attrs >>= attrRead +lookupAttr :: Attribute a => CI Text -> Bool -> a -> Map (CI Text) Text -> a +-- ^ Extract an attribute by name -- the 'Bool' attribute specifies whether we additionally accept the empty string as key +lookupAttr t emptyOk def attrs = fromMaybe def $ (emptyOk' $ Map.lookup t attrs) >>= attrRead + where + emptyOk' + | emptyOk = (<|> Map.lookup (CI.mk T.empty) attrs) + | otherwise = id -- cgit v1.2.3