content: {-# LANGUAGE AllowAmbiguousTypes       #-}
  {-# LANGUAGE DataKinds                 #-}
  {-# LANGUAGE DerivingStrategies        #-}
  {-# LANGUAGE ExistentialQuantification #-}
  {-# LANGUAGE FlexibleContexts          #-}
  {-# LANGUAGE MagicHash                 #-}
  {-# LANGUAGE TypeInType                #-}
  {-# LANGUAGE UndecidableInstances      #-}
  
  {- |
  Copyright: (c) 2018-2020 Kowainik
  SPDX-License-Identifier: MPL-2.0
  Maintainer: Kowainik <xrom.xkov@gmail.com>
  
  This module contains 'Memory' data type and various utility functions:
  
  1. Create values of type 'Memory'.
  2. Unwrap values of type 'Memory' to integral types.
  3. Pretty-displaying functions.
  4. Parsing.
  5. Numeric functions.
  -}
  
  module Membrain.Memory
         ( -- * Data type
           Memory (..)
         , memory
         , toMemory
         , showMemory
         , readMemory
  
           -- * Conversion functions
         , toBits
         , toRat
         , floor
  
           -- * Numeric operations
         , memoryMul
         , memoryDiff
         , memoryPlus
         , memoryDiv
  
           -- * Any memory data type
           -- $any
         , AnyMemory (..)
         ) where
  
  import Prelude hiding (floor)
  
  import Data.Char (isDigit, isSpace)
  import Data.Coerce (coerce)
  import Data.Foldable (foldl')
  import Data.Kind (Type)
  import Data.List.NonEmpty (NonEmpty)
  import Data.Ratio (Ratio, (%))
  import Data.Semigroup (Semigroup (..))
  import GHC.Exts (Proxy#, proxy#)
  import GHC.Generics (Generic)
  import GHC.TypeNats (KnownNat, Nat, natVal')
  import Numeric.Natural (Natural)
  
  import Membrain.Units (KnownUnitSymbol, unitSymbol)
  
  import qualified Prelude
  
  
  {- $setup
  >>> import Membrain
  -}
  
  {- | Main memory units type. It has phantom type parameter @mem@ of kind 'Nat'
  which is type level representation of the unit. Stores internally memory as
  bits. To construct values of type 'Memory', use functions from the
  "Membrain.Constructors" module.
  -}
  newtype Memory (mem :: Nat) = Memory
      { unMemory :: Natural
      } deriving stock   (Show, Read, Generic)
        deriving newtype (Eq, Ord)
  
  {- | Semigroup over addition.
  
  >>> byte 2 <> byte 5
  Memory {unMemory = 56}
  -}
  instance Semigroup (Memory (mem :: Nat)) where
      (<>) :: Memory mem -> Memory mem -> Memory mem
      (<>) = coerce ((+) @Natural)
      {-# INLINE (<>) #-}
  
      sconcat :: NonEmpty (Memory mem) -> Memory mem
      sconcat = foldl' (<>) mempty
      {-# INLINE sconcat #-}
  
      stimes :: Integral b => b -> Memory mem -> Memory mem
      stimes n (Memory m) = Memory (fromIntegral n * m)
      {-# INLINE stimes #-}
  
  instance Monoid (Memory (mem :: Nat)) where
      mempty :: Memory mem
      mempty = Memory 0
      {-# INLINE mempty #-}
  
      mappend :: Memory mem -> Memory mem -> Memory mem
      mappend = (<>)
      {-# INLINE mappend #-}
  
      mconcat :: [Memory mem] -> Memory mem
      mconcat = foldl' (<>) mempty
      {-# INLINE mconcat #-}
  
  {- |
  This 'showMemory' function shows a 'Memory' value as 'Double' along with the
  measure unit suffix. It shows 'Memory' losslessly while used with standardized
  units of measurements. The following mathematical law is used to display
  'Memory':
  
  A decimal representation written with a repeating final @0@ is supposed to
  terminate before these zeros. Instead of @1.585000...@ one simply writes
  @1.585@. The decimal is also called a terminating decimal. Terminating decimals
  represent rational numbers of the form \( \cfrac{k}{2^n 5^m} \). If you use
  different forms of units then the 'show' function for 'Memory' hangs.
  
  >>> showMemory (Memory 22 :: Memory Byte)
  "2.75B"
  -}
  showMemory :: forall mem . (KnownNat mem, KnownUnitSymbol mem) => Memory mem -> String
  showMemory (Memory m) = showFrac m (nat @mem) ++ unitSymbol @mem
    where
      showFrac :: Natural -> Natural -> String
      showFrac number d = goIntegral number
        where
          -- take integral part of fraction
          goIntegral :: Natural -> String
          goIntegral n =
              let (q, r) = n `divMod` d
                  integral = show q
              in if r == 0
                 then integral
                 else integral ++ '.' : goFractional r
  
          -- convert reminder to fractional part
          goFractional :: Natural -> String
          goFractional 0 = ""
          goFractional n =
              let (q, r) = (n * 10) `divMod` d
              in show q ++ goFractional r
  
  
  {- | Inverse of 'showMemory'.
  
  >>> readMemory @Byte "2.75B"
  Just (Memory {unMemory = 22})
  >>> readMemory @Bit "2.75B"
  Nothing
  -}
  readMemory
      :: forall (mem :: Nat)
       . (KnownUnitSymbol mem, KnownNat mem)
      => String
      -> Maybe (Memory mem)
  readMemory (dropWhile isSpace -> str) = case span isDigit str of
      ([], _) -> Nothing
      (_, []) -> Nothing
      (ds, '.': rest) -> case span isDigit rest of
          ([], _)           -> Nothing
          (numerator, unit) -> makeMemory ds numerator unit
      (ds, unit) -> makeMemory ds "0" unit
    where
      makeMemory :: String -> String -> String -> Maybe (Memory mem)
      makeMemory (read @Natural -> whole) numStr u =
          if unitSymbol @mem == u
          then case ((whole * numPow + num) * unit) `divMod` numPow of
              (b, 0) -> Just $ Memory b
              _      -> Nothing
          else Nothing
        where
            unit :: Natural
            unit = nat @mem
  
            num :: Natural
            num = read @Natural numStr
  
            numPow :: Natural
            numPow = 10 ^ length numStr
  
  {- | Creates 'Memory' of unit @mem@ by the given 'Natural' number. 'Memory's
  smart constructor.
  
  >>> memory @Byte 3
  Memory {unMemory = 24}
  -}
  memory :: forall (mem :: Nat) . KnownNat mem => Natural -> Memory mem
  memory = Memory . (* nat @mem)
  {-# INLINE memory #-}
  
  {- | Convert memory from one unit to another.
  
  __Note:__ this changes only view, not model.
  So this operation has zero runtime cost.
  
  >>> showMemory $ toMemory @Kilobyte $ byte 100
  "0.1kB"
  >>> showMemory $ toMemory @Kibibyte $ byte 100
  "0.09765625KiB"
  -}
  toMemory :: forall (to :: Nat) (from :: Nat) . Memory from -> Memory to
  toMemory = coerce
  {-# INLINE toMemory #-}
  
  {- | Lossless 'Memory' conversion to bits. Alias to 'unMemory'.
  
  >>> toBits $ byte 1
  8
  >>> toBits $ kilobyte 1
  8000
  -}
  toBits :: Memory mem -> Natural
  toBits = coerce
  {-# INLINE toBits #-}
  
  {- | Lossless 'Memory' conversion to rational number.
  
  >>> toRat $ byte 4
  4 % 1
  >>> toRat $ toMemory @Byte $ bit 22
  11 % 4
  -}
  toRat :: forall (mem :: Nat) . KnownNat mem => Memory mem -> Ratio Natural
  toRat (Memory m) = m % nat @mem
  {-# INLINE toRat #-}
  
  {- | Floor 'Memory' unit to integral number. This function may lose some
  information, so use only when:
  
  1. You don't care about losing information.
  2. You are sure that there will be no loss.
  
  >>> floor $ byte 4
  4
  >>> floor $ toMemory @Byte $ bit 22
  2
  -}
  floor
      :: forall (n :: Type) (mem :: Nat) .
         (Integral n, KnownNat mem)
      => Memory mem
      -> n
  floor = Prelude.floor . toRat
  {-# INLINE floor #-}
  {-# SPECIALIZE floor :: KnownNat mem => Memory mem -> Int     #-}
  {-# SPECIALIZE floor :: KnownNat mem => Memory mem -> Word    #-}
  {-# SPECIALIZE floor :: KnownNat mem => Memory mem -> Integer #-}
  {-# SPECIALIZE floor :: KnownNat mem => Memory mem -> Natural #-}
  
  ----------------------------------------------------------------------------
  -- Numeric functions
  ----------------------------------------------------------------------------
  
  {- | Returns the result of multiplication 'Natural' with the given 'Memory' value
  
  >>> memoryMul 2 (byte 4)
  Memory {unMemory = 64}
  -}
  memoryMul  :: Natural -> Memory mem -> Memory mem
  memoryMul = stimes
  {-# INLINE memoryMul #-}
  
  {- | Returns the result of comparison of two 'Memory' values
  and the difference between them as another 'Memory' of the same unit.
  
  >>> memoryDiff (bit 4) (bit 8)
  (LT,Memory {unMemory = 4})
  >>> memoryDiff (byte 8) (byte 4)
  (GT,Memory {unMemory = 32})
  >>> memoryDiff (kilobyte 2) (kilobyte 2)
  (EQ,Memory {unMemory = 0})
  -}
  memoryDiff :: Memory mem -> Memory mem -> (Ordering, Memory mem)
  memoryDiff (Memory m1) (Memory m2) = case compare m1 m2 of
      LT -> (LT, Memory $ m2 - m1)
      GT -> (GT, Memory $ m1 - m2)
      EQ -> (EQ, Memory 0)
  {-# INLINE memoryDiff #-}
  
  {- | Returns the result of addition of two 'Memory' values casted
  to the second memory unit.
  
  >>> memoryPlus (bit 8) (megabyte 2)
  Memory {unMemory = 16000008}
  -}
  memoryPlus :: Memory mem1 -> Memory mem2 -> Memory mem2
  memoryPlus m1 = (<>) (toMemory m1)
  {-# INLINE memoryPlus #-}
  
  {- | Retuns the result of division of two 'Memory' values of any units.
  
  >>> memoryDiv (kilobyte 3) (byte 2)
  1500 % 1
  -}
  memoryDiv :: Memory mem1 -> Memory mem2 -> Ratio Natural
  memoryDiv (Memory m1) (Memory m2) = m1 % m2
  {-# INLINE memoryDiv #-}
  
  ----------------------------------------------------------------------------
  -- AnyMemory
  ----------------------------------------------------------------------------
  
  {- $any
  This data type is useful for working with 'Memory' of different units in
  collections, or when 'Memory' of non-specified unit can be returned.
  -}
  
  -- | Existential data type for 'Memory's.
  data AnyMemory
      = forall (mem :: Nat) . (KnownNat mem, KnownUnitSymbol mem)
      => MkAnyMemory (Memory mem)
  
  instance Show AnyMemory where
      show (MkAnyMemory t) = showMemory t
  
  ----------------------------------------------------------------------------
  -- Internal
  ----------------------------------------------------------------------------
  
  nat :: forall (mem :: Nat) . KnownNat mem => Natural
  nat = natVal' (proxy# :: Proxy# mem)
  {-# INLINE nat #-}
  