module Language.Noodle.Lib.String(env,decls) where

import Language.Noodle.Evaluation
import Data.List

env    = extenv decls
decls  = [("++",     extop sconcat)
         ,("chars",  extfun schars)
         ,("unchars",extfun sunchars)
         ,("words",  extfun swords)
         ,("unwords",extfun sunwords)
         ,("lines",  extfun slines)
         ,("unlines",extfun sunlines)
         ,("$/",     extop ssplit)
         ,("$*",     extop sjoin)]

sconcat (Str s1) (Str s2) = return $ Str $ s1 ++ s2
sconcat _         _       = return $ srtError "invalid operand: ++"

schars (Str s) = return $ foldr1 Prod $ map Str $ schars' s
schars _       = return $ srtError "'chars' can only be applied to strings"
schars' :: String -> [String]
schars' ""      = [""]
schars' [c]     = [[c]]
schars' (c:cs)  = [c]:schars' cs




swords (Str s) = return $ foldr1 Prod $ map Str $ swords' s
swords _       = return $ srtError "'words' can only be applied to strings"
swords' s   = let wrds = words s
              in if wrds == []
                    then [""]
                    else wrds
slines (Str s) = return $ foldr1 Prod $ map Str $ slines' s
slines _       =  return $ srtError "'lines' can only be applied to strings"

slines'  s      = let lns = lines s
                  in if lns == []
                        then [""]
                        else lns

ssplit (Str s) (Str d) = return $ foldr1 Prod $ map Str $
                            case filter (/= "") $ split s d of
                                 [] -> [""]
                                 o  -> o
ssplit _ _ = return $ srtError "invalid operand $/"

split :: String -> String -> [String]
split s "" = schars' s
split  "" _  = [""]
split s  d   = let ls = length s
                   ld = length d
               in if ld > ls
                  then [s]
                  else if d `isPrefixOf` s
                          then [""] ++ split (drop (ld) s) d
                          else let (c:cs) = s
                               in case split cs d of
                                       [end]     -> [c:end]
                                       part:rest -> (c:part):rest

sunchars cprod
    = do result <- sjoin cprod (Str "")
         case result of
              Error s -> return $ srtError "invalid parameters to unchars"
              _       -> return result
sunwords wprod
    = do result <- sjoin wprod (Str " ")
         case result of
              Error s -> return $ srtError "invalid parameters to unwords"
              _       -> return result
sunlines lprod
    = do result <- sjoin lprod (Str "\n")
         case result of
              Error s -> return $ srtError "invalid parameters to unlines"
              _       -> return result


sjoin (Str s) (Str _) = return $ Str s
sjoin (Prod (Str s) next) (Str d)
    = do (Str rest) <- sjoin next (Str d)
         return $ Str $ s ++ d ++ rest
sjoin _ _ = return $ srtError "invalid operand $*"