{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# OPTIONS_GHC -Wno-x-partial #-}

module T17722B (setHelper) where

import Data.List.NonEmpty (NonEmpty (..))
import Data.Sequence (Seq)
import Data.Text (Text)
import Data.Void (Void)
import qualified Data.Foldable
import qualified Data.List
import qualified Data.Sequence
import qualified Data.Text

import T17722A

data Expr s a
  = App (Expr s a) (Expr s a)
  | List
  | ListLit (Maybe (Expr s a)) (Seq (Expr s a))

data Src

type Extractor s a = Validation (ExtractErrors s a)

typeError :: Expr s a -> Expr s a -> Extractor s a b
typeError expected actual =
    Failure . ExtractErrors . pure . TypeMismatch $ InvalidDecoder expected actual

extractError :: Text -> Extractor s a b
extractError = Failure . ExtractErrors . pure . ExtractError

newtype ExtractErrors s a = ExtractErrors (NonEmpty (ExtractError s a))
  deriving Semigroup

data ExtractError s a =
    TypeMismatch (InvalidDecoder s a)
  | ExtractError Text

data InvalidDecoder s a = InvalidDecoder (Expr s a) (Expr s a)

data Decoder a = Decoder
    (Expr Src Void -> Extractor Src Void a)
    (Expr Src Void)

setHelper :: (Eq a, Foldable t, Show a)
          => (t a -> Int)
          -> ([a] -> t a)
          -> Decoder a
          -> Decoder (t a)
setHelper size toSet (Decoder extractIn expectedIn) = Decoder extractOut expectedOut
  where
    extractOut (ListLit _ es) = case traverse extractIn es of
        Success vSeq
            | sameSize               -> Success vSet
            | otherwise              -> extractError err
          where
            vList = Data.Foldable.toList vSeq
            vSet = toSet vList
            sameSize = size vSet == Data.Sequence.length vSeq
            duplicates = vList Data.List.\\ Data.Foldable.toList vSet
            err | length duplicates == 1 =
                     "One duplicate element in the list: "
                     <> (Data.Text.pack $ show $ head duplicates)
                | otherwise              = Data.Text.pack $ unwords
                     [ show $ length duplicates
                     , "duplicates were found in the list, including"
                     , show $ head duplicates
                     ]
        Failure f -> Failure f
    extractOut expr = typeError expectedOut expr

    expectedOut = App List expectedIn