module WeekDaze.Model.TimetableAxisTraversal(
Sense,
AxisTraversal(..),
senseTag,
maybeSenseToList,
invertSense,
hasWildSense
) where
import Control.Arrow((&&&))
import qualified Control.Arrow
import qualified Control.DeepSeq
import qualified Data.Char
import qualified Data.Maybe
import qualified Text.XML.HXT.Arrow.Pickle as HXT
import qualified WeekDaze.Model.TimetableAxis as Model.TimetableAxis
import WeekDaze.Enhanced.EnhancedBool()
tag :: String
tag = "timetableAxisTraversal"
senseTag :: String
senseTag = "sense"
type Sense = Bool
data AxisTraversal = MkAxisTraversal {
getMaybeSense :: Maybe Sense,
getAxis :: Model.TimetableAxis.Axis
} deriving Eq
instance Read AxisTraversal where
readsPrec _ [] = []
readsPrec _ s@(c : remainder)
| Data.Char.isSpace c = reads remainder
| otherwise = case c of
'+' -> Control.Arrow.first (MkAxisTraversal $ Just True) `map` reads remainder
'-' -> Control.Arrow.first (MkAxisTraversal $ Just False) `map` reads remainder
_ -> Control.Arrow.first (MkAxisTraversal Nothing) `map` reads s
instance Show AxisTraversal where
showsPrec _ axisTraversal = showString (
Data.Maybe.maybe "" (\sense -> if sense then "+" else "-") $ getMaybeSense axisTraversal
) . shows (getAxis axisTraversal)
instance HXT.XmlPickler AxisTraversal where
xpickle = HXT.xpElem tag . HXT.xpWrap (
uncurry MkAxisTraversal,
getMaybeSense &&& getAxis
) $ HXT.xpAttrImplied senseTag HXT.xpickle `HXT.xpPair` HXT.xpickle
instance Control.DeepSeq.NFData AxisTraversal where
rnf = Control.DeepSeq.rnf . (getMaybeSense &&& getAxis)
maybeSenseToList :: Maybe Sense -> [Sense]
maybeSenseToList = Data.Maybe.maybe [minBound .. maxBound] return
invertSense :: AxisTraversal -> AxisTraversal
invertSense (MkAxisTraversal (Just sense) axis) = MkAxisTraversal (Just $ not sense) axis
invertSense x@(MkAxisTraversal Nothing _) = x
hasWildSense :: AxisTraversal -> Bool
hasWildSense = Data.Maybe.isNothing . getMaybeSense