    {-# LANGUAGE PatternGuards #-}

    module Data.Derive.DSL.Derive(derive) where

    import Data.Derive.DSL.HSE
    import Data.Derive.DSL.DSL
    import Data.Derive.DSL.Apply
    import Data.List
    import Data.Char
    import Data.Maybe

    data Guess = Guess DSL
               | GuessFld Int DSL
               | GuessCtr Int Bool DSL  -- 0 based index, does it mention CtorName
                 deriving Show

    ctrNames = map ctorName $ dataCtors sample

    derive :: Out -> [DSL]
    derive x = [simplifyDSL y | Guess y <- guess $ toOutput x]

    guess :: Output -> [Guess]
    guess (OApp "InstDecl" [OApp "Nothing" [], OList [], OList ctxt,name,typ,bod])
        | OApp "UnQual" [OApp "Ident" [OString name]] <- name
        , OList [OApp "TyParen" [OApp "TyApp"
            [OApp "TyCon" [OApp "UnQual" [OApp "Ident" [OString nam]]]
            ,OApp "TyVar" [OApp "Ident" [OString var]]]]] <- typ
        , nam == dataName sample
        , ctxt <- [x | OApp "ClassA" [OApp "UnQual" [OApp "Ident" [OString x]],_] <- map unparenA ctxt]
        = [Guess $ Instance ctxt name y | Guess y <- guess bod]
        where
            unparenA (OApp "ParenA" [x]) = unparenA x
            unparenA x = x

    guess (OList xs) = guessList xs
    guess o@(OApp op xs) = gssFold o ++ gssApp o ++ map (lift (App op)) (guessList xs)

    guess (OString x)
        | Just i <- findIndex (`isSuffixOf` x) ctrNames = [GuessCtr i True $ String (take (length x - length (ctrNames !! i)) x) `append` CtorName]
        | "Sample" `isSuffixOf` x = [Guess $ String (take (length x - 6) x) `append` DataName]
        | otherwise =
             [lift (\d -> append (String $ init x) (ShowInt d)) g | x /= "", isDigit (last x), g <- guess $ OInt $ read [last x]] ++
             [Guess $ String x]

    guess (OInt i) =
        [GuessFld (fromInteger i) FieldIndex | i `elem` [1,2]] ++
        [GuessCtr 1 False CtorIndex | i == 1] ++
        [GuessCtr 1 False CtorArity | i == 2] ++
        [Guess $ Int i]

    guess x = error $ show ("fallthrough",x)

    {-
    First try and figure out runs to put them in to one possible option
    Then try and figure out similarities to give them the same type
    -}
    guessList :: [Output] -> [Guess]
    guessList xs = mapMaybe sames $ map diffs $ sequence $ map guess xs
        where
            -- Given a list of guesses, try and collapse them into one coherent guess
            -- Each input Guess will guess at a List, so compose with Concat
            sames :: [Guess] -> Maybe Guess
            sames xs = do
                let (is,fs) = unzip $ map fromGuess xs
                i <- maxim is
                return $ toGuess i $ Concat $ List fs

            -- Promote each Guess to be a list
            diffs :: [Guess] -> [Guess]

            diffs (GuessCtr 0 True x0:GuessCtr 1 True x1:GuessCtr 2 True x2:xs)
                | f 0 x0 == f 0 x1 && f 2 x2 == f 2 x1 = Guess (MapCtor x1) : diffs xs
                where f i x = applyEnv x env{envInput=sample, envCtor=dataCtors sample !! i}

            diffs (GuessCtr 2 True x2:GuessCtr 1 True x1:GuessCtr 0 True x0:xs)
                | f 0 x0 == f 0 x1 && f 2 x2 == f 2 x1 = Guess (Reverse $ MapCtor x1) : diffs xs
                where f i x = applyEnv x env{envInput=sample, envCtor=dataCtors sample !! i}

            diffs (GuessFld 1 x1:GuessFld 2 x2:xs)
                | f 1 x1 == f 1 x2 = GuessCtr 1 False (MapField x2) : diffs xs
                where f i x = applyEnv x env{envInput=sample, envField=i}

            diffs (GuessFld 2 x2:GuessFld 1 x1:xs)
                | f 1 x1 == f 1 x2 = GuessCtr 1 False (Reverse $ MapField x2) : diffs xs
                where f i x = applyEnv x env{envInput=sample, envField=i}

            diffs (x:xs) = lift box x : diffs xs
            diffs [] = []

    gssFold o@(OApp op [x,m,y]) = f True (x : follow True y) ++ f False (y : follow False x)
        where
            follow dir (OApp op2 [a,m2,b]) | op == op2 && m == m2 = a2 : follow dir b2
                where (a2,b2) = if dir then (a,b) else (b,a)
            follow dir x = [x]

            f dir xs | length xs <= 2 = []
            f dir xs = map (lift g) $ guess $ OList xs
                where g = Fold (App op $ List [h,fromOut m,t])
                      (h,t) = if dir then (Head,Tail) else (Tail,Head)

    gssFold _ = []

    gssApp (OApp "App" [OApp "App" [x,y],z]) = map (lift Application) $ guess $ OList $ fromApp x ++ [y,z]
        where fromApp (OApp "App" [x,y]) = fromApp x ++ [y]
              fromApp x = [x]
    gssApp _ = []

    lift :: (DSL -> DSL) -> Guess -> Guess
    lift f x = toGuess a (f b)
        where (a,b) = fromGuess x

    type GuessState = Maybe (Either Int (Int,Bool))

    fromGuess :: Guess -> (GuessState, DSL)
    fromGuess (Guess x) = (Nothing, x)
    fromGuess (GuessFld i x) = (Just (Left i), x)
    fromGuess (GuessCtr i b x) = (Just (Right (i,b)), x)

    toGuess :: GuessState -> DSL -> Guess
    toGuess Nothing = Guess
    toGuess (Just (Left i)) = GuessFld i
    toGuess (Just (Right (i,b))) = GuessCtr i b

    -- return the maximum element, if one exists
    maxim :: [GuessState] -> Maybe GuessState
    maxim [] = Just Nothing
    maxim [x] = Just x
    maxim (Nothing:xs) = maxim xs
    maxim (x:Nothing:xs) = maxim $ x:xs
    maxim (x1:x2:xs) | x1 == x2 = maxim $ x1:xs
    maxim (Just (Right (i1,b1)):Just (Right (i2,b2)):xs) | i1 == i2 = maxim $ Just (Right (i1,max b1 b2)) : xs
    maxim _ = Nothing