-- MIT License, Copyright (c) 2022 Marvin Borner
module Binary
  ( toBinary
  , fromBinary
  , toBitString
  , fromBitString
  , fromJot
  ) where

import qualified Data.BitString                as Bit

import           Helper

toBinary :: Expression -> String
toBinary (Bruijn      x        ) = replicate (x + 1) '1' ++ "0"
toBinary (Abstraction e        ) = "00" ++ toBinary e
toBinary (Application exp1 exp2) = "01" ++ toBinary exp1 ++ toBinary exp2
toBinary _                       = invalidProgramState

fromBinary' :: String -> (Expression, String)
fromBinary' inp = case inp of
  '0' : '0' : rst -> let (e, es) = fromBinary' rst in (Abstraction e, es)
  '0' : '1' : rst ->
    let (exp1, rst1) = fromBinary' rst
        (exp2, rst2) = fromBinary' rst1
    in  (Application exp1 exp2, rst2)
  '1' : _ : rst -> binaryBruijn rst
  _             -> invalidProgramState
 where
  binaryBruijn rst =
    let idx = length (takeWhile (== '1') inp) - 1
    in  case rst of
          "" -> (Bruijn idx, "")
          _  -> (Bruijn idx, drop idx rst)

fromBinary :: String -> Expression
fromBinary = fst . fromBinary'

toBitString :: String -> Bit.BitString
toBitString = Bit.fromList . map
  (\case
    '0' -> False
    '1' -> True
    _   -> invalidProgramState
  )

fromBitString :: Bit.BitString -> String
fromBitString =
  map
      (\case
        False -> '0'
        True  -> '1'
      )
    . Bit.toList

---

fromJot :: String -> Expression
fromJot = worker . reverse
 where
  s = Function $ NormalFunction "s"
  k = Function $ NormalFunction "k"
  worker ('0' : xs) = Application (Application (worker xs) s) k
  worker ('1' : xs) = Application s (Application k (worker xs))
  worker _          = Abstraction (Bruijn 0)