{-# LANGUAGE GeneralizedNewtypeDeriving, TypeSynonymInstances #-} module Hranker.State ( AnnotatedItem(..) , idS , InputState , MyState(..) , OutputState , validRank ) where import Hranker.Rank (highestRank, Rank, rankToIndex) import Data.List.NonEmpty (length', NonEmpty(..), nonEmptyToList) -- | A possibly-annotated item to be ranked. Empty annotations are treated as no annotation. data (Show a, Eq a, Ord a) => AnnotatedItem a = AnnotatedItem { item :: a , annotation :: String } deriving (Eq, Ord) instance (Show a, Eq a, Ord a) => Show (AnnotatedItem a) where show (AnnotatedItem { annotation = "", item = i}) = show i show (AnnotatedItem { annotation = a , item = i}) = show i ++ " (" ++ a ++ ")" -- | Program state data (Show a, Eq a, Ord a) => MyState c a = MyState { ranked :: [[AnnotatedItem a]] , unranked :: c (AnnotatedItem a) } -- | Input state of a command type InputState = MyState NonEmpty -- | Output state of a command type OutputState = MyState [] -- | Turn an InputState into an OutputState idS :: (Show a, Eq a, Ord a) => InputState a -> OutputState a idS s = s { unranked = nonEmptyToList $ unranked s } instance (Show a, Eq a, Ord a) => Show (InputState a) where show s = unlines $ "Rank:\tItem(s):" : zipWith showRank [highestRank..] (ranked s) ++ [ "" , show (length' $ unranked s) ++ " unranked items, starting with: " ++ show (neHead $ unranked s) ] -- | (Show a, Eq a, Ord a) particular rank, given the rank number and the AnnotatedItems at that rank showRank :: (Show a, Eq a, Ord a) => Rank -> [AnnotatedItem a] -> String showRank rank ais = show rank ++ '\t' : show ais -- | Is the given rank currently listed? validRank :: (Show a, Eq a, Ord a) => MyState c a -> Rank -> Bool validRank s r = rankToIndex r < length (ranked s) && r >= highestRank