<commit_before>{-# LANGUAGE ExistentialQuantification #-}

-- 
-- RankNTypes

-- , ScopedTypeVariables, PatternSignatures
-- Also had that same 'impossible' crash on mac with 6.8.3

--
-- , ImpredicativeTypes
-- 
--  FlexibleContexts
{- # OPTIONS glasgow-exts #-}


-- Haskell needs :t in the code!!!


import Data.Set as Set
import Data.Map as Map
import Data.IORef
import Unsafe.Coerce
import Control.Monad
import qualified Data.IntMap as IntMap

import System.IO.Unsafe
import Debug.Trace
import Data.Maybe

--import Data.IntMap as Map
--type Foo = IntMap Float

------------------------------------------------------------
-- Type definitions:

-- The central abstraction is a (heterogeneous) group of item and tag collections.
type Collections = (Int, MatchedTagMap, MatchedItemMap)


showcol (n, MT tmap, MI imap) =
  show (n, Map.size tmap, IntMap.keys imap, Map.keys foo, Map.elems foo)
 where 
    foo = unsafeCoerce $ (IntMap.!) imap 0 :: ItemCol Char Int

-- I think this is WRONG.  Quantification should have a narrower scope.
data MatchedItemMap = forall a b. Ord a => MI (IntMap.IntMap (ItemCol a b))
data MatchedTagMap  = forall a.   MT (Map (TagColID  a)   (TagCol a))

type TagColID  a   = Int
type ItemColID a b = Int
type TagCol    a   = Set a
type ItemCol   a b = Map a b

-- Produces a batch of new data to write, or blocks
type Step a = Collections -> a -> StepResult
data StepResult = Done ([NewTag], [NewItem])
                | forall a. Ord a => Block (TagColID a) a
		  -- type-wise Block is the same as NewTag
data NewTag  = forall a.   Ord a => NT (TagColID  a)   a
data NewItem = forall a b. Ord a => NI (ItemColID a b) a b

-- Need it to be a map... but this type is wrong, as above:
data Graph = forall a. G (Map (TagColID a) [Step a])

------------------------------------------------------------
-- (Optional) type signatures for operations:

newCollections :: IO (IORef Collections)
newTagCol      :: IORef Collections -> IO (TagColID a)
newItemCol     :: IORef Collections -> IO (ItemColID a b)


-- These are called by the step code and produce outbound tags and items:
put  :: Ord a => ItemColID a b -> a -> b -> NewItem
call :: Ord a => TagColID  a   -> a      -> NewTag


--------------------------------------------------------------------------------
-- Implementation:

--dummy = Map.empty :: Map (ItemColID Int Int) (ItemCol Int Int)
dummy = IntMap.empty :: IntMap.IntMap (ItemCol Int Int)

newCollections = newIORef (0, MT Map.empty, MI dummy)
newTagCol ref = do (cnt, MT tags, items) <- readIORef ref		   
		   let newtags = Map.insert cnt Set.empty tags
		   writeIORef ref (cnt+1, MT newtags, items)
		   return cnt
newItemCol ref = do (cnt, tags, MI items) <- readIORef ref 	   
		    let newitems = IntMap.insert cnt Map.empty items
		    writeIORef ref (cnt+1, tags, MI newitems)
		    return cnt

magic :: ItemColID a b -> ItemCol c d -> (a->c, d->b)
magic id col = (unsafeCoerce, unsafeCoerce)


{-# NOINLINE get #-}
get :: Ord a => Collections -> ItemColID a b -> a -> Maybe b
get (_, MT tmap, MI imap) id tag = 
  unsafePerformIO (putStrLn $ "  GETTING "++ show (unsafeCoerce tag::Char)) `seq`
  let itemcol = (IntMap.!) imap id 
      (castkey,castback) = magic id itemcol in
  case
      --trace ("LOOKUP " ++ (show $ (unsafeCoerce (Map.lookup (castkey tag) itemcol :: Maybe b) :: Maybe Int))) $ 
      --unsafePerformIO (putStrLn $ "  tag again "++ show (castkey tag)) `seq`
      Map.lookup (castkey tag) itemcol of
    Nothing -> trace " DAMN " $ Nothing
    Just d  -> trace (" YAY************ " ++ show (unsafeCoerce d :: Int)) $ Just (castback d)


put id tag item = NI id tag item -- Just accumulate puts as data
call id tag     = NT id tag 

bla = 
    do cref <- newCollections 
       d1 <- newItemCol cref :: IO (ItemColID Char Int)
       modifyIORef cref $ 
	 mergeUpdates [] [put d1 'z' 33, put d1 'b' 100]
       c  <- readIORef cref
       putStrLn "WTF is happening"
       putStrLn $ showcol c
       let !foo = trace "GET starting" $ get c d1 'b'
       putStrLn "almost done"
       --return $ trace ("foo " ++ show (foo::Maybe Int)) $ foo
       return $ (fromJust foo) + 0


-- This inserts new items and tags into a Collections object.
--
-- This is inefficient in that it looks up the tagCol/itemCol ID for
-- each update.  Ideally, steps would produce a more organized
-- "chunked" structure so that we could
--
-- Also, we could optimize this here by optimistically assuming that a
-- batch of updates are likely to the same collection.

magic2 :: ItemColID a b -> ItemCol c d -> 
	  (a -> c, b -> d, ItemColID a b -> ItemColID c d)
magic2 id col = (unsafeCoerce, unsafeCoerce, unsafeCoerce)

--mergeUpdates :: IORef Collections -> [NewTag] -> [NewItem] -> IO ()
mergeUpdates :: [NewTag] -> [NewItem] -> Collections -> Collections
--mergeUpdates cref newtags newitems =
mergeUpdates newtags newitems (n, MT tags, MI items) =
       -- SHOULD WE USE foldl' ???
       let items' = foldl (\ acc (NI id k x) -> 
  			    let (castkey, castval, cast) = magic2 id itemcol 
			        itemcol = (IntMap.!) acc (cast id)
 			        col = Map.insert (castkey k) (castval x) itemcol 
			    in
  			    IntMap.insert id col acc 
			  )
 	             items newitems in

-- Even THIS doesn't work:<commit_msg>Ok, making the item col IDs a real data type rather than a synonym fixed the last problem<commit_after>{-# LANGUAGE ExistentialQuantification #-}

-- 
-- RankNTypes

-- , ScopedTypeVariables, PatternSignatures
-- Also had that same 'impossible' crash on mac with 6.8.3

--
-- , ImpredicativeTypes
-- 
--  FlexibleContexts
{- # OPTIONS glasgow-exts #-}


-- Haskell needs :t in the code!!!


import Data.Set as Set
import Data.Map as Map
import Data.IORef
import Unsafe.Coerce
import Control.Monad
import qualified Data.IntMap as IntMap

import System.IO.Unsafe
import Debug.Trace
import Data.Maybe

--import Data.IntMap as Map
--type Foo = IntMap Float

------------------------------------------------------------
-- Type definitions:

-- The central abstraction is a (heterogeneous) group of item and tag collections.
type Collections = (Int, MatchedTagMap, MatchedItemMap)


showcol (n, MT tmap, MI imap) =
  show (n, Map.size tmap, IntMap.keys imap, Map.keys foo, Map.elems foo)
 where 
    foo = unsafeCoerce $ (IntMap.!) imap 0 :: ItemCol Char Int

-- I think this is WRONG.  Quantification should have a narrower scope.
data MatchedItemMap = forall a b. Ord a => MI (IntMap.IntMap (ItemCol a b))
data MatchedTagMap  = forall a.   MT (Map (TagColID  a)   (TagCol a))

type TagColID  a   = Int
data ItemColID a b = ICID Int
type TagCol    a   = Set a
type ItemCol   a b = Map a b

-- Produces a batch of new data to write, or blocks
type Step a = Collections -> a -> StepResult
data StepResult = Done ([NewTag], [NewItem])
                | forall a. Ord a => Block (TagColID a) a
		  -- type-wise Block is the same as NewTag
data NewTag  = forall a.   Ord a => NT (TagColID  a)   a
data NewItem = forall a b. Ord a => NI (ItemColID a b) a b

-- Need it to be a map... but this type is wrong, as above:
data Graph = forall a. G (Map (TagColID a) [Step a])

------------------------------------------------------------
-- (Optional) type signatures for operations:

newCollections :: IO (IORef Collections)
newTagCol      :: IORef Collections -> IO (TagColID a)
newItemCol     :: IORef Collections -> IO (ItemColID a b)


-- These are called by the step code and produce outbound tags and items:
put  :: Ord a => ItemColID a b -> a -> b -> NewItem
call :: Ord a => TagColID  a   -> a      -> NewTag


--------------------------------------------------------------------------------
-- Implementation:

--dummy = Map.empty :: Map (ItemColID Int Int) (ItemCol Int Int)
dummy = IntMap.empty :: IntMap.IntMap (ItemCol Int Int)

newCollections = newIORef (0, MT Map.empty, MI dummy)
newTagCol ref = do (cnt, MT tags, items) <- readIORef ref		   
		   let newtags = Map.insert cnt Set.empty tags
		   writeIORef ref (cnt+1, MT newtags, items)
		   return cnt
newItemCol ref = do (cnt, tags, MI items) <- readIORef ref 	   
		    let newitems = IntMap.insert cnt Map.empty items
		    writeIORef ref (cnt+1, tags, MI newitems)
		    return (ICID cnt)

magic :: ItemColID a b -> ItemCol c d -> (a->c, d->b)
magic id col = (unsafeCoerce, unsafeCoerce)


{-# NOINLINE get #-}
get :: Ord a => Collections -> ItemColID a b -> a -> Maybe b
get (_, MT tmap, MI imap) id tag = 
  unsafePerformIO (putStrLn $ "  GETTING "++ show (unsafeCoerce tag::Char)) `seq`
  let ICID n = id 
      itemcol = (IntMap.!) imap n
      (castkey,castback) = magic id itemcol in
  case
      --trace ("LOOKUP " ++ (show $ (unsafeCoerce (Map.lookup (castkey tag) itemcol :: Maybe b) :: Maybe Int))) $ 
      --unsafePerformIO (putStrLn $ "  tag again "++ show (castkey tag)) `seq`
      Map.lookup (castkey tag) itemcol of
    Nothing -> trace " DAMN " $ Nothing
    Just d  -> trace (" YAY************ " ++ show (unsafeCoerce d :: Int)) $ Just (castback d)


put id tag item = NI id tag item -- Just accumulate puts as data
call id tag     = NT id tag 

bla = 
    do cref <- newCollections 
       d1 <- newItemCol cref :: IO (ItemColID Char Int)
       modifyIORef cref $ 
	 mergeUpdates [] [put d1 'z' 33, put d1 'b' 100]
       c  <- readIORef cref
       putStrLn "WTF is happening"
       putStrLn $ showcol c
       let !foo = trace "GET starting" $ get c d1 'b'
       putStrLn "almost done"
       --return $ trace ("foo " ++ show (foo::Maybe Int)) $ foo
--       return $ (fromJust foo) + 0
       return $ foo


-- This inserts new items and tags into a Collections object.
--
-- This is inefficient in that it looks up the tagCol/itemCol ID for
-- each update.  Ideally, steps would produce a more organized
-- "chunked" structure so that we could
--
-- Also, we could optimize this here by optimistically assuming that a
-- batch of updates are likely to the same collection.

magic2 :: ItemColID a b -> ItemCol c d ->  (a -> c, b -> d)
--	  (a -> c, b -> d, ItemColID a b -> ItemColID c d)
magic2 id col = (unsafeCoerce, unsafeCoerce)

--mergeUpdates :: IORef Collections -> [NewTag] -> [NewItem] -> IO ()
mergeUpdates :: [NewTag] -> [NewItem] -> Collections -> Collections
--mergeUpdates cref newtags newitems =
mergeUpdates newtags newitems (n, MT tags, MI items) =
       -- SHOULD WE USE foldl' ???
       let items' = foldl (\ acc (NI id k x) -> 
  			    let ICID n = id 
			        (castkey, castval) = magic2 id itemcol 
			        itemcol = (IntMap.!) acc n
 			        col = Map.insert (castkey k) (castval x) itemcol 
			    in
  			    IntMap.insert n col acc 
			  )
 	             items newitems in

-- Even THIS doesn't work:
{'fraction_non_alphanumeric': 0.14635285327355935, 'fraction_numerical': 0.0037358737274680114, 'mean_word_length': 2.345204623555139, 'pattern_counts': {'":': 0, '<': 13, '<?xml version=': 0, '>': 79, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6875339', 'n_tokens_mistral': 3593, 'n_tokens_neox': 3359, 'n_words': 1367}