content: {-# LANGUAGE Safe #-}
  -----------------------------------------------------------------------------
  -- |
  -- Module      : Hasmin.Utils
  -- Copyright   : (c) 2017 Cristian Adrián Ontivero
  -- License     : BSD3
  -- Stability   : experimental
  -- Portability : unknown
  --
  -----------------------------------------------------------------------------
  module Hasmin.Utils
      ( epsilon
      , eps
      , fromLeft'
      , fromRight'
      , mconcatIntersperse
      , restrict
      , textualLength
      , replaceAt
      , mzip
      , reduceTRBL
      ) where
  
  import Data.Monoid ((<>))
  import qualified Data.Text as T
  import Data.List.NonEmpty (NonEmpty((:|)))
  
  import Hasmin.Class
  
  textualLength :: ToText a => a -> Int
  textualLength = T.length . toText
  
  restrict :: Ord a => a -> a -> a -> a
  restrict minv maxv val | val >= maxv = maxv
                         | val < minv  = minv
                         | otherwise   = val
  
  mconcatIntersperse :: Monoid b => (a -> b) -> b -> [a] -> b
  mconcatIntersperse _ _ []            = mempty
  mconcatIntersperse toMonoid y (x:xs) = toMonoid x <> rest
    where rest | null xs   = mempty
               | otherwise = y <> mconcatIntersperse toMonoid y xs
  
  replaceAt :: Int -> a -> [a] -> [a]
  replaceAt index val ls = case splitAt index ls of
                             (xs, _:vs) -> xs ++ (val:vs)
                             (xs, [])   -> xs
  
  fromRight' :: Either a b -> b
  fromRight' (Right x) = x
  fromRight' _         = error "fromRight'"
  
  fromLeft' :: Either a b -> a
  fromLeft' (Left x) = x
  fromLeft' _        = error "fromLeft'"
  
  -- TODO: Find out how precise is enough.
  -- Can we use double and round when printing?
  epsilon :: Rational
  epsilon = 2.2204460492503131e-30 :: Rational
  
  eps :: Rational
  eps = 0.000001 -- See https://bug-30341-attachments.webkit.org/attachment.cgi?id=45276
  
  -- Why does Attoparsec have no instance of MonadZip? :«
  mzip :: Applicative f => f a -> f b -> f (a, b)
  mzip f g = (,) <$> f <*> g
  
  reduceTRBL :: Eq a => NonEmpty a -> NonEmpty a
  reduceTRBL xs =
      case xs of
        t:|[r,b,l] -> reduce4 t r b l
        t:|[r,b]   -> reduce3 t r b
        t:|[r]     -> reduce2 t r
        _          -> xs
    where reduce4 tv rv bv lv
              | lv == rv  = reduce3 tv rv bv
              | otherwise = xs
          reduce3 tv rv bv
              | tv == bv  = reduce2 tv rv
              | otherwise = tv:|[rv, bv]
          reduce2 tv rv
              | tv == rv  = tv:|[]
              | otherwise = tv:|[rv]
  