module SList where

open import Data.Bool
open import Data.Nat
open import Data.String hiding (toList; fromList)
open import Data.Product
open import Data.List hiding (_++_)

-- Using a standard datatype as the tag, instead of void types.
data Tag : Set where 
  Safe   : Tag
  Unsafe : Tag

-- Reimplemention of standard list
-- Uses both a parameter and an index
data sList (A : Set) : Tag -> Set where
  Nil  : sList A Unsafe
  Cons : { t : Tag } -> A -> sList A t -> sList A Safe 

showList : { t : Tag } -> sList String t -> String
showList (Nil) = "[]"
showList (Cons x xs) = "(cons " ++  x ++ " " ++ showList xs ++ ")"

x : sList String Unsafe
x = Nil

y : sList String Safe
y = Cons "1" (Cons "2" (Cons "3" Nil))

-- Lists where we don't know whether they are safe or not
ListUnsafe : Set -> Set
ListUnsafe B = Σ Tag (sList B)

showUnsafe : ListUnsafe String -> String
showUnsafe ( t , l ) = showList l

-- Coerce to an unsafe list.
forget : { a : Tag } { b : Set } -> sList b a -> ListUnsafe b
forget l = ( _ , l )

-- Convert to/from a regular list
toList : { a : Tag } -> { b : Set } -> sList b a -> List b 
toList Nil = []
toList (Cons hd tl) = hd ∷ toList tl

uCons : { B : Set } -> B -> ListUnsafe B -> ListUnsafe B 
uCons x ( _ , l ) = ( Safe , Cons x l )

fromList : { b : Set } -> List b -> ListUnsafe b
fromList = foldr uCons (_ , Nil) 

-- Four operations that require non-empty lists

sHead : { a : Set } -> sList a Safe -> a 
sHead (Cons hd tl) = hd

sTail : { a : Set } -> sList a Safe -> ListUnsafe a
sTail (Cons hd Nil) = (Unsafe , Nil)
sTail (Cons hd (Cons x tl)) = (Safe , (Cons x tl))

sLast : { a : Set } -> sList a Safe -> a
sLast (Cons x Nil)  = x
sLast (Cons x (Cons y ys))   = sLast (Cons y ys)

sInit : { a : Set } -> sList a Safe -> ListUnsafe a 
sInit (Cons x Nil) = (Unsafe , Nil)
sInit (Cons x (Cons y ys)) = uCons x (sInit (Cons y ys))

-- Other standard operations that work for any list

sElem : ∀ { a  b } ->  (b -> b -> Bool) -> b -> sList b a -> Bool
sElem eq b (Cons x xs) = if eq b x then true else sElem eq b xs
sElem eq b Nil = false

sMap  : ∀ { b1  b2  a } -> (b1 -> b2) -> sList b1 a -> sList b2 a
sMap f  Nil        = Nil
sMap f (Cons x xs) = (Cons (f x) (sMap f xs))

sFilter : { a : Tag } { b : Set } -> (b -> Bool) -> sList b a -> ListUnsafe b
sFilter f Nil       = (Unsafe ,  Nil)
sFilter f (Cons x xs) with f x
sFilter f (Cons x xs) | false = sFilter f xs
sFilter f (Cons x xs) | true  = uCons x (sFilter f xs)

sLength : {b : Set} {a : Tag} -> sList b a -> ℕ
sLength Nil = 0
sLength (Cons x xs) = 1 + sLength xs

-- what is type of (binary) concat

addtag : Tag -> Tag -> Tag
addtag Unsafe Unsafe = Unsafe 
addtag _ _ = Safe

sConcat : ∀ {a t1 t2} -> sList a t1 -> sList a t2 -> sList a (addtag t1 t2)
sConcat Nil Nil         = Nil
sConcat Nil (Cons x xs) = Cons x xs
sConcat (Cons x xs) l   = Cons x (sConcat xs l)