{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Data.Rg
  ( Rg(..)
  , RgText(..)
  , BE(..)
  , Range
  , newStartOfRangeFromList
  , newStartOfRangeFromVector
  , extractRange
  ) where

import           Data.Array
import qualified Data.HashMap.Strict  as HM
import           Data.Maybe
import           Data.Possibly
import qualified Data.Text            as T
import qualified Data.Vector          as V
import           Fmt


-- | Rg acts a bit like a Bounded Enum, but the size of the enumeration
-- can be dynamically determined from each value in the type (see 'sizeRg')
class Rg rg where
  -- | the number of values in the enumeration; sizeRg sz > 0
  sizeRg      :: rg -> Int

  -- | the nth item in the enumeration (first is 0)
  toRg        :: rg -> Int -> Maybe rg

  -- | place in the enumation (first is 0)
  fromRg      :: rg -> Int

  -- | first item in the enumeration
  minRg       :: rg -> rg
  minRg    = fromMaybe oops . flip toRg 0
    where
      oops = error "minRg: no minimum value in range"

  -- | last item in the enumeration
  maxRg       :: rg -> rg
  maxRg rg = fromMaybe oops $ toRg rg n
    where
      n    = sizeRg rg - 1
      oops = error "maxRg: no maximum value in range"

  -- | next item in the enumeration (Nothing if already last)
  succRg      :: rg -> Maybe rg
  succRg rg = toRg rg $ fromRg rg + 1

  -- | previous item in the enumeration (Nothing if already first)
  predRg      :: rg -> Maybe rg
  predRg rg = toRg rg $ fromRg rg - 1

  -- | list given items in the enumeration
  allListRg   :: rg -> [rg]
  allListRg rg = listRg rg [0..]

  -- | list given items in the enumeration, stopping as soon as an index is
  -- out of range
  listRg      :: rg -> [Int] -> [rg]
  listRg rg is = catMaybes $ takeWhile isJust [ toRg rg i | i<-is ]

  -- | list given items in the enumeration as a 'V.Vector'
  allVectorRg :: rg -> [rg]
  allVectorRg rg = listRg rg [0..]

  -- | list the items in the enumeration as a 'V.Vector', stopping as soon as an
  -- index is out of range
  vectorRg    :: rg -> [Int] -> V.Vector rg
  vectorRg rg is = V.fromList $ listRg rg is


-------------------------------------------------------------------------------
-- class RgText
-------------------------------------------------------------------------------

-- | a class in which we can build things and parse them from 'T.Text'
class (Rg e, Buildable e, Eq e, Ord e, Show e) => RgText e where
  parseRgText :: e -> T.Text -> Possibly e
  parseRgText e txt = maybe (Left msg) Right $ HM.lookup txt $ hashmap_t e
    where
      msg = "parseRgText: enumeration not recognised: "++show txt


-------------------------------------------------------------------------------
-- newtype BE
-------------------------------------------------------------------------------

-- | a @newtype@ wrapper used for deriving 'Rg' instances from 'Bounded' 'Enum'
newtype BE a = BE { _BE :: a }
  deriving  (Eq,Ord,Bounded,Enum,Show)

instance (Bounded i,Enum i) => Rg (BE i) where
  sizeRg be = (1 +) $ fromEnum $ maxBound `asTypeOf` _BE be

  toRg be i = case 0 <= i && i < sizeRg be of
    True  -> Just $ BE $ toEnum i
    False -> Nothing

  fromRg = fromEnum . _BE


-------------------------------------------------------------------------------
-- data Range
-------------------------------------------------------------------------------

-- | used to generate 'Rg' values from lists of things
data Range a =
  Range
    { _rg_size  :: Int          -- ^ number of items in enumeration (derivable from Array)
    , _rg_elem  :: Int          -- ^ position in the enumeration of this element
    , _rg_array :: Array Int a  -- ^ all of the elements of the enumeration
    }
  deriving (Show)

instance Rg (Range a) where
  sizeRg      = _rg_size
  toRg   rg i = case 0 <= i && i < _rg_size rg of
    False -> Nothing
    True  -> Just rg { _rg_elem = i }
  fromRg      = _rg_elem

-- | generating a 'Range' from a list
newStartOfRangeFromList :: [a] -> Range a
newStartOfRangeFromList xs =
  Range
    { _rg_size  = sz
    , _rg_elem  = 0
    , _rg_array = listArray (0,sz-1) xs
    }
  where
    sz = length xs

-- | generating a 'Range' from a 'V.Vector'
newStartOfRangeFromVector :: V.Vector a -> Range a
newStartOfRangeFromVector v =
  Range
    { _rg_size  = sz
    , _rg_elem  = 0
    , _rg_array = listArray (0,sz-1) $ V.toList v
    }
  where
    sz = V.length v

-- | extracting the thing
extractRange :: Range a -> a
extractRange Range{..} = _rg_array ! _rg_elem


-------------------------------------------------------------------------------
-- hashmap_t
-------------------------------------------------------------------------------

-- | 'T.Text' 'HM.HashMap' based on 'renderEnumText' representation
hashmap_t :: RgText e => e -> HM.HashMap T.Text e
hashmap_t x = HM.fromList
    [ (fmt $ build c,c)
      | c <- allListRg x
      ]