{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Internal module. Take care as usage can violate invariants.
module Shrun.Command.Types.Internal
  ( -- * Index
    CommandIndex (..),
    fromPositive,
    unsafeFromInt,
    succ,
    addNN,
    range,
    joinRange,

    -- * Vertex
    Vertex,
    LVertex,
    toVertex,
    fromVertex,
  )
where

import Numeric.Data.Positive.Internal (Positive (UnsafePositive))
import Shrun.Prelude

-- | Numeric index for each command, for handling command graph dependencies.
-- Conversion to/from 'Vertex' should use 'indexToVertex' and
-- 'indexFromVertex', as 'CommandIndex' is 1-based whereas 'Vertex' is
-- 0-based.
newtype CommandIndex = MkCommandIndex {CommandIndex -> Positive Int
unCommandIndex :: Positive Int}
  deriving stock ((forall x. CommandIndex -> Rep CommandIndex x)
-> (forall x. Rep CommandIndex x -> CommandIndex)
-> Generic CommandIndex
forall x. Rep CommandIndex x -> CommandIndex
forall x. CommandIndex -> Rep CommandIndex x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CommandIndex -> Rep CommandIndex x
from :: forall x. CommandIndex -> Rep CommandIndex x
$cto :: forall x. Rep CommandIndex x -> CommandIndex
to :: forall x. Rep CommandIndex x -> CommandIndex
Generic, Int -> CommandIndex -> ShowS
[CommandIndex] -> ShowS
CommandIndex -> String
(Int -> CommandIndex -> ShowS)
-> (CommandIndex -> String)
-> ([CommandIndex] -> ShowS)
-> Show CommandIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommandIndex -> ShowS
showsPrec :: Int -> CommandIndex -> ShowS
$cshow :: CommandIndex -> String
show :: CommandIndex -> String
$cshowList :: [CommandIndex] -> ShowS
showList :: [CommandIndex] -> ShowS
Show)
  deriving newtype (CommandIndex -> CommandIndex -> CommandIndex
(CommandIndex -> CommandIndex -> CommandIndex)
-> ASemigroup CommandIndex
forall s. (s -> s -> s) -> ASemigroup s
$c.+. :: CommandIndex -> CommandIndex -> CommandIndex
.+. :: CommandIndex -> CommandIndex -> CommandIndex
ASemigroup, CommandIndex -> CommandIndex -> Bool
(CommandIndex -> CommandIndex -> Bool)
-> (CommandIndex -> CommandIndex -> Bool) -> Eq CommandIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommandIndex -> CommandIndex -> Bool
== :: CommandIndex -> CommandIndex -> Bool
$c/= :: CommandIndex -> CommandIndex -> Bool
/= :: CommandIndex -> CommandIndex -> Bool
Eq, Eq CommandIndex
Eq CommandIndex =>
(Int -> CommandIndex -> Int)
-> (CommandIndex -> Int) -> Hashable CommandIndex
Int -> CommandIndex -> Int
CommandIndex -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> CommandIndex -> Int
hashWithSalt :: Int -> CommandIndex -> Int
$chash :: CommandIndex -> Int
hash :: CommandIndex -> Int
Hashable, CommandIndex -> CommandIndex -> CommandIndex
(CommandIndex -> CommandIndex -> CommandIndex)
-> MSemigroup CommandIndex
forall s. (s -> s -> s) -> MSemigroup s
$c.*. :: CommandIndex -> CommandIndex -> CommandIndex
.*. :: CommandIndex -> CommandIndex -> CommandIndex
MSemigroup, MSemigroup CommandIndex
CommandIndex
MSemigroup CommandIndex => CommandIndex -> MMonoid CommandIndex
forall m. MSemigroup m => m -> MMonoid m
$cone :: CommandIndex
one :: CommandIndex
MMonoid, Eq CommandIndex
Eq CommandIndex =>
(CommandIndex -> CommandIndex -> Ordering)
-> (CommandIndex -> CommandIndex -> Bool)
-> (CommandIndex -> CommandIndex -> Bool)
-> (CommandIndex -> CommandIndex -> Bool)
-> (CommandIndex -> CommandIndex -> Bool)
-> (CommandIndex -> CommandIndex -> CommandIndex)
-> (CommandIndex -> CommandIndex -> CommandIndex)
-> Ord CommandIndex
CommandIndex -> CommandIndex -> Bool
CommandIndex -> CommandIndex -> Ordering
CommandIndex -> CommandIndex -> CommandIndex
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CommandIndex -> CommandIndex -> Ordering
compare :: CommandIndex -> CommandIndex -> Ordering
$c< :: CommandIndex -> CommandIndex -> Bool
< :: CommandIndex -> CommandIndex -> Bool
$c<= :: CommandIndex -> CommandIndex -> Bool
<= :: CommandIndex -> CommandIndex -> Bool
$c> :: CommandIndex -> CommandIndex -> Bool
> :: CommandIndex -> CommandIndex -> Bool
$c>= :: CommandIndex -> CommandIndex -> Bool
>= :: CommandIndex -> CommandIndex -> Bool
$cmax :: CommandIndex -> CommandIndex -> CommandIndex
max :: CommandIndex -> CommandIndex -> CommandIndex
$cmin :: CommandIndex -> CommandIndex -> CommandIndex
min :: CommandIndex -> CommandIndex -> CommandIndex
Ord)
  deriving anyclass (CommandIndex -> ()
(CommandIndex -> ()) -> NFData CommandIndex
forall a. (a -> ()) -> NFData a
$crnf :: CommandIndex -> ()
rnf :: CommandIndex -> ()
NFData)
  deriving ((forall ann. CommandIndex -> Doc ann)
-> (forall ann. [CommandIndex] -> Doc ann) -> Pretty CommandIndex
forall ann. [CommandIndex] -> Doc ann
forall ann. CommandIndex -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
$cpretty :: forall ann. CommandIndex -> Doc ann
pretty :: forall ann. CommandIndex -> Doc ann
$cprettyList :: forall ann. [CommandIndex] -> Doc ann
prettyList :: forall ann. [CommandIndex] -> Doc ann
Pretty) via Int

instance Enum CommandIndex where
  toEnum :: Int -> CommandIndex
toEnum = HasCallStack => Int -> CommandIndex
Int -> CommandIndex
unsafeFromInt

  fromEnum :: CommandIndex -> Int
fromEnum = Optic' A_Getter NoIx CommandIndex Int -> CommandIndex -> Int
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic
  An_Iso NoIx CommandIndex CommandIndex (Positive Int) (Positive Int)
#unCommandIndex Optic
  An_Iso NoIx CommandIndex CommandIndex (Positive Int) (Positive Int)
-> Optic A_Getter NoIx (Positive Int) (Positive Int) Int Int
-> Optic' A_Getter NoIx CommandIndex Int
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Getter NoIx (Positive Int) (Positive Int) Int Int
#unPositive)

instance
  ( k ~ An_Iso,
    a ~ Positive Int,
    b ~ Positive Int
  ) =>
  LabelOptic "unCommandIndex" k CommandIndex CommandIndex a b
  where
  labelOptic :: Optic k NoIx CommandIndex CommandIndex a b
labelOptic = (CommandIndex -> a)
-> (b -> CommandIndex) -> Iso CommandIndex CommandIndex a b
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(MkCommandIndex Positive Int
i) -> a
Positive Int
i) b -> CommandIndex
Positive Int -> CommandIndex
MkCommandIndex
  {-# INLINE labelOptic #-}

succ :: CommandIndex -> CommandIndex
succ :: CommandIndex -> CommandIndex
succ = (CommandIndex -> CommandIndex -> CommandIndex
forall s. ASemigroup s => s -> s -> s
.+. CommandIndex
forall m. MMonoid m => m
one)

addNN :: CommandIndex -> NonNegative Int -> CommandIndex
addNN :: CommandIndex -> NonNegative Int -> CommandIndex
addNN CommandIndex
idx = Positive Int -> CommandIndex
MkCommandIndex (Positive Int -> CommandIndex)
-> (NonNegative Int -> Positive Int)
-> NonNegative Int
-> CommandIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Positive Int
forall a.
(AMonoid a, HasCallStack, Ord a, Show a) =>
a -> Positive a
unsafePositive (Int -> Positive Int)
-> (NonNegative Int -> Int) -> NonNegative Int -> Positive Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> (NonNegative Int -> Int) -> NonNegative Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Optic' A_Getter NoIx (NonNegative Int) Int
-> NonNegative Int -> Int
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Getter NoIx (NonNegative Int) Int
#unNonNegative
  where
    i :: Int
i = CommandIndex
idx CommandIndex -> Optic' A_Getter NoIx CommandIndex Int -> Int
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  An_Iso NoIx CommandIndex CommandIndex (Positive Int) (Positive Int)
#unCommandIndex Optic
  An_Iso NoIx CommandIndex CommandIndex (Positive Int) (Positive Int)
-> Optic A_Getter NoIx (Positive Int) (Positive Int) Int Int
-> Optic' A_Getter NoIx CommandIndex Int
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Getter NoIx (Positive Int) (Positive Int) Int Int
#unPositive

-- | Collapses 'range' output back into a single 'NESeq'.
joinRange :: (a, NESeq a) -> NESeq a
joinRange :: forall a. (a, NESeq a) -> NESeq a
joinRange (a
x1, a
x2 :<|| Seq a
xs) = a
x1 a -> Seq a -> NESeq a
forall a. a -> Seq a -> NESeq a
:<|| a
x2 a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
:<| Seq a
xs

-- | Given m, n s.t. m < n, returns [m .. n]. Notice this is /strictly/
-- increasing.
range :: CommandIndex -> CommandIndex -> Either String (Tuple2 CommandIndex (NESeq CommandIndex))
range :: CommandIndex
-> CommandIndex -> Either String (CommandIndex, NESeq CommandIndex)
range (MkCommandIndex (MkPositive Int
lower)) (MkCommandIndex (MkPositive Int
upper)) =
  if Int
lower Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
upper
    then case Int
lower Int -> Seq Int -> NESeq Int
forall a. a -> Seq a -> NESeq a
:<|| [Int
lower Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 .. Int
Item (Seq Int)
upper] of
      Int
_ :<|| Seq Int
Empty -> String -> Either String (CommandIndex, NESeq CommandIndex)
forall a b. a -> Either a b
Left String
err -- impossible!
      Int
x1 :<|| Int
x2 :<| Seq Int
xs -> (CommandIndex, NESeq CommandIndex)
-> Either String (CommandIndex, NESeq CommandIndex)
forall a b. b -> Either a b
Right (Int -> CommandIndex
f Int
x1, Int -> CommandIndex
f (Int -> CommandIndex) -> NESeq Int -> NESeq CommandIndex
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int
x2 Int -> Seq Int -> NESeq Int
forall a. a -> Seq a -> NESeq a
:<|| Seq Int
xs))
    else
      String -> Either String (CommandIndex, NESeq CommandIndex)
forall a b. a -> Either a b
Left String
err
  where
    f :: Int -> CommandIndex
f = Positive Int -> CommandIndex
MkCommandIndex (Positive Int -> CommandIndex)
-> (Int -> Positive Int) -> Int -> CommandIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Positive Int
forall a.
(AMonoid a, HasCallStack, Ord a, Show a) =>
a -> Positive a
unsafePositive

    err :: String
err =
      [String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
Item [String]
"Bad range. Expected ",
          Int -> String
forall a. Show a => a -> String
show Int
lower,
          String
Item [String]
" < ",
          Int -> String
forall a. Show a => a -> String
show Int
upper
        ]

fromPositive :: Positive Int -> CommandIndex
fromPositive :: Positive Int -> CommandIndex
fromPositive = Positive Int -> CommandIndex
MkCommandIndex

unsafeFromInt :: (HasCallStack) => Int -> CommandIndex
unsafeFromInt :: HasCallStack => Int -> CommandIndex
unsafeFromInt = Positive Int -> CommandIndex
fromPositive (Positive Int -> CommandIndex)
-> (Int -> Positive Int) -> Int -> CommandIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Positive Int
forall a.
(AMonoid a, HasCallStack, Ord a, Show a) =>
a -> Positive a
unsafePositive

-- | Type for Command graph vertex, for usage with fgl.
type Vertex = Int

-- | Labeled 'Vertex'.
type LVertex a = Tuple2 Vertex a

-- | Conversion to 'Vertex'.
toVertex :: CommandIndex -> Vertex
toVertex :: CommandIndex -> Int
toVertex (MkCommandIndex (MkPositive Int
i)) = Int
i

-- | Conversion from 'Vertex'.
fromVertex :: (HasCallStack) => Vertex -> CommandIndex
fromVertex :: HasCallStack => Int -> CommandIndex
fromVertex Int
v = Positive Int -> CommandIndex
MkCommandIndex (Int -> Positive Int
forall a.
(AMonoid a, HasCallStack, Ord a, Show a) =>
a -> Positive a
unsafePositive Int
v)