module DataTypeTool.Parsing.ParserOld where

import qualified Antelude.List              as List
import qualified Antelude.List.NonEmpty     as NE
import qualified Antelude.Maybe             as Maybe
import           Antelude.Monad
    ( fail
    , mapM
    , mapM_
    , replicateM_
    , void
    )
import qualified Antelude.Monad             as Monad
import           Antelude.String            ( fromString )

import qualified Data.List                  as UnsafeList ( head )
import           Data.Map.Strict            ( (!) )
import qualified Data.Map.Strict            as Map
import qualified Data.Set                   as Set
import qualified Data.Text                  as Text

import qualified DataTypeTool.Common.Utils  as Com
import           DataTypeTool.Config.Config
    ( LangConfiguration (EmptyConfig)
    , targets
    )
import qualified DataTypeTool.Config.Config as Config
import qualified DataTypeTool.Parsing.Types as PT

import qualified System.Directory           as Dir
import qualified System.Exit                as Exit ( die )

import qualified Text.Megaparsec            as MP
import qualified Text.Megaparsec.Char       as MPC
import qualified Text.Megaparsec.Char.Lexer as MPCL
import qualified Text.Megaparsec.Debug      as MPD

type Parser = MP.Parsec Void String

type Spacer = Parser ()

runParsers
    :: FilePath
    -> Config.Config
    -> IO
        ( List
            ( FilePath
            , Either (MP.ParseErrorBundle String Void) PT.DataTypeFile
            )
        )
runParsers typeFileDirectory config =
    let runReal
            :: List (FilePath, String)
            -> IO
                ( List
                    ( FilePath
                    , Either (MP.ParseErrorBundle String Void) PT.DataTypeFile
                    )
                )
        runReal =
            List.map
                ( \(pth, str) ->
                    ( List.stripPrefix typeFileDirectory pth
                        |> Maybe.withDefault pth
                    , ( case List.last str of
                            Just '\n' -> str
                            _         -> str <> "\n"
                      )
                        |> MP.parse (parser (Config.spacing config)) pth
                    )
                )
                .> return

        runTest
            :: List (FilePath, String)
            -> IO
                ( List
                    ( FilePath
                    , Either (MP.ParseErrorBundle String Void) PT.DataTypeFile
                    )
                )
        runTest lst =
            Monad.mapM_
                ( \(pth, str) ->
                    MP.parseTest (parser (Config.spacing config)) str
                )
                lst
                >> return []
    in  case NE.head config.targets of
            EmptyConfig ->
                Exit.die "No targets defined. Please set up languages to generate types for."
            _ ->
                Com.recurseDirectory typeFileDirectory
                    -- >>= runTest
                    >>= runReal


parser :: Config.Spacing -> Parser PT.DataTypeFile
parser spacing =
    let spacer :: Parser ()
        spacer = case spacing of
            Config.Tabs    -> tab
            Config.Spaces2 -> space2
            Config.Spaces3 -> space3
            Config.Spaces4 -> space4

        spacePos :: Int
        spacePos = case spacing of
            Config.Tabs    -> 4
            Config.Spaces2 -> 2
            Config.Spaces3 -> 3
            Config.Spaces4 -> 4

        dataTypeParser :: Parser PT.DataTypes
        dataTypeParser =
            MPCL.nonIndented
                spaceAny
                ( MP.choice
                    [ MPCL.indentBlock spaceAny <| do
                        voidString "alias "
                        name <- nameParser
                        MPC.space
                        colon
                        return
                            ( MPCL.IndentMany
                                (Just (MP.mkPos <| 1 + spacePos))
                                (aliasMapper name <. Map.toList <. Map.fromList)
                                aliasParser
                            )
                    , MPCL.indentBlock spaceAny <| do
                        voidString "enum "
                        name <- nameParser
                        MPC.space
                        colon
                        return
                            ( MPCL.IndentMany
                                (Just (MP.mkPos <| 1 + spacePos))
                                (enumMapper name <. Map.toList <. Map.fromList)
                                enumParser
                            )
                    , MPCL.indentBlock spaceAny <| do
                        voidString "model "
                        name <- nameParser
                        MPC.space
                        colon
                        return
                            ( MPCL.IndentMany
                                (Just (MP.mkPos <| 1 + spacePos))
                                (modelMapper name <. Map.toList <. Map.fromList)
                                modelParser
                            )
                    , MPCL.indentBlock spaceAny <| do
                        voidString "constant "
                        name <- nameParser
                        MPC.space
                        colon
                        return
                            ( MPCL.IndentMany
                                (Just (MP.mkPos <| 1 + spacePos))
                                (constantMapper name <. Map.toList <. Map.fromList)
                                constantParser
                            )
                    ]
                )

        aliasMapper :: Text -> [(String, PT.AliasParams)] -> Parser PT.DataTypes
        aliasMapper name map =
            let meta :: Maybe PT.MetaField
                meta =
                    ( List.lookup "meta" map
                        |> \case
                            Just (PT.AliasMeta m) -> m
                            _ -> Nothing
                    )

                type_ :: Maybe PT.Types
                type_ =
                    ( List.lookup "type" map
                        |> \case
                            Just (PT.AliasType t) -> Just t
                            _ -> Nothing
                    )
            in  case type_ of
                    Just t -> return <| PT.Alias name meta t
                    _ -> fail "Insufficient parameters passed to alias type"

        aliasParser :: Parser (String, PT.AliasParams)
        aliasParser =
            MPCL.lexeme spacer <|
                MP.choice
                    [ MPCL.indentBlock spaceAny <| do
                        voidString "meta:"
                        indentWrapper
                            "meta"
                            (MP.mkPos <| 1 + (spacePos * 2))
                            (PT.AliasMeta <. metaMapper <. Map.toList <. Map.fromList)
                            metaParser
                    , MPCL.indentBlock spaceAny <| do
                        voidString "type:"
                        indentWrapper
                            "type"
                            (MP.mkPos <| 1 + (spacePos * 2))
                            (PT.AliasType <. UnsafeList.head)
                            typeParser
                    ]

        enumMapper :: Text -> [(String, PT.EnumParams)] -> Parser PT.DataTypes
        enumMapper name map =
            let meta :: Maybe PT.MetaField
                meta =
                    ( List.lookup "meta" map
                        |> \case
                            Just (PT.EnumMeta m) -> m
                            _ -> Nothing
                    )

                members :: Maybe [PT.Values]
                members =
                    ( List.lookup "members" map
                        |> \case
                            Just (PT.EnumMembers e) -> Just e
                            _ -> Nothing
                    )
            in  case members of
                    Just m -> return <| PT.Enum name meta m
                    _      -> fail "Insufficient parameters passed to enum type"

        enumParser :: Parser (String, PT.EnumParams)
        enumParser =
            MPCL.lexeme spacer <|
                MP.choice
                    [ MPCL.indentBlock spaceAny <| do
                        voidString "meta:"
                        indentWrapper
                            "meta"
                            (MP.mkPos <| 1 + (spacePos * 2))
                            (PT.EnumMeta <. metaMapper <. Map.toList <. Map.fromList)
                            metaParser
                    , MPCL.indentBlock spaceAny <| do
                        voidString "members:"
                        indentWrapper
                            "members"
                            (MP.mkPos <| 1 + (spacePos * 2))
                            PT.EnumMembers
                            valueParser
                    ]

        modelMapper :: Text -> [(String, PT.ModelParams)] -> Parser PT.DataTypes
        modelMapper name map =
            let meta :: Maybe PT.MetaField
                meta =
                    ( List.lookup "meta" map
                        |> \case
                            Just (PT.ModelMeta m) -> m
                            _ -> Nothing
                    )

                fields :: Maybe [PT.ModelField]
                fields =
                    ( List.lookup "fields" map
                        |> \case
                            Just (PT.ModelFields f) -> Just f
                            _ -> Nothing
                    )
            in  case fields of
                    Just f -> return <| PT.Model name meta f
                    _ -> fail "Insufficient parameters passed to model type"

        modelParser :: Parser (String, PT.ModelParams)
        modelParser =
            MPCL.lexeme spacer <|
                MP.choice
                    [ MPCL.indentBlock spaceAny <| do
                        voidString "meta:"
                        indentWrapper
                            "meta"
                            (MP.mkPos <| 1 + (spacePos * 2))
                            (PT.ModelMeta <. metaMapper <. Map.toList <. Map.fromList)
                            metaParser
                    , MPCL.indentBlock spaceAny <| do
                        voidString "fields:"
                        indentWrapper
                            "fields"
                            (MP.mkPos <| 1 + (spacePos * 2))
                            PT.ModelFields
                            modelFieldsParser
                    ]

        modelFieldsParser :: Parser PT.ModelField
        modelFieldsParser =
            MPCL.lexeme spacer <|
                MPCL.indentBlock spaceAny <|
                    do
                        voidString "field "
                        name <- nameParser
                        MPC.space
                        colon
                        return
                            ( MPCL.IndentMany
                                (Just <| (MP.mkPos <| 1 + (spacePos * 3)))
                                (return <. fieldMapper name)
                                fieldParser
                            )

        fieldMapper :: Text -> [PT.Types] -> PT.ModelField
        fieldMapper name types =
            PT.ModelField name (UnsafeList.head types)

        fieldParser :: Parser PT.Types
        fieldParser =
            MPCL.lexeme spacer <|
                MPCL.indentBlock spaceAny <|
                    do
                        voidString "type:"
                        return
                            ( MPCL.IndentMany
                                (Just <| (MP.mkPos <| 1 + (spacePos * 4)))
                                (return <. UnsafeList.head)
                                typeParser
                            )

        constantMapper :: Text -> [(String, PT.ConstantParams)] -> Parser PT.DataTypes
        constantMapper name map =
            let meta :: Maybe PT.MetaField
                meta =
                    ( List.lookup "meta" map
                        |> \case
                            Just (PT.ConstantMeta m) -> m
                            _ -> Nothing
                    )

                type_ :: Maybe PT.Types
                type_ =
                    ( List.lookup "type" map
                        |> \case
                            Just (PT.ConstantType t) -> Just t
                            _ -> Nothing
                    )

                value :: Maybe PT.Values
                value =
                    ( List.lookup "value" map
                        |> \case
                            Just (PT.ConstantValue v) -> Just v
                            _ -> Nothing
                    )
            in  case (type_, value) of
                    (Just t, Just v) -> return <| PT.Constant name meta t v
                    _ -> fail "Insufficient parameters passed to constant type"

        constantParser :: Parser (String, PT.ConstantParams)
        constantParser =
            MPCL.lexeme spacer <|
                MP.choice
                    [ MPCL.indentBlock spaceAny <| do
                        voidString "meta:"
                        indentWrapper
                            "meta"
                            (MP.mkPos <| 1 + (spacePos * 2))
                            (PT.ConstantMeta <. metaMapper <. Map.toList <. Map.fromList)
                            metaParser
                    , MPCL.indentBlock spaceAny <| do
                        voidString "type:"
                        indentWrapper
                            "type"
                            (MP.mkPos <| 1 + (spacePos * 2))
                            (PT.ConstantType <. UnsafeList.head)
                            typeParser
                    , MPCL.indentBlock spaceAny <| do
                        voidString "value:"
                        indentWrapper
                            "value"
                            (MP.mkPos <| 1 + (spacePos * 2))
                            (PT.ConstantValue <. UnsafeList.head)
                            valueParser
                    ]

        metaMapper :: [(String, PT.MetaParams)] -> Maybe PT.MetaField
        metaMapper map =
            let doc :: Maybe Text
                doc =
                    ( List.lookup "doc" map
                        |> \case
                            Just (PT.MetaDoc d) -> d
                            _ -> Nothing
                    )

                ref :: Maybe [(FilePath, [PT.Types])]
                ref =
                    ( List.lookup "ref" map
                        |> \case
                            Just (PT.MetaRef r) -> r
                            _ -> Nothing
                    )

                lang :: Maybe [Text]
                lang =
                    ( List.lookup "lang" map
                        |> \case
                            Just (PT.MetaLang l) -> l
                            _ -> Nothing
                    )
            in  case (doc, ref, lang) of
                    (Nothing, Nothing, Nothing) -> fail "No parameters passed to meta field, but a meta field was opened."
                    _ -> return <| PT.MetaField doc ref lang

        metaParser :: Parser (String, PT.MetaParams)
        metaParser =
            MPCL.lexeme spacer <|
                MP.choice
                    [ MPCL.indentBlock spaceAny <| do
                        voidString "doc:"
                        indentWrapper
                            "doc"
                            (MP.mkPos <| 1 + (spacePos * 3))
                            (PT.MetaDoc <. docMapper)
                            docParser
                    , MPCL.indentBlock spaceAny <| do
                        voidString "ref:"
                        indentWrapper
                            "ref"
                            (MP.mkPos <| 1 + (spacePos * 3))
                            (PT.MetaRef <. Just)
                            refParser
                    , MPCL.indentBlock spaceAny <| do
                        voidString "lang:"
                        indentWrapper
                            "lang"
                            (MP.mkPos <| 1 + (spacePos * 3))
                            (PT.MetaLang <. Just)
                            langParser
                    ]

        docMapper :: [Text] -> Maybe Text
        docMapper docLines = Just <| List.foldl (\a b -> a <> Text.pack "\n" <> b) (Text.pack "") docLines

        docParser :: Parser Text
        docParser =
            MPCL.lexeme spacer <|
                MP.manyTill MPCL.charLiteral eol
                    >>= return <. Text.pack

        refParser :: Parser (FilePath, [PT.Types])
        refParser =
            MPCL.lexeme spacer <|
                do
                    path <- pathParser
                    colon
                    types_ <- MP.sepBy1 definedTypeParser colon
                    return <|
                        ( path
                        , types_
                        )

        langParser :: Parser Text
        langParser = langLangParser

        langLangParser :: Parser Text
        langLangParser =
            MPCL.lexeme spacer <| do
                lang <-
                    MP.choice
                        [ MPC.string "haskell"
                        , MPC.string "python"
                        , MPC.string "elm"
                        , MPC.string "gleam"
                        ]
                        >>= return <. Text.pack
                eol
                return lang

        typeParser :: Parser PT.Types
        typeParser =
            let type_ :: Parser PT.Types
                type_ =
                    MP.choice
                        [ PT.DTTStr <$ MPC.string "Str"
                        , PT.DTTInt <$ MPC.string "Int"
                        , PT.DTTFloat <$ MPC.string "Float"
                        , PT.DTTBool <$ MPC.string "Bool"
                        , do
                            voidString "Dict "
                            PT.DTTDict <$> typeParser
                        , do
                            voidString "List "
                            PT.DTTList <$> typeParser
                        , do
                            voidString "Nullable "
                            PT.DTTNullable <$> typeParser
                        , do
                            voidString "Set "
                            PT.DTTSet <$> typeParser
                        , do
                            voidString "Tuple2"
                            PT.DTTPair
                                <$> do
                                    MPC.char ' '
                                    typeParser
                                <*> do
                                    MPC.char ' '
                                    typeParser
                        , do
                            voidString "Tuple3"
                            PT.DTTTrio
                                <$> do
                                    MPC.char ' '
                                    typeParser
                                <*> do
                                    MPC.char ' '
                                    typeParser
                                <*> do
                                    MPC.char ' '
                                    typeParser
                        , do
                            voidString "Tuple4"
                            PT.DTTQuad
                                <$> do
                                    MPC.char ' '
                                    typeParser
                                <*> do
                                    MPC.char ' '
                                    typeParser
                                <*> do
                                    MPC.char ' '
                                    typeParser
                                <*> do
                                    MPC.char ' '
                                    typeParser
                        , do
                            voidString "Tuple5"
                            PT.DTTQuint
                                <$> do
                                    MPC.char ' '
                                    typeParser
                                <*> do
                                    MPC.char ' '
                                    typeParser
                                <*> do
                                    MPC.char ' '
                                    typeParser
                                <*> do
                                    MPC.char ' '
                                    typeParser
                                <*> do
                                    MPC.char ' '
                                    typeParser
                        , definedTypeParser
                        ]
            in  ( do
                    MPC.char '('
                    spaceAny
                    t <- type_
                    spaceAny
                    MPC.char ')'
                    return t
                )
                    <|> type_

        valueParser :: Parser PT.Values
        valueParser =
            let val =
                    MP.choice
                        [ MPC.char '"'
                            >> MP.manyTill MPCL.charLiteral (MPC.char '"')
                            >>= return <. PT.VStr
                        , ( MPCL.signed spaceAny <|
                                MPCL.lexeme spacer <|
                                    MPCL.decimal
                          )
                            >>= return <. PT.VInt
                        , ( MPCL.signed spaceAny <|
                                MPCL.lexeme spacer <|
                                    MPCL.float
                          )
                            >>= return <. PT.VFloat
                        , MP.choice
                            [ PT.VBool True <$ MPC.string "True"
                            , PT.VBool False <$ MPC.string "False"
                            ]
                        , MPCL.lexeme spaceAny <|
                            voidString "Dict"
                                >> spaceAny
                                >> MP.between
                                    (MPCL.symbol spaceAny "[")
                                    (MPCL.symbol spaceAny "]")
                                    ( MP.sepBy
                                        ( MP.between
                                            (MPCL.symbol spaceAny "{")
                                            (MPCL.symbol spaceAny "}")
                                            ( do
                                                k <-
                                                    MPC.char '"'
                                                        >> MP.manyTill MPCL.charLiteral (MPC.char '"')
                                                voidString ", "
                                                v <- valueParser
                                                return (k, v)
                                            )
                                        )
                                        (voidString ", ")
                                    )
                                >>= return <. PT.VDict <. Map.fromList
                        , MPCL.lexeme spaceAny <|
                            voidString "List"
                                >> spaceAny
                                >> MP.between
                                    (MPCL.symbol spaceAny "[")
                                    (MPCL.symbol spaceAny "]")
                                    (MP.sepBy valueParser (MPC.char ','))
                                >>= return <. PT.VList
                        , MP.choice
                            [ do
                                voidString "NotNull "
                                jVal <- valueParser
                                return <| PT.VNullable <| Just jVal
                            , PT.VNullable Nothing <$ voidString "Null"
                            ]
                        , MPCL.lexeme spaceAny <|
                            voidString "Set"
                                >> spaceAny
                                >> MP.between
                                    (MPCL.symbol spaceAny "[")
                                    (MPCL.symbol spaceAny "]")
                                    ( MP.sepBy valueParser (MPC.char ',')
                                        >>= return <. PT.VSet <. Set.fromList
                                    )
                        , MPCL.lexeme spaceAny <|
                            voidString "Tuple2"
                                >> spaceAny
                                >> MP.between
                                    (MPCL.symbol spaceAny "{")
                                    (MPCL.symbol spaceAny "}")
                                    ( do
                                        a <- valueParser
                                        b <- valueParser
                                        return (a, b)
                                    )
                                >>= return <. PT.VTuple2
                        , MPCL.lexeme spaceAny <|
                            voidString "Tuple3"
                                >> spaceAny
                                >> MP.between
                                    (MPCL.symbol spaceAny "{")
                                    (MPCL.symbol spaceAny "}")
                                    ( do
                                        a <- valueParser
                                        b <- valueParser
                                        c <- valueParser
                                        return (a, b, c)
                                    )
                                >>= return <. PT.VTuple3
                        , MPCL.lexeme spaceAny <|
                            voidString "Tuple4"
                                >> spaceAny
                                >> MP.between
                                    (MPCL.symbol spaceAny "{")
                                    (MPCL.symbol spaceAny "}")
                                    ( do
                                        a <- valueParser
                                        b <- valueParser
                                        c <- valueParser
                                        d <- valueParser
                                        return (a, b, c, d)
                                    )
                                >>= return <. PT.VTuple4
                        , MPCL.lexeme spaceAny <|
                            voidString "Tuple5"
                                >> spaceAny
                                >> MP.between
                                    (MPCL.symbol spaceAny "{")
                                    (MPCL.symbol spaceAny "}")
                                    ( do
                                        a <- valueParser
                                        b <- valueParser
                                        c <- valueParser
                                        d <- valueParser
                                        e <- valueParser
                                        return (a, b, c, d, e)
                                    )
                                >>= return <. PT.VTuple5
                        , MPCL.lexeme spaceAny <|
                            nameParser
                                >>= return <. PT.OtherValue
                        ]
            in  MP.between
                    (MPCL.symbol spaceAny "(")
                    (MPCL.symbol spaceAny ")")
                    val
                    <|> val

        nameParser :: Parser Text
        nameParser =
            MPCL.lexeme spacer <| do
                first <- MPC.upperChar
                rest <-
                    MP.many
                        ( MP.choice
                            [ MPC.alphaNumChar
                            , MPC.char '_'
                            ]
                        )
                return <| Text.pack (first : rest)

        -- A specific packed version of nameParser
        definedTypeParser :: Parser PT.Types -- Specifically (DefinedDataType Text)
        definedTypeParser =
            MPCL.lexeme spacer <| do
                first <- MPC.upperChar
                rest <-
                    MP.many
                        ( MP.choice
                            [ MPC.alphaNumChar
                            , MPC.char '_'
                            ]
                        )
                return <| PT.DefinedDataType <| Text.pack (first : rest)

        pathParser :: Parser FilePath
        pathParser =
            MPCL.lexeme spacer <|
                MP.many
                    ( MP.choice
                        [ MPC.alphaNumChar
                        , MPC.char '_'
                        , MPC.char '-'
                        , MPC.char '/'
                        , MPC.char '\\'
                        ]
                    )

        pathAsTextParser :: Parser Text
        pathAsTextParser =
            MPCL.lexeme spacer <|
                MP.many
                    ( MP.choice
                        [ MPC.alphaNumChar
                        , MPC.char '_'
                        , MPC.char '-'
                        , MPC.char '/'
                        , MPC.char '\\'
                        ]
                    )
                    >>= return <. Text.pack

        anyNameParser :: Parser Text
        anyNameParser =
            MPCL.lexeme spacer <| do
                MP.many
                    ( MP.choice
                        [ MPC.alphaNumChar
                        , MPC.char '_'
                        ]
                    )
                    >>= return <. Text.pack

        indentWrapper
            :: String
            -> MP.Pos
            -> ([a] -> c)
            -> Parser a
            -> Parser
                ( MPCL.IndentOpt
                    Parser
                    (String, c)
                    a
                )
        indentWrapper field pos wrapperMapper parser =
            return
                ( MPCL.IndentMany
                    (Just pos)
                    ( \a ->
                        return (field, wrapperMapper a)
                    )
                    parser
                )
    in  MP.someTill
            dataTypeParser
            MP.eof

lineComment :: Parser ()
lineComment =
    MPCL.skipLineComment "#"

space2 :: Parser ()
space2 =
    MPCL.space
        (replicateM_ 2 (MPC.char ' '))
        lineComment
        MP.empty

space3 :: Parser ()
space3 =
    MPCL.space
        (replicateM_ 3 (MPC.char ' '))
        lineComment
        MP.empty

space4 :: Parser ()
space4 =
    MPCL.space
        (replicateM_ 4 (MPC.char ' '))
        lineComment
        MP.empty

tab :: Parser ()
tab =
    MPCL.space
        (void <| MPC.char '\t')
        lineComment
        MP.empty

spaceAny :: Parser ()
spaceAny =
    MPCL.space
        MPC.space1
        lineComment
        MP.empty

eol :: Parser ()
eol = void MPC.eol

colon :: Parser ()
colon = void (MPC.char ':')

voidString :: String -> Parser ()
voidString str = void (MPC.string str)

nullParser :: Parser ()
nullParser = return ()