{-# LANGUAGE OverloadedStrings #-}

module Funcons.Core.Values.Composite.Collections.Lists where

import Funcons.EDSL
import Funcons.Types
import Funcons.Core.Values.Primitive.BoolBuiltin

import Data.List

library = libFromList [
        ("list-length", ValueOp stepList_Length)
    ,   ("list", ValueOp stepList)
    ,   ("tail", ValueOp stepTail)
    ,   ("head", ValueOp stepHead)
    ,   ("cons", ValueOp stepCons)
    ,   ("nil", NullaryFuncon (rewritten (List [])))
    ,   ("is-in-list", ValueOp stepIs_In_List)
    ,   ("is-nil", ValueOp stepIs_Nil)
    ,   ("list-append", ValueOp list_append_op)
    ,   ("list-to-tuple", ValueOp stepList_To_Tuple)
    ,   ("list-intersperse", ValueOp stepList_Intersperse)
    ,   ("list-repeat", ValueOp stepList_Repeat)
    ,   ("list-reverse", ValueOp stepList_Reverse)
    ,   ("list-suffix", ValueOp stepList_Suffix)
    ,   ("list-prefix", ValueOp stepList_Prefix)
    ]

stepList vs = rewriteTo $ FValue $ List vs

stepList_Length [List l] = rewriteTo $ int_ (length l)
stepList_Length v = sortErr (applyFuncon "list-length" (fvalues v))
                        "list-length not applied to a list"

stepHead [List []]              = partialOp (applyFuncon "head" [FValue $ List []]) "head of empty list"
stepHead [List (h:_)]           = rewriteTo $ FValue h
stepHead v                      = sortErr (applyFuncon "head" (fvalues v)) "head not applied to a list"

stepTail [List []]              = partialOp (applyFuncon "tail" [FValue $ List []]) "tail of empty list"
stepTail [List (_:tl)]          = rewriteTo $ FValue $ List tl
stepTail v                      = sortErr (applyFuncon "tail" (fvalues v))
                                    "tail not applied to a list"

-- | Funcons for inserting a value to a list.
cons_ :: [Funcons] -> Funcons
cons_ = applyFuncon "cons"

-- | Funcons representing the empty list.
nil_ :: Funcons
nil_  = applyFuncon "nil" []

stepCons [h, List t]   = rewriteTo $ FValue $ List (h:t)
stepCons v             = sortErr (applyFuncon "cons" (fvalues v))
                                            "cons should add a value to a list of values"
stepIs_In_List [e, List xs] = rewriteTo $ FValue $ tobool (e `elem` xs)
stepIs_In_List v                = sortErr (applyFuncon "is-in-list" (fvalues v))
                                        "sort check: is-in-list(X,XS)"

stepIs_Nil [List vs] = rewriteTo $ FValue $ tobool (null vs)
stepIs_Nil v         = sortErr (applyFuncon "is-nil" (fvalues v))
                                     "is-nil not applied to a list"
stepList_Suffix [vn, List ls]
    | Nat n <- upcastNaturals vn = rewriteTo $ listval (drop (fromInteger n) ls)
stepList_Suffix vn = sortErr (applyFuncon "list-suffix" (fvalues vn)) "sort check"

stepList_Prefix [vn, List ls]
    | Nat n <- upcastNaturals vn = rewriteTo $ listval (take (fromInteger n) ls)
stepList_Prefix vn = sortErr (applyFuncon "list-prefix" (fvalues vn)) "sort check"

list_to_tuple_ :: [Funcons] -> Funcons
list_to_tuple_ = applyFuncon "list-to-tuple" 
stepList_To_Tuple vs            = list_to_tuple_op vs

stepList_Intersperse [v,List l] = rewriteTo $ listval (intersperse v l)
stepList_Intersperse v          = sortErr (applyFuncon "list-intersperse" (fvalues v)) "list-intersperse not applied to a value and a list"

stepList_Repeat [m,v]
    | Nat n <- upcastNaturals m = rewriteTo $ listval (replicate (fromInteger n) v)
stepList_Repeat v               = sortErr (applyFuncon "list-repeat" (fvalues v)) "list-repeat not applied to a nat and a value"

stepList_Reverse [List l]       = rewriteTo $ listval (reverse l)
stepList_Reverse v              = sortErr (applyFuncon "list-reverse" (fvalues v)) "list-reverse not applied to a list"


list_to_tuple_op [List xs] = rewriteTo $ FValue $ safe_tuple_val xs
list_to_tuple_op v = sortErr (applyFuncon "list-to-tuple" (fvalues v))
                         "list-to-tuple not applied to list"

list_append_op :: [Values] -> Rewrite Rewritten
list_append_op vs | all isList_ vs = rewriteTo $ FValue $  List (concatMap toList vs)
                  | otherwise = sortErr (applyFuncon "list-append" [FValue $ safe_tuple_val vs])
                                    "list-append not applied to a sequence of lists"
 where  toList (List l) = l
        toList _ = error "list-append not applied to lists"
        isList_ (List _) = True
        isList_ _        = False