import Control.Monad
import Data.Bifunctor

import Control.Arrow hiding (first, second)

import Data.Map (Map)
import Data.Set (Set)
import Data.Array.Unboxed (UArray)

import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Ord as Ord
import qualified Data.List as List
import qualified Data.Char as Char
import qualified Data.Maybe as Maybe
import qualified Data.Array.Unboxed as UArray

toNumber = flip (-) (Char.ord '0') <<< Char.ord 

type FileID = Int
type FileLength = Int
type DiskPosition = Int
type File = (FileID, (DiskPosition, FileLength))
type EmptyMap = Map FileLength (Set DiskPosition)

readDisk :: DiskPosition -> [(Bool, FileLength)] -> [(Bool, (DiskPosition, FileLength))]
readDisk _ [] = []
readDisk o ((True, l):fs)  = (True, (o, l))  : readDisk (o+l) fs
readDisk o ((False, l):fs) = (False, (o, l)) : readDisk (o+l) fs

parse2 :: String -> ([File], EmptyMap)
parse2 s = takeWhile (/= '\n')
        >>> map toNumber
        >>> zip (cycle [True, False]) -- True is File, False is empty
        >>> readDisk 0
        >>> List.partition fst
        >>> join bimap (map snd)
        >>> first (zip [0..])
        >>> first List.reverse
        >>> second (filter (snd >>> (/= 0)))
        >>> second (List.sortOn snd)
        >>> second (List.groupBy (curry $ (snd *** snd) >>> uncurry (==)))
        >>> second (List.map (snd . head &&& map fst))
        >>> second (List.map (second Set.fromDistinctAscList))
        >>> second Map.fromDistinctAscList
        $ s

maybeMinimumBy :: (a -> a -> Ordering) -> [a] -> Maybe a
maybeMinimumBy _ [] = Nothing
maybeMinimumBy f as = Just $ List.minimumBy f as

fileChecksum fid fpos flen = fid * (fpos * flen + ((flen-1) * (flen-1) + (flen-1)) `div` 2)

type Checksum = Int
moveFilesAccumulate :: (Checksum, EmptyMap) -> File -> (Checksum, EmptyMap)
moveFilesAccumulate (check, spaces) (fid, (fpos, flen)) = do
        let bestFit = Map.map (Set.minView)
                >>> Map.toList
                >>> List.filter (fst >>> (>= flen))
                >>> List.filter (snd >>> Maybe.isJust)
                >>> List.map (second Maybe.fromJust) -- [(FileLength, (DiskPosition, Set DiskPosition))]
                >>> List.filter (snd >>> fst >>> (< fpos))
                >>> maybeMinimumBy (\ (_, (p, _)) (_, (p', _)) -> Ord.compare p p')
                $ spaces

        case bestFit of
                Nothing -> (check + fileChecksum fid fpos flen, spaces)
                Just (spaceLength, (spacePosition, remainingSet)) -> do
                        

                        -- remove the old empty entry by replacing the set
                        let updatedMap  = Map.update (const $! Just remainingSet) spaceLength spaces

                        -- add the remaining space, if any
                        let remainingSpace = spaceLength - flen
                        let remainingSpacePosition = spacePosition + flen
                        let updatedMap' = if remainingSpace == 0 then updatedMap else Map.insertWith (Set.union) remainingSpace (Set.singleton remainingSpacePosition) updatedMap

                        (check + fileChecksum fid spacePosition flen, updatedMap')

parse1 :: String -> UArray Int Int
parse1 s = UArray.listArray (0, sum lengthsOnly - 1) blocks
        where
                lengthsOnly = filter (/= '\n')
                        >>> map toNumber
                        $ s :: [Int]
                blocks = zip [0..]
                        >>> List.concatMap (\ (index, n) -> if index `mod` 2 == 0 then replicate n (index `div` 2) else replicate n (-1))
                        $ lengthsOnly :: [Int]

moveBlocksAccumulate :: Int -> Int -> UArray Int Int -> Int
moveBlocksAccumulate start stop array
        | start      == stop   = if startBlock == -1 then 0 else start * startBlock
        | start      >  stop   = 0
        | stopBlock  == -1     = moveBlocksAccumulate start (stop - 1) array
        | startBlock == -1     = movedChecksum + moveBlocksAccumulate (start + 1) (stop - 1) array
        | startBlock /= -1     = startChecksum + moveBlocksAccumulate (start + 1) stop array
        where
                startBlock    = array UArray.! start
                stopBlock     = array UArray.! stop
                movedChecksum = stopBlock * start
                startChecksum = startBlock * start

part1 a = moveBlocksAccumulate 0 arrayLength a
        where
                (_, arrayLength) = UArray.bounds a
part2 (files, spaces) = foldl moveFilesAccumulate (0, spaces)
        >>> fst
        $ files

main = getContents
        >>= print
        . (part1 . parse1 &&& part2 . parse2)

because of text limit and this code being slow, I put it in a topaz paste: [ link ]

you can also find this code in the Topaz link: [ link ]

def int_of_char(x):
    return ord(x) - ord('0')

# Represent content as tuples:
# ('Empty', size) or ('File', id, size)
def parse(line):
    arr = []
    for i in range(len(line)):
        c = int_of_char(line[i])
        if i % 2 == 0:
            arr.append(('File', i // 2, c))
        else:
            arr.append(('Empty', c))
    return arr

def int_sum(low, high):
    return (high - low + 1) * (high + low) // 2

def size(elem):
    t = elem[0]
    if t == 'Empty':
        return elem[1]
    else:
        return elem[2]

def part1(array):
    total = 0
    left = 0
    pos = 0
    right = len(array) - 1

    while left < right:
        if array[left][0] == 'File':
            # File
            _, fid, fsize = array[left]
            total += fid * int_sum(pos, pos + fsize - 1)
            pos += fsize
            left += 1
        else:
            # Empty
            _, esize = array[left]
            if array[right][0] == 'Empty':
                right -= 1
            else:
                # Right is File
                _, fid, fsize = array[right]
                if esize >= fsize:
                    array[left] = ('Empty', esize - fsize)
                    total += fid * int_sum(pos, pos + fsize - 1)
                    pos += fsize
                    right -= 1
                else:
                    array[right] = ('File', fid, fsize - esize)
                    total += fid * int_sum(pos, pos + esize - 1)
                    pos += esize
                    left += 1

    # If one element remains (left == right)
    if left == right and left < len(array):
        if array[left][0] == 'File':
            _, fid, fsize = array[left]
            total += fid * int_sum(pos, pos + fsize - 1)

    return total

def positions(arr):
    total = 0
    res = []
    for e in arr:
        res.append(total)
        total += size(e)
    return res

def array_fold_right_i(f, arr, acc):
    pos = len(arr) - 1
    for elt in reversed(arr):
        acc = f(elt, pos, acc)
        pos -= 1
    return acc

def part2(array):
    def find_empty(size_needed, max_pos, pos):
        while pos <= max_pos:
            if array[pos][0] == 'File':
                raise Exception("Unexpected: only empty at odd positions")
            # Empty
            _, esize = array[pos]
            if esize >= size_needed:
                array[pos] = ('Empty', esize - size_needed)
                return pos
            pos += 2
        return None

    emptys = [1 if i < 10 else None for i in range(10)]
    pos_arr = positions(array)

    def fold_fun(elt, i, total):
        if elt[0] == 'Empty':
            return total
        # File
        _, fid, fsize = elt
        init_pos = emptys[fsize]
        if init_pos is None:
            new_pos = pos_arr[i]
        else:
            opt = find_empty(fsize, i, init_pos)
            if opt is None:
                new_pos = pos_arr[i]
            else:
                new_pos = pos_arr[opt]
                pos_arr[opt] += fsize
                emptys[fsize] = opt
        return total + fid * int_sum(new_pos, new_pos + fsize - 1)

    return array_fold_right_i(fold_fun, array, 0)

def main():
    with open('largest_test', 'r') as f:
        line = f.read().replace('\r', '').replace('\n', '')
    arr = parse(line)
    arr_copy = arr[:]
    p1 = part1(arr_copy)
    print("Part 1 :", p1)
    p2 = part2(arr)
    print("Part 2 :", p2)

if __name__ == "__main__":
    main()

int[] layout = new int[0];
public void Input(IEnumerable<string> lines)
{
  layout = string.Join("", lines).ToCharArray().Select(c => int.Parse(c.ToString())).ToArray();
}

public void Part1()
{
  ushort?[] blocks = BuildBlockmap().ToArray();

  var it = 0;
  for (var i = blocks.Length - 1; i > it; i--)
  {
    if (blocks[i] == null)
      continue;

    while (it < blocks.Length && blocks[it] != null)
      ++it;

    if (it >= blocks.Length)
      break;

    (blocks[it], blocks[i]) = (blocks[i], null);
  }

  long checksum = 0;
  foreach (var part in blocks.OfType<ushort>().Select((b, i) => i * b))
    checksum += part;

  Console.WriteLine($"Checksum: {checksum}");
}

public void Part2()
{
  var sparse = BuildSparsemap().ToList();

  for (var i = sparse.Count - 1; i >= 0; i--)
  {
    if (sparse[i].Item1 == null)
      continue;

    for (var j = 0; j < i; ++j)
    {
      if (sparse[j].Item1 != null)
        continue;

      if (sparse[i].Item2 > sparse[j].Item2)
        continue;

      var size = sparse[j].Item2;
      size -= sparse[i].Item2;

      (sparse[j], sparse[i]) = (sparse[i], (null, sparse[i].Item2));

      if (i + 1 < sparse.Count && sparse[i + 1].Item1 == null)
      {
        sparse[i] = (null, (ushort)(sparse[i].Item2 + sparse[i + 1].Item2));
        sparse.RemoveAt(i + 1);
      }

      if (sparse[i - 1].Item1 == null)
      {
        sparse[i - 1] = (null, (ushort)(sparse[i - 1].Item2 + sparse[i].Item2));
        sparse.RemoveAt(i);
      }

      if (size > 0)
        sparse.Insert(j + 1, (null, size));

      j = i + 1;
    }
  }

  int ind = 0;
  long checksum = 0;
  foreach (var (val, cnt) in sparse)
    for (var i = 0; i < cnt; ++i)
    {
      checksum += (val ?? 0) * ind;
      ++ind;
    }

  Console.WriteLine($"Checksum: {checksum}");
}

IEnumerable<ushort?> BuildBlockmap()
{
  ushort blockit = 0;
  bool block = true;
  foreach (var value in layout)
  {
    for (int i = 0; i < value; ++i)
      yield return block ? blockit : null;
    if (block)
      blockit++;
    block = !block;
  }
}

IEnumerable<(ushort?, ushort)> BuildSparsemap()
{
  ushort blockit = 0;
  bool block = true;
  foreach (var value in layout)
  {
    if (block)
      yield return (blockit++, (ushort)value);
    else
      yield return (null, (ushort)value);
    block = !block;
  }
}

function readInput(inputFile::String)
	f = open(inputFile,"r"); diskMap::String = readline(f); close(f)
	disk::Vector{String} = []
	id::Int = 0
	for (i,c) in enumerate(diskMap)
		if i%2 != 0 #used space
			for j=1 : parse(Int,c)
				push!(disk,string(id))
			end
			id += 1
		else #free space
			for j=1 : parse(Int,c)
				push!(disk,".")
			end
		end
	end
	return disk
end

function getDiscBlocks(disk::Vector{String})::Vector{Vector{Int}}
	diskBlocks::Vector{Vector{Int}} = []
	currBlock::Int = parse(Int,disk[1]) #-1 for free space
	blockLength::Int = 0; blockStartIndex::Int = 0
	for (i,b) in enumerate(map(x->(x=="." ? -1 : parse(Int,x)),disk))
		if b == currBlock
			blockLength += 1
		else #b!=currBlock
			push!(diskBlocks,[currBlock,blockLength,blockStartIndex,i-2])
			currBlock = b
			blockLength = 1
			blockStartIndex = i-1 #start of next block
		end
	end
	push!(diskBlocks,[currBlock,blockLength,blockStartIndex,length(disk)-1])
	return diskBlocks
end

function compressDisk(disk::Vector{String})::Vector{Int} #part 1
	compressedDisk::Vector{Int} = []
	startPtr::Int=1; endPtr::Int=length(disk)
	while endPtr >= startPtr
		while endPtr>startPtr && disk[endPtr]=="."
			endPtr -= 1
		end
		while startPtr<endPtr && disk[startPtr]!="."
			push!(compressedDisk,parse(Int,disk[startPtr])) about AoC
			startPtr += 1
		end
		push!(compressedDisk,parse(Int,disk[endPtr]))
		startPtr+=1;endPtr-=1
	end
	return compressedDisk
end

function compressBlocks(diskBlocks::Vector{Vector{Int}})
	for i=length(diskBlocks) : -1 : 1 #go through all blocks, starting from end
		diskBlocks[i][1] == -1 ? continue : nothing
		for j=1 : i-1 #look for large enough empty space
			diskBlocks[j][1]!=-1 || diskBlocks[j][2]<diskBlocks[i][2] ? continue : nothing #skip occupied blocks and empty blocks that are too short
			diskBlocks[i][3] = diskBlocks[j][3] #set start index
			diskBlocks[i][4] = diskBlocks[j][3]+diskBlocks[i][2]-1 #set end index
			diskBlocks[j][3] += diskBlocks[i][2] #move start of empty block
			diskBlocks[j][2] -= diskBlocks[i][2] #adjust length of empty block
			break
		end
	end
	return diskBlocks
end

function calcChecksum(compressedDisk::Vector{Int})::Int
	checksum::Int = 0
	for (i,n) in enumerate(compressedDisk)
		checksum += n*(i-1)
	end
	return checksum
end

function calcChecksumBlocks(diskBlocks::Vector{Vector{Int}})::Int
	checksum::Int = 0
	for b in diskBlocks
		b[1]==-1 ? continue : nothing
		for i=b[3] : b[4]
			checksum += b[1]*i
		end
	end
	return checksum
end

disk::Vector{String} = readInput("input/day09Input")
@info "Part 1"
println("checksum: $(calcChecksum(compressDisk(disk)))")
@info "Part 2"
println("checksum: $(calcChecksumBlocks(compressBlocks(getDiscBlocks(disk)))")