-- | A newtype with an attached phantom type which allows us to encode
-- nucleotides and amino acids. Actual seqence-specific functions can be founds
-- in the appropriate modules @AA@ and @Nuc@.

module Biobase.Primary.Letter where

import           Control.DeepSeq (NFData)
import           Data.Aeson
import           Data.Binary
import           Data.Coerce
import           Data.Data
import           Data.Hashable (Hashable)
import           Data.Ix (Ix(..))
import           Data.Serialize (Serialize(..))
import           Data.String (IsString(..))
import           Data.Typeable
import           Data.Vector.Fusion.Stream.Monadic (map,Step(..),flatten)
import           Data.Vector.Unboxed.Deriving
import           GHC.Base (remInt,quotInt)
import           GHC.Generics (Generic)
import           Prelude hiding (map)
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Vector.Unboxed as VU

import           Data.PrimitiveArray hiding (map)
import Data.Info



-- | A 'Letter' together with its phantom type @seqTy@ encodes bio-sequences,
-- while @nameTy@ allows to specify a type-level name for a letter.

newtype Letter (seqTy :: *) (nameTy :: k) = Letter { Letter seqTy nameTy -> Int
getLetter :: Int }
  deriving (Letter seqTy nameTy -> Letter seqTy nameTy -> Bool
(Letter seqTy nameTy -> Letter seqTy nameTy -> Bool)
-> (Letter seqTy nameTy -> Letter seqTy nameTy -> Bool)
-> Eq (Letter seqTy nameTy)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall seqTy k (nameTy :: k).
Letter seqTy nameTy -> Letter seqTy nameTy -> Bool
/= :: Letter seqTy nameTy -> Letter seqTy nameTy -> Bool
$c/= :: forall seqTy k (nameTy :: k).
Letter seqTy nameTy -> Letter seqTy nameTy -> Bool
== :: Letter seqTy nameTy -> Letter seqTy nameTy -> Bool
$c== :: forall seqTy k (nameTy :: k).
Letter seqTy nameTy -> Letter seqTy nameTy -> Bool
Eq,Eq (Letter seqTy nameTy)
Eq (Letter seqTy nameTy)
-> (Letter seqTy nameTy -> Letter seqTy nameTy -> Ordering)
-> (Letter seqTy nameTy -> Letter seqTy nameTy -> Bool)
-> (Letter seqTy nameTy -> Letter seqTy nameTy -> Bool)
-> (Letter seqTy nameTy -> Letter seqTy nameTy -> Bool)
-> (Letter seqTy nameTy -> Letter seqTy nameTy -> Bool)
-> (Letter seqTy nameTy
    -> Letter seqTy nameTy -> Letter seqTy nameTy)
-> (Letter seqTy nameTy
    -> Letter seqTy nameTy -> Letter seqTy nameTy)
-> Ord (Letter seqTy nameTy)
Letter seqTy nameTy -> Letter seqTy nameTy -> Bool
Letter seqTy nameTy -> Letter seqTy nameTy -> Ordering
Letter seqTy nameTy -> Letter seqTy nameTy -> Letter seqTy nameTy
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
forall seqTy k (nameTy :: k). Eq (Letter seqTy nameTy)
forall seqTy k (nameTy :: k).
Letter seqTy nameTy -> Letter seqTy nameTy -> Bool
forall seqTy k (nameTy :: k).
Letter seqTy nameTy -> Letter seqTy nameTy -> Ordering
forall seqTy k (nameTy :: k).
Letter seqTy nameTy -> Letter seqTy nameTy -> Letter seqTy nameTy
min :: Letter seqTy nameTy -> Letter seqTy nameTy -> Letter seqTy nameTy
$cmin :: forall seqTy k (nameTy :: k).
Letter seqTy nameTy -> Letter seqTy nameTy -> Letter seqTy nameTy
max :: Letter seqTy nameTy -> Letter seqTy nameTy -> Letter seqTy nameTy
$cmax :: forall seqTy k (nameTy :: k).
Letter seqTy nameTy -> Letter seqTy nameTy -> Letter seqTy nameTy
>= :: Letter seqTy nameTy -> Letter seqTy nameTy -> Bool
$c>= :: forall seqTy k (nameTy :: k).
Letter seqTy nameTy -> Letter seqTy nameTy -> Bool
> :: Letter seqTy nameTy -> Letter seqTy nameTy -> Bool
$c> :: forall seqTy k (nameTy :: k).
Letter seqTy nameTy -> Letter seqTy nameTy -> Bool
<= :: Letter seqTy nameTy -> Letter seqTy nameTy -> Bool
$c<= :: forall seqTy k (nameTy :: k).
Letter seqTy nameTy -> Letter seqTy nameTy -> Bool
< :: Letter seqTy nameTy -> Letter seqTy nameTy -> Bool
$c< :: forall seqTy k (nameTy :: k).
Letter seqTy nameTy -> Letter seqTy nameTy -> Bool
compare :: Letter seqTy nameTy -> Letter seqTy nameTy -> Ordering
$ccompare :: forall seqTy k (nameTy :: k).
Letter seqTy nameTy -> Letter seqTy nameTy -> Ordering
$cp1Ord :: forall seqTy k (nameTy :: k). Eq (Letter seqTy nameTy)
Ord,(forall x. Letter seqTy nameTy -> Rep (Letter seqTy nameTy) x)
-> (forall x. Rep (Letter seqTy nameTy) x -> Letter seqTy nameTy)
-> Generic (Letter seqTy nameTy)
forall x. Rep (Letter seqTy nameTy) x -> Letter seqTy nameTy
forall x. Letter seqTy nameTy -> Rep (Letter seqTy nameTy) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall seqTy k (nameTy :: k) x.
Rep (Letter seqTy nameTy) x -> Letter seqTy nameTy
forall seqTy k (nameTy :: k) x.
Letter seqTy nameTy -> Rep (Letter seqTy nameTy) x
$cto :: forall seqTy k (nameTy :: k) x.
Rep (Letter seqTy nameTy) x -> Letter seqTy nameTy
$cfrom :: forall seqTy k (nameTy :: k) x.
Letter seqTy nameTy -> Rep (Letter seqTy nameTy) x
Generic,Ord (Letter seqTy nameTy)
Ord (Letter seqTy nameTy)
-> ((Letter seqTy nameTy, Letter seqTy nameTy)
    -> [Letter seqTy nameTy])
-> ((Letter seqTy nameTy, Letter seqTy nameTy)
    -> Letter seqTy nameTy -> Int)
-> ((Letter seqTy nameTy, Letter seqTy nameTy)
    -> Letter seqTy nameTy -> Int)
-> ((Letter seqTy nameTy, Letter seqTy nameTy)
    -> Letter seqTy nameTy -> Bool)
-> ((Letter seqTy nameTy, Letter seqTy nameTy) -> Int)
-> ((Letter seqTy nameTy, Letter seqTy nameTy) -> Int)
-> Ix (Letter seqTy nameTy)
(Letter seqTy nameTy, Letter seqTy nameTy) -> Int
(Letter seqTy nameTy, Letter seqTy nameTy) -> [Letter seqTy nameTy]
(Letter seqTy nameTy, Letter seqTy nameTy)
-> Letter seqTy nameTy -> Bool
(Letter seqTy nameTy, Letter seqTy nameTy)
-> Letter seqTy nameTy -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
forall seqTy k (nameTy :: k). Ord (Letter seqTy nameTy)
forall seqTy k (nameTy :: k).
(Letter seqTy nameTy, Letter seqTy nameTy) -> Int
forall seqTy k (nameTy :: k).
(Letter seqTy nameTy, Letter seqTy nameTy) -> [Letter seqTy nameTy]
forall seqTy k (nameTy :: k).
(Letter seqTy nameTy, Letter seqTy nameTy)
-> Letter seqTy nameTy -> Bool
forall seqTy k (nameTy :: k).
(Letter seqTy nameTy, Letter seqTy nameTy)
-> Letter seqTy nameTy -> Int
unsafeRangeSize :: (Letter seqTy nameTy, Letter seqTy nameTy) -> Int
$cunsafeRangeSize :: forall seqTy k (nameTy :: k).
(Letter seqTy nameTy, Letter seqTy nameTy) -> Int
rangeSize :: (Letter seqTy nameTy, Letter seqTy nameTy) -> Int
$crangeSize :: forall seqTy k (nameTy :: k).
(Letter seqTy nameTy, Letter seqTy nameTy) -> Int
inRange :: (Letter seqTy nameTy, Letter seqTy nameTy)
-> Letter seqTy nameTy -> Bool
$cinRange :: forall seqTy k (nameTy :: k).
(Letter seqTy nameTy, Letter seqTy nameTy)
-> Letter seqTy nameTy -> Bool
unsafeIndex :: (Letter seqTy nameTy, Letter seqTy nameTy)
-> Letter seqTy nameTy -> Int
$cunsafeIndex :: forall seqTy k (nameTy :: k).
(Letter seqTy nameTy, Letter seqTy nameTy)
-> Letter seqTy nameTy -> Int
index :: (Letter seqTy nameTy, Letter seqTy nameTy)
-> Letter seqTy nameTy -> Int
$cindex :: forall seqTy k (nameTy :: k).
(Letter seqTy nameTy, Letter seqTy nameTy)
-> Letter seqTy nameTy -> Int
range :: (Letter seqTy nameTy, Letter seqTy nameTy) -> [Letter seqTy nameTy]
$crange :: forall seqTy k (nameTy :: k).
(Letter seqTy nameTy, Letter seqTy nameTy) -> [Letter seqTy nameTy]
$cp1Ix :: forall seqTy k (nameTy :: k). Ord (Letter seqTy nameTy)
Ix,Typeable)

-- | While @coerce@ will always work, this way restricts the change to just the
-- @nameTy@.

changeNameTy :: Letter seqTy nameTy -> Letter seqTy newNameTy
{-# Inline changeNameTy #-}
changeNameTy :: Letter seqTy nameTy -> Letter seqTy newNameTy
changeNameTy = Letter seqTy nameTy -> Letter seqTy newNameTy
coerce

-- | Manual @Data@ instance because @Letter@ should not show its
-- implementation. This also allows for better use of generic programming
-- downstream.

instance (Typeable t, Typeable (Letter t n)) => Data (Letter t n) where
  toConstr :: Letter t n -> Constr
toConstr = DataType -> Int -> Constr
forall a. (Integral a, Show a) => DataType -> a -> Constr
mkIntegralConstr DataType
letterDataType (Int -> Constr) -> (Letter t n -> Int) -> Letter t n -> Constr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Letter t n -> Int
forall seqTy k (nameTy :: k). Letter seqTy nameTy -> Int
getLetter
  gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Letter t n)
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
z Constr
c = case Constr -> ConstrRep
constrRep Constr
c of
    (IntConstr Integer
x) -> Letter t n -> c (Letter t n)
forall r. r -> c r
z (Int -> Letter t n
forall k seqTy (nameTy :: k). Int -> Letter seqTy nameTy
Letter (Int -> Letter t n) -> Int -> Letter t n
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
    ConstrRep
_ -> [Char] -> c (Letter t n)
forall a. [Char] -> a
errorWithoutStackTrace ([Char] -> c (Letter t n)) -> [Char] -> c (Letter t n)
forall a b. (a -> b) -> a -> b
$ [Char]
"Biobase.Primary.Letter.gunfold: Constructor "
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Constr -> [Char]
forall a. Show a => a -> [Char]
show Constr
c
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" is not of type Letter (using Int-rep)"
  dataTypeOf :: Letter t n -> DataType
dataTypeOf Letter t n
_ = DataType
letterDataType
letterDataType :: DataType
letterDataType = [Char] -> [Constr] -> DataType
mkDataType [Char]
"Biobase.Primary.Letter" [Constr
letterConstr]
letterConstr :: Constr
letterConstr   = DataType -> [Char] -> [[Char]] -> Fixity -> Constr
mkConstr DataType
letterDataType [Char]
"Letter" [] Fixity
Prefix

instance Binary    (Letter t n)
instance Serialize (Letter t n)

instance NFData (Letter t n)

type Primary t n = VU.Vector (Letter t n)

-- | Convert 'Letter' types into character forms. @DNA@, @RNA@, and @amino
-- acid@ sequences can make use of this. Other @Letter@ types only if they
-- have single-char representations.

class LetterChar t n where
  letterChar :: Letter t n -> Char
  charLetter :: Char -> Letter t n

-- | Conversion from a large number of sequence-like inputs to primary
-- sequences.

class MkPrimary c t n where
    primary :: c -> Primary t n

instance MkPrimary (VU.Vector Char) t n => MkPrimary String t n where
    primary :: [Char] -> Primary t n
primary = Vector Char -> Primary t n
forall k c t (n :: k). MkPrimary c t n => c -> Primary t n
primary (Vector Char -> Primary t n)
-> ([Char] -> Vector Char) -> [Char] -> Primary t n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Vector Char
forall a. Unbox a => [a] -> Vector a
VU.fromList

instance MkPrimary (VU.Vector Char) t n =>  MkPrimary T.Text t n where
    primary :: Text -> Primary t n
primary = Vector Char -> Primary t n
forall k c t (n :: k). MkPrimary c t n => c -> Primary t n
primary (Vector Char -> Primary t n)
-> (Text -> Vector Char) -> Text -> Primary t n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Vector Char
forall a. Unbox a => [a] -> Vector a
VU.fromList ([Char] -> Vector Char) -> (Text -> [Char]) -> Text -> Vector Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack

instance MkPrimary (VU.Vector Char) t n => MkPrimary TL.Text t n where
    primary :: Text -> Primary t n
primary = Vector Char -> Primary t n
forall k c t (n :: k). MkPrimary c t n => c -> Primary t n
primary (Vector Char -> Primary t n)
-> (Text -> Vector Char) -> Text -> Primary t n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Vector Char
forall a. Unbox a => [a] -> Vector a
VU.fromList ([Char] -> Vector Char) -> (Text -> [Char]) -> Text -> Vector Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
TL.unpack

instance MkPrimary (VU.Vector Char) t n => MkPrimary BS.ByteString t n where
    primary :: ByteString -> Primary t n
primary = Vector Char -> Primary t n
forall k c t (n :: k). MkPrimary c t n => c -> Primary t n
primary (Vector Char -> Primary t n)
-> (ByteString -> Vector Char) -> ByteString -> Primary t n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Vector Char
forall a. Unbox a => [a] -> Vector a
VU.fromList ([Char] -> Vector Char)
-> (ByteString -> [Char]) -> ByteString -> Vector Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
BS.unpack

instance MkPrimary (VU.Vector Char) t n => MkPrimary BSL.ByteString t n where
    primary :: ByteString -> Primary t n
primary = Vector Char -> Primary t n
forall k c t (n :: k). MkPrimary c t n => c -> Primary t n
primary (Vector Char -> Primary t n)
-> (ByteString -> Vector Char) -> ByteString -> Primary t n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Vector Char
forall a. Unbox a => [a] -> Vector a
VU.fromList ([Char] -> Vector Char)
-> (ByteString -> [Char]) -> ByteString -> Vector Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
BSL.unpack

instance (VU.Unbox (Letter t n), IsString [Letter t n]) => IsString (VU.Vector (Letter t n)) where
    fromString :: [Char] -> Vector (Letter t n)
fromString = [Letter t n] -> Vector (Letter t n)
forall a. Unbox a => [a] -> Vector a
VU.fromList ([Letter t n] -> Vector (Letter t n))
-> ([Char] -> [Letter t n]) -> [Char] -> Vector (Letter t n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Letter t n]
forall a. IsString a => [Char] -> a
fromString



-- *** Instances for 'Letter'.

derivingUnbox "Letter"
  [t| forall t n . Letter t n -> Int |] [| getLetter |] [| Letter |]

instance Hashable (Letter t n)

-- |
--
-- TODO replace @LtLetter Int@ with more specific limits? Maybe some constants?

instance Index (Letter l n) where
  newtype LimitType (Letter l n) = LtLetter (Letter l n)
  linearIndex :: LimitType (Letter l n) -> Letter l n -> Int
linearIndex LimitType (Letter l n)
_ (Letter Int
i) = Int
i
  {-# Inline linearIndex #-}
  fromLinearIndex :: LimitType (Letter l n) -> Int -> Letter l n
fromLinearIndex LimitType (Letter l n)
_ Int
k = Int -> Letter l n
forall k seqTy (nameTy :: k). Int -> Letter seqTy nameTy
Letter Int
k
  {-# Inline fromLinearIndex #-}
  size :: LimitType (Letter l n) -> Int
size (LtLetter (Letter h)) = Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
  {-# Inline size #-}
  inBounds :: LimitType (Letter l n) -> Letter l n -> Bool
inBounds (LtLetter h) Letter l n
i = Letter l n
forall i. Index i => i
zeroBound Letter l n -> Letter l n -> Bool
forall a. Ord a => a -> a -> Bool
<= Letter l n
i Bool -> Bool -> Bool
&& Letter l n
i Letter l n -> Letter l n -> Bool
forall a. Ord a => a -> a -> Bool
<= Letter l n
h
  {-# Inline inBounds #-}
  zeroBound :: Letter l n
zeroBound = Int -> Letter l n
forall k seqTy (nameTy :: k). Int -> Letter seqTy nameTy
Letter Int
0
  {-# Inline zeroBound #-}
  zeroBound' :: LimitType (Letter l n)
zeroBound' = Letter l n -> LimitType (Letter l n)
forall k l (n :: k). Letter l n -> LimitType (Letter l n)
LtLetter Letter l n
forall i. Index i => i
zeroBound
  {-# Inline zeroBound' #-}
  totalSize :: LimitType (Letter l n) -> [Integer]
totalSize (LtLetter (Letter k)) = [ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1 ]
  {-# Inline totalSize #-}
  showBound :: LimitType (Letter l n) -> [[Char]]
showBound (LtLetter (Letter k)) = [ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
k ]
  showIndex :: Letter l n -> [[Char]]
showIndex (Letter Int
k) = [ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
k ]

deriving instance (Bounded (Letter l n)) => Bounded (LimitType (Letter l n))
deriving instance Eq      (LimitType (Letter l n))
deriving instance Generic (LimitType (Letter l n))
deriving instance (Read (Letter l n)) => Read    (LimitType (Letter l n))
deriving instance (Show (Letter l n)) => Show    (LimitType (Letter l n))
deriving instance Typeable (LimitType (Letter l n))
deriving instance Data (Letter l n) => Data (LimitType (Letter l n))

instance IndexStream z => IndexStream (z:.Letter l n) where
  streamUp :: LimitType (z :. Letter l n)
-> LimitType (z :. Letter l n) -> Stream m (z :. Letter l n)
streamUp (ls:..LtLetter l) (hs:..LtLetter h) = (z -> m (z, Letter l n))
-> ((z, Letter l n) -> m (Step (z, Letter l n) (z :. Letter l n)))
-> Stream m z
-> Stream m (z :. Letter l n)
forall (m :: * -> *) a s b.
Monad m =>
(a -> m s) -> (s -> m (Step s b)) -> Stream m a -> Stream m b
flatten z -> m (z, Letter l n)
mk (z, Letter l n) -> m (Step (z, Letter l n) (z :. Letter l n))
step (Stream m z -> Stream m (z :. Letter l n))
-> Stream m z -> Stream m (z :. Letter l n)
forall a b. (a -> b) -> a -> b
$ LimitType z -> LimitType z -> Stream m z
forall i (m :: * -> *).
(IndexStream i, Monad m) =>
LimitType i -> LimitType i -> Stream m i
streamUp LimitType z
ls LimitType z
hs
    where mk :: z -> m (z, Letter l n)
mk z
z = (z, Letter l n) -> m (z, Letter l n)
forall (m :: * -> *) a. Monad m => a -> m a
return (z
z,Letter l n
l)
          step :: (z, Letter l n) -> m (Step (z, Letter l n) (z :. Letter l n))
step (z
z,Letter l n
k)
            | Letter l n
k Letter l n -> Letter l n -> Bool
forall a. Ord a => a -> a -> Bool
> Letter l n
h     = Step (z, Letter l n) (z :. Letter l n)
-> m (Step (z, Letter l n) (z :. Letter l n))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (z, Letter l n) (z :. Letter l n)
 -> m (Step (z, Letter l n) (z :. Letter l n)))
-> Step (z, Letter l n) (z :. Letter l n)
-> m (Step (z, Letter l n) (z :. Letter l n))
forall a b. (a -> b) -> a -> b
$ Step (z, Letter l n) (z :. Letter l n)
forall s a. Step s a
Done
            | Bool
otherwise = Step (z, Letter l n) (z :. Letter l n)
-> m (Step (z, Letter l n) (z :. Letter l n))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (z, Letter l n) (z :. Letter l n)
 -> m (Step (z, Letter l n) (z :. Letter l n)))
-> Step (z, Letter l n) (z :. Letter l n)
-> m (Step (z, Letter l n) (z :. Letter l n))
forall a b. (a -> b) -> a -> b
$ (z :. Letter l n)
-> (z, Letter l n) -> Step (z, Letter l n) (z :. Letter l n)
forall a s. a -> s -> Step s a
Yield (z
zz -> Letter l n -> z :. Letter l n
forall a b. a -> b -> a :. b
:.Letter l n
k) (z
z,Int -> Letter l n
forall k seqTy (nameTy :: k). Int -> Letter seqTy nameTy
Letter (Int -> Letter l n) -> Int -> Letter l n
forall a b. (a -> b) -> a -> b
$ Letter l n -> Int
forall seqTy k (nameTy :: k). Letter seqTy nameTy -> Int
getLetter Letter l n
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
          {-# Inline [0] mk   #-}
          {-# Inline [0] step #-}
  {-# Inline streamUp #-}
  streamDown :: LimitType (z :. Letter l n)
-> LimitType (z :. Letter l n) -> Stream m (z :. Letter l n)
streamDown (ls:..LtLetter l) (hs:..LtLetter h) = (z -> m (z, Letter l n))
-> ((z, Letter l n) -> m (Step (z, Letter l n) (z :. Letter l n)))
-> Stream m z
-> Stream m (z :. Letter l n)
forall (m :: * -> *) a s b.
Monad m =>
(a -> m s) -> (s -> m (Step s b)) -> Stream m a -> Stream m b
flatten z -> m (z, Letter l n)
mk (z, Letter l n) -> m (Step (z, Letter l n) (z :. Letter l n))
step (Stream m z -> Stream m (z :. Letter l n))
-> Stream m z -> Stream m (z :. Letter l n)
forall a b. (a -> b) -> a -> b
$ LimitType z -> LimitType z -> Stream m z
forall i (m :: * -> *).
(IndexStream i, Monad m) =>
LimitType i -> LimitType i -> Stream m i
streamDown LimitType z
ls LimitType z
hs
    where mk :: z -> m (z, Letter l n)
mk z
z = (z, Letter l n) -> m (z, Letter l n)
forall (m :: * -> *) a. Monad m => a -> m a
return (z
z,Letter l n
h)
          step :: (z, Letter l n) -> m (Step (z, Letter l n) (z :. Letter l n))
step (z
z,Letter l n
k)
            | Letter l n
k Letter l n -> Letter l n -> Bool
forall a. Ord a => a -> a -> Bool
< Letter l n
l     = Step (z, Letter l n) (z :. Letter l n)
-> m (Step (z, Letter l n) (z :. Letter l n))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (z, Letter l n) (z :. Letter l n)
 -> m (Step (z, Letter l n) (z :. Letter l n)))
-> Step (z, Letter l n) (z :. Letter l n)
-> m (Step (z, Letter l n) (z :. Letter l n))
forall a b. (a -> b) -> a -> b
$ Step (z, Letter l n) (z :. Letter l n)
forall s a. Step s a
Done
            | Bool
otherwise = Step (z, Letter l n) (z :. Letter l n)
-> m (Step (z, Letter l n) (z :. Letter l n))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (z, Letter l n) (z :. Letter l n)
 -> m (Step (z, Letter l n) (z :. Letter l n)))
-> Step (z, Letter l n) (z :. Letter l n)
-> m (Step (z, Letter l n) (z :. Letter l n))
forall a b. (a -> b) -> a -> b
$ (z :. Letter l n)
-> (z, Letter l n) -> Step (z, Letter l n) (z :. Letter l n)
forall a s. a -> s -> Step s a
Yield (z
zz -> Letter l n -> z :. Letter l n
forall a b. a -> b -> a :. b
:.Letter l n
k) (z
z,Int -> Letter l n
forall k seqTy (nameTy :: k). Int -> Letter seqTy nameTy
Letter (Int -> Letter l n) -> Int -> Letter l n
forall a b. (a -> b) -> a -> b
$ Letter l n -> Int
forall seqTy k (nameTy :: k). Letter seqTy nameTy -> Int
getLetter Letter l n
k Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
          {-# Inline [0] mk   #-}
          {-# Inline [0] step #-}
  {-# Inline streamDown #-}

instance IndexStream (Letter l n) where
  streamUp :: LimitType (Letter l n)
-> LimitType (Letter l n) -> Stream m (Letter l n)
streamUp LimitType (Letter l n)
l LimitType (Letter l n)
h = ((Z :. Letter l n) -> Letter l n)
-> Stream m (Z :. Letter l n) -> Stream m (Letter l n)
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Stream m a -> Stream m b
map (\(Z
Z:.Letter l n
k) -> Letter l n
k) (Stream m (Z :. Letter l n) -> Stream m (Letter l n))
-> Stream m (Z :. Letter l n) -> Stream m (Letter l n)
forall a b. (a -> b) -> a -> b
$ LimitType (Z :. Letter l n)
-> LimitType (Z :. Letter l n) -> Stream m (Z :. Letter l n)
forall i (m :: * -> *).
(IndexStream i, Monad m) =>
LimitType i -> LimitType i -> Stream m i
streamUp (LimitType Z
ZZLimitType Z
-> LimitType (Letter l n) -> LimitType (Z :. Letter l n)
forall zs z. LimitType zs -> LimitType z -> LimitType (zs :. z)
:..LimitType (Letter l n)
l) (LimitType Z
ZZLimitType Z
-> LimitType (Letter l n) -> LimitType (Z :. Letter l n)
forall zs z. LimitType zs -> LimitType z -> LimitType (zs :. z)
:..LimitType (Letter l n)
h)
  streamDown :: LimitType (Letter l n)
-> LimitType (Letter l n) -> Stream m (Letter l n)
streamDown LimitType (Letter l n)
l LimitType (Letter l n)
h = ((Z :. Letter l n) -> Letter l n)
-> Stream m (Z :. Letter l n) -> Stream m (Letter l n)
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Stream m a -> Stream m b
map (\(Z
Z:.Letter l n
k) -> Letter l n
k) (Stream m (Z :. Letter l n) -> Stream m (Letter l n))
-> Stream m (Z :. Letter l n) -> Stream m (Letter l n)
forall a b. (a -> b) -> a -> b
$ LimitType (Z :. Letter l n)
-> LimitType (Z :. Letter l n) -> Stream m (Z :. Letter l n)
forall i (m :: * -> *).
(IndexStream i, Monad m) =>
LimitType i -> LimitType i -> Stream m i
streamDown (LimitType Z
ZZLimitType Z
-> LimitType (Letter l n) -> LimitType (Z :. Letter l n)
forall zs z. LimitType zs -> LimitType z -> LimitType (zs :. z)
:..LimitType (Letter l n)
l) (LimitType Z
ZZLimitType Z
-> LimitType (Letter l n) -> LimitType (Z :. Letter l n)
forall zs z. LimitType zs -> LimitType z -> LimitType (zs :. z)
:..LimitType (Letter l n)
h)
  {-# Inline streamUp #-}
  {-# Inline streamDown #-}