{-# LANGUAGE TypeSynonymInstances #-}

{-# LANGUAGE FlexibleInstances #-}
module ZEBEDDE.Core.ReadXYZ (readXYZ,writeXYZ,showMolecule) where
import ZEBEDDE.Core.Vector
import ZEBEDDE.Core.Molecule

type XYZ = (Int,[(String,Vec)])

readXYZ :: String -> IO Molecule
readXYZ filepath = do
               dat <- readFile filepath
               let n = read (firstLine dat) in do
                return (newMolecule n (map getName (atoms dat)))
 where
  getName (a,b) | a == "C" = (a,6,b)
                | a == "H" = (a,1,b)
                | otherwise = (a,0,b) -- this is still to be implemented and should decide the atomic weight from the name. 
  firstLine = takeWhile (not . (=='\n'))
  rest a = drop ((length (firstLine a))+2) a
  atoms a =  map getAtom $ filter ((4==).length ) $ map ((split ' ')) (split '\n' (rest a))
   where
    getAtom :: [String] -> (String,Vec)
    getAtom xss = let [a,b,c,d] = take 4 xss in (a,vec (read b,read c,read d)) 
    split flag string | string == [] = []
                      | string == [flag] = []
                      | (head string) == flag = split flag (tail string)
                      | flag `elem` string = let x = (takeWhile (not.(==flag)) string) in x:(split flag (drop ((length x)+1) string))
                      | otherwise = [string] 

writeXYZ :: String -> Molecule -> IO ()
writeXYZ s xyz = writeFile s (showMolecule xyz) 

showMolecule m = let atoms' = (atoms m) in 
   (show (length atoms')) +++  (foldl (+++) "" (map show'' atoms'))
    where
    (+++) a b = a ++ "\n"++ ( b)
    show'' ((s,_, v)) = (s) ++ show v

instance Show Vec where
 show v = (show' ((unVec v)::(Double,Double,Double)) )
  where 
   show'  ((a,b,c)) = concat $  map (show''.show''') [a,b,c]
   show'' a = if (head a) == '-' then ("    " ++ (pad a)) else ("     " ++ (pad a))
   show''' a = show a
   pad   a | length a == 11 = a 
           | otherwise = a ++ (take (11-(length a)) (repeat ' '))



test = do
 putStr "please run this in the same directory as \"benzene.xyz\"\n"
 _ <- getLine
 xyz <- readXYZ "benzene.xyz"
 writeXYZ "out.xyz" xyz  
 putStrLn "thank you, that worked."