hranker-0.1.1: Hranker/State.hs

{-# 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