From 683bbbf4c3935851610969fd565fbe97598d294c Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Mon, 18 Jan 2016 05:56:02 +0000 Subject: Better attribute parsing --- spec/src/Thermoprint/Printout/BBCode/Attribute.hs | 33 +++++++++++++++++++++++ 1 file changed, 33 insertions(+) create mode 100644 spec/src/Thermoprint/Printout/BBCode/Attribute.hs (limited to 'spec/src/Thermoprint/Printout/BBCode') diff --git a/spec/src/Thermoprint/Printout/BBCode/Attribute.hs b/spec/src/Thermoprint/Printout/BBCode/Attribute.hs new file mode 100644 index 0000000..60815c8 --- /dev/null +++ b/spec/src/Thermoprint/Printout/BBCode/Attribute.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE DefaultSignatures #-} + +-- | Parsing attributes +module Thermoprint.Printout.BBCode.Attribute + ( Attribute(..) + , lookupAttr + ) where + +import Data.Text (Text) +import qualified Data.Text as T (unpack) + +import Data.Map (Map) +import qualified Data.Map as Map (lookup) + +import Data.CaseInsensitive (CI) +import qualified Data.CaseInsensitive as CI + +import Text.Read (readMaybe) +import Data.Maybe (fromMaybe) + +-- | We build our own version of 'Read' so we can override the presentation used +-- +-- We provide a default implementation for 'Read a => Attribute a' +class Attribute a where + attrRead :: Text -> Maybe a + default attrRead :: Read a => Text -> Maybe a + attrRead = readMaybe . T.unpack + +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 -- cgit v1.2.3