module WeekDaze.Model.TimetableAxisTriple(
Axes(
deconstruct
),
tag,
permutations,
fromList,
toList,
invertSense,
generatePermutationsOf,
mkAxes,
hasWildSense
) where
import qualified Control.Arrow
import qualified Control.DeepSeq
import qualified Data.List
import qualified Text.XML.HXT.Arrow.Pickle as HXT
import qualified ToolShed.SelfValidate
import qualified WeekDaze.Model.TimetableAxis as Model.TimetableAxis
import qualified WeekDaze.Model.TimetableAxisTraversal as Model.TimetableAxisTraversal
tag :: String
tag = "traversalOrder"
type Triple = (Model.TimetableAxisTraversal.AxisTraversal, Model.TimetableAxisTraversal.AxisTraversal, Model.TimetableAxisTraversal.AxisTraversal)
newtype Axes = MkAxes {
deconstruct :: Triple
} deriving Eq
instance Read Axes where
readsPrec _ = map (Control.Arrow.first mkAxes) . reads
instance Show Axes where
showsPrec _ (MkAxes triple) = shows triple
instance ToolShed.SelfValidate.SelfValidator Axes where
getErrors axes = ToolShed.SelfValidate.extractErrors [(not $ areOrthogonal axes, "axes must be orthogonal; " ++ show axes)]
instance HXT.XmlPickler Axes where
xpickle = HXT.xpElem tag $ HXT.xpWrap (
mkAxes,
deconstruct
) $ HXT.xpTriple (
HXT.xpElem "x" HXT.xpickle
) (
HXT.xpElem "y" HXT.xpickle
) (
HXT.xpElem "z" HXT.xpickle
)
instance Control.DeepSeq.NFData Axes where
rnf = Control.DeepSeq.rnf . deconstruct
mkAxes :: Triple -> Axes
mkAxes triple
| ToolShed.SelfValidate.isValid axes = axes
| otherwise = error $ "WeekDaze.Model.TimetableAxisTriple.mkAxes:\t" ++ ToolShed.SelfValidate.getFirstError axes ++ "."
where
axes = MkAxes triple
areOrthogonal :: Axes -> Bool
areOrthogonal = (== 3) . length . Data.List.nub . map Model.TimetableAxisTraversal.getAxis . toList
invertSense :: Axes -> Axes
invertSense = fromList . map Model.TimetableAxisTraversal.invertSense . toList
fromList :: [Model.TimetableAxisTraversal.AxisTraversal] -> Axes
fromList [x, y, z] = mkAxes (x, y, z)
fromList axisTraversals = error $ "WeekDaze.Model.TimetableAxisTriple.mkAxes:\tprecisely three axes-traversals are required " ++ show axisTraversals ++ "."
toList :: Axes -> [Model.TimetableAxisTraversal.AxisTraversal]
toList (MkAxes (x, y, z)) = [x, y, z]
permutations :: [Axes]
permutations = [
mkAxes (
Model.TimetableAxisTraversal.MkAxisTraversal (Just xSense) xAxis,
Model.TimetableAxisTraversal.MkAxisTraversal (Just ySense) yAxis,
Model.TimetableAxisTraversal.MkAxisTraversal (Just zSense) $ Model.TimetableAxis.getPerpendicular xAxis yAxis
) |
xSense <- [minBound .. maxBound],
xAxis <- Model.TimetableAxis.range,
ySense <- [minBound .. maxBound],
yAxis <- Model.TimetableAxis.getOthers xAxis,
zSense <- [minBound .. maxBound]
]
generatePermutationsOf :: Axes -> [Axes]
generatePermutationsOf axes@(MkAxes (x, y, z))
| not $ hasWildSense axes = [axes]
| otherwise = [
mkAxes (
Model.TimetableAxisTraversal.MkAxisTraversal (Just xSense) $ Model.TimetableAxisTraversal.getAxis x,
Model.TimetableAxisTraversal.MkAxisTraversal (Just ySense) $ Model.TimetableAxisTraversal.getAxis y,
Model.TimetableAxisTraversal.MkAxisTraversal (Just zSense) $ Model.TimetableAxisTraversal.getAxis z
) |
xSense <- Model.TimetableAxisTraversal.maybeSenseToList $ Model.TimetableAxisTraversal.getMaybeSense x,
ySense <- Model.TimetableAxisTraversal.maybeSenseToList $ Model.TimetableAxisTraversal.getMaybeSense y,
zSense <- Model.TimetableAxisTraversal.maybeSenseToList $ Model.TimetableAxisTraversal.getMaybeSense z
]
hasWildSense :: Axes -> Bool
hasWildSense = any Model.TimetableAxisTraversal.hasWildSense . toList