content: -- MIT License, Copyright (c) 2022 Marvin Borner
  module Conversion where
  
  import qualified Data.BitString                as Bit
  import qualified Data.ByteString.Lazy          as Byte
  import qualified Data.ByteString.Lazy.Char8    as C
  import           Data.Char                      ( chr )
  import           GHC.Real                       ( denominator
                                                  , numerator
                                                  )
  import           Numeric                        ( showFFloatAlt )
  
  import           Helper
  
  listify :: [Expression] -> Expression
  listify [] = Abstraction (Abstraction (Bruijn 0))
  listify (e : es) =
    Abstraction (Application (Application (Bruijn 0) e) (listify es))
  
  binarify :: [Expression] -> Expression
  binarify = foldr Application (Bruijn 2)
  
  encodeByte :: [Bool] -> Expression
  encodeByte bits = Abstraction $ Abstraction $ Abstraction $ binarify
    (map encodeBit bits)
   where
    encodeBit False = Bruijn 0
    encodeBit True  = Bruijn 1
  
  -- TODO: There must be a better way to do this :D
  encodeBytes :: Byte.ByteString -> Expression
  encodeBytes bytes = listify $ map
    (encodeByte . Bit.toList . Bit.bitStringLazy . Byte.pack . (: []))
    (Byte.unpack bytes)
  
  stringToExpression :: String -> Expression
  stringToExpression = encodeBytes . C.pack
  
  charToExpression :: Char -> Expression
  charToExpression ch = encodeByte $ Bit.toList $ Bit.bitStringLazy $ C.pack [ch]
  
  encodeStdin :: IO Expression
  encodeStdin = encodeBytes <$> Byte.getContents
  
  unlistify :: Expression -> Maybe [Expression]
  unlistify (Abstraction (Abstraction (Bruijn 0))) = Just []
  unlistify (Abstraction (Application (Application (Bruijn 0) e) es)) =
    (:) <$> Just e <*> unlistify es
  unlistify _ = Nothing
  
  unpairify :: Expression -> Maybe [Expression]
  unpairify (Abstraction (Application (Application (Bruijn 0) e1) e2)) =
    Just (e1 : [e2])
  unpairify _ = Nothing
  
  decodeByte :: Expression -> Maybe [Bool]
  decodeByte (Abstraction (Abstraction (Abstraction es))) = decodeByte es
  decodeByte (Application (Bruijn 0) es) = (:) <$> Just False <*> decodeByte es
  decodeByte (Application (Bruijn 1) es) = (:) <$> Just True <*> decodeByte es
  decodeByte (Bruijn 2                 ) = Just []
  decodeByte _                           = Nothing
  
  decodeStdout :: Expression -> Maybe String
  decodeStdout e = do
    u <- unlistify e
    pure $ C.unpack $ Byte.concat $ map
      (\m -> case decodeByte m of
        Just b  -> Bit.realizeBitStringLazy $ Bit.fromList b
        Nothing -> Byte.empty
      )
      u
  
  ---
  
  floatToRational :: Rational -> Expression
  floatToRational f = Abstraction
    (Application (Application (Bruijn 0) (decimalToTernary p))
                 (decimalToTernary $ q - 1)
    )
   where
    p = numerator f
    q = denominator f
  
  floatToReal :: Rational -> Expression
  floatToReal = Abstraction . floatToRational
  
  floatToComplex :: Rational -> Rational -> Expression
  floatToComplex r i = Abstraction $ Abstraction $ Application
    (Application (Bruijn 0) (Application (floatToReal r) (Bruijn 1)))
    (Application (floatToReal i) (Bruijn 1))
  
  -- Dec to Bal3 in Bruijn encoding: reversed application with 0=>0; 1=>1; T=>2; end=>3
  -- e.g. 0=0=[[[[3]]]]; 2=1T=[[[[2 (1 3)]]]] -5=T11=[[[[1 (1 (2 3))]]]]
  decimalToTernary :: Integer -> Expression
  decimalToTernary n =
    Abstraction $ Abstraction $ Abstraction $ Abstraction $ gen n
   where
    gen 0 = Bruijn 3
    gen n' =
      Application (Bruijn $ fromIntegral $ mod n' 3) (gen $ div (n' + 1) 3)
  
  -- Decimal to binary encoding
  decimalToBinary :: Integer -> Expression
  decimalToBinary n | n < 0     = decimalToBinary 0
                    | otherwise = Abstraction $ Abstraction $ Abstraction $ gen n
   where
    gen 0  = Bruijn 2
    gen n' = Application (Bruijn $ fromIntegral $ mod n' 2) (gen $ div n' 2)
  
  -- Decimal to unary (church) encoding
  decimalToUnary :: Integer -> Expression
  decimalToUnary n | n < 0     = decimalToUnary 0
                   | otherwise = Abstraction $ Abstraction $ gen n
   where
    gen 0  = Bruijn 0
    gen n' = Application (Bruijn 1) (gen (n' - 1))
  
  -- Decimal to de Bruijn encoding
  decimalToDeBruijn :: Integer -> Expression
  decimalToDeBruijn n | n < 0     = decimalToDeBruijn 0
                      | otherwise = gen n
   where
    gen 0  = Abstraction $ Bruijn $ fromInteger n
    gen n' = Abstraction $ gen (n' - 1)
  
  unaryToDecimal :: Expression -> Maybe String
  unaryToDecimal e = (<> "u") . show <$> unaryToDecimal' e
  
  unaryToDecimal' :: Expression -> Maybe Integer
  unaryToDecimal' e = do
    res <- resolve e
    return (sum res :: Integer)
   where
    multiplier (Bruijn 1) = Just 1
    multiplier _          = Nothing
    resolve' (Bruijn 0) = Just []
    resolve' (Application x@(Bruijn _) (Bruijn 0)) =
      (:) <$> multiplier x <*> Just []
    resolve' (Application x@(Bruijn _) xs@(Application _ _)) =
      (:) <$> multiplier x <*> resolve' xs
    resolve' _ = Nothing
    resolve (Abstraction (Abstraction n)) = resolve' n
    resolve _                             = Nothing
  
  binaryToChar :: Expression -> Maybe String
  binaryToChar e = show <$> binaryToChar' e
  
  binaryToChar' :: Expression -> Maybe Char
  binaryToChar' e = do
    n <- binaryToDecimal e
    if n > 31 && n < 127 || n == 10 then Just $ chr $ fromIntegral n else Nothing
  
  binaryToString :: Expression -> Maybe String
  binaryToString e = (<> "b") . show <$> binaryToDecimal e
  
  binaryToDecimal :: Expression -> Maybe Integer
  binaryToDecimal e = do
    res <- resolve e
    return (sum $ zipWith (*) res (iterate (* 2) 1) :: Integer)
   where
    multiplier (Bruijn 0) = Just 0
    multiplier (Bruijn 1) = Just 1
    multiplier _          = Nothing
    resolve' (Bruijn 2) = Just []
    resolve' (Application x@(Bruijn _) (Bruijn 2)) =
      (:) <$> multiplier x <*> Just []
    resolve' (Application x@(Bruijn _) xs@(Application _ _)) =
      (:) <$> multiplier x <*> resolve' xs
    resolve' _ = Nothing
    resolve (Abstraction (Abstraction (Abstraction n))) = resolve' n
    resolve _ = Nothing
  
  ternaryToString :: Expression -> Maybe String
  ternaryToString e = (<> "t") . show <$> ternaryToDecimal e
  
  ternaryToDecimal :: Expression -> Maybe Integer
  ternaryToDecimal e = do
    res <- resolve e
    return (sum $ zipWith (*) res (iterate (* 3) 1) :: Integer)
   where
    multiplier (Bruijn 0) = Just 0
    multiplier (Bruijn 1) = Just 1
    multiplier (Bruijn 2) = Just (-1)
    multiplier _          = Nothing
    resolve' (Bruijn 3) = Just []
    resolve' (Application x@(Bruijn _) (Bruijn 3)) =
      (:) <$> multiplier x <*> Just []
    resolve' (Application x@(Bruijn _) xs@(Application _ _)) =
      (:) <$> multiplier x <*> resolve' xs
    resolve' _ = Nothing
    resolve (Abstraction (Abstraction (Abstraction (Abstraction n)))) =
      resolve' n
    resolve _ = Nothing
  
  rationalToString :: Expression -> Maybe String
  rationalToString (Abstraction (Application (Application (Bruijn 0) a) b)) = do
    n <- ternaryToDecimal a
    d <- ternaryToDecimal b
    Just
      $  show n
      <> "/"
      <> show (d + 1)
      <> " (approx. "
      <> showFFloatAlt (Just 8)
                       (fromIntegral n / fromIntegral (d + 1) :: Double)
                       ""
      <> ")"
  rationalToString _ = Nothing
  
  realToString :: Expression -> Maybe String
  realToString (Abstraction e) = rationalToString e
  realToString _               = Nothing
  
  complexToString :: Expression -> Maybe String
  complexToString (Abstraction (Abstraction (Application (Application (Bruijn 0) (Abstraction (Application (Application (Bruijn 0) lr) rr))) (Abstraction (Application (Application (Bruijn 0) li) ri)))))
    = do
      nlr <- ternaryToDecimal lr
      drr <- ternaryToDecimal rr
      nli <- ternaryToDecimal li
      dri <- ternaryToDecimal ri
      Just
        $  show nlr
        <> "/"
        <> show (drr + 1)
        <> " + "
        <> show nli
        <> "/"
        <> show (dri + 1)
        <> "i"
        <> " (approx. "
        <> showFFloatAlt (Just 8)
                         (fromIntegral nlr / fromIntegral (drr + 1) :: Double)
                         ""
        <> "+"
        <> showFFloatAlt (Just 8)
                         (fromIntegral nli / fromIntegral (dri + 1) :: Double)
                         ""
        <> "i)"
  complexToString _ = Nothing
  