module Gimlh
(
Giml(..)
, GimlVal(..)
, GimlType(..)
, GimlNode(..)
, SimpleGiml(..)
, parseString
, parseFile
, simplifyGiml
, fetch
, fetchG
, val2Str
, val2List
)
where
import Prelude
import System.IO
import Data.List.Split (splitOn)
import Data.Maybe (fromJust)
import Numeric (readFloat)
import Data.Char (isDigit)
data GimlVal
= Text String
| List [String]
| Number Integer
| Float Double
deriving (Show, Eq)
data GimlType
= TextG
| ListG
| NumberG
| FloatG
deriving (Show, Eq)
type GimlNode = (String, GimlType, GimlVal)
type SimpleGiml = [(String, GimlVal)]
type Giml = [GimlNode]
parseFile :: FilePath -> IO Giml
parseFile path = do
contents <- readFile path
return $ parseString contents
parseString :: String -> Giml
parseString contents = parseLines (lines contents) Nothing
simplifyGiml :: Giml -> SimpleGiml
simplifyGiml = map (\(a, b, c) -> (a, c))
fetch :: SimpleGiml -> String -> Maybe GimlVal
fetch [] _ = Nothing
fetch ((key, val):xs) req = if key == req
then return val
else fetch xs req
fetchG :: Giml -> String -> Maybe GimlVal
fetchG giml = fetch (simplifyGiml giml)
val2Str :: GimlVal -> String
val2Str (Text val) = val
val2Str (List val) = show val
val2Str (Number val) = show val
val2Str (Float val) = show val
val2List :: GimlVal -> [String]
val2List (List val) = val
val2List (Text val) = [val]
val2List (Number val) = [show val]
val2List (Float val) = [show val]
parseLines :: [String] -> Maybe GimlNode -> Giml
parseLines [] Nothing = []
parseLines [] (Just node) = [postProcess node]
parseLines (line:rest) node = case parseLine line node of
(Nothing, Nothing) -> parseLines rest node
(Nothing, newNode) -> parseLines rest newNode
(oldNode, newNode) -> postProcess (fromJust oldNode) : parseLines rest newNode
postProcess :: GimlNode -> GimlNode
postProcess (key, TextG, val) = let str = removeSymbolAtEnd (val2Str val) '\n'
in
(key, TextG, Text $ str)
postProcess node = node
parseLine :: String -> Maybe GimlNode -> (Maybe GimlNode, Maybe GimlNode)
parseLine ('#':_) _ = (Nothing, Nothing)
parseLine line@(':':_) (Just old) = (return old, return $ newNode (words line))
parseLine line@(':':_) Nothing = (Nothing, return $ newNode (words line))
parseLine line (Just var) = (Nothing, return $ setNode var line)
parseLine _ Nothing = (Nothing, Nothing)
newNode :: [String] -> GimlNode
newNode (":list:":key) = (head key, ListG, List [])
newNode (":vlist:":key) = (head key, ListG, List [])
newNode (":text:":key) = (head key, TextG, Text [])
newNode (":num:":key) = (head key, NumberG, Number 0)
setNode :: GimlNode -> String -> GimlNode
setNode orig@(key, ListG, xs) "" = orig
setNode (key, ListG, xs) x = case head $ words x of
"-" -> (key, ListG, List $ val2List xs ++ [unwords . tail $ words x])
otherwise -> (key, ListG, List $ val2List xs ++ splitOn ", " (removeSymbolAtEnd x ','))
setNode orig@(key, TextG, xs) "" = case xs of
Text "" -> orig
otherwise -> (key, TextG, Text $ val2Str xs ++ "\n")
setNode (key, TextG, xs) x = case xs of
Text "" -> (key, TextG, Text $ val2Str xs ++ x)
otherwise -> (key, TextG, Text $ val2Str xs ++ "\n" ++ x)
setNode (key, _, val) "" = (key, NumberG, val)
setNode (key, _, _) newVal = let parsedNum = fromJust $ parseNum newVal
in
case parsedNum of
(Number val) -> (key, NumberG, Number val)
(Float val) -> (key, FloatG, Float val)
otherwise -> (key, NumberG, Number 0)
val2Int (Number val) = val
val2Dbl (Float val) = val
removeSymbolAtEnd :: String -> Char -> String
removeSymbolAtEnd str char = if last str == char && last (init str) /= '\\'
then removeSymbolAtEnd (init str) char
else str
parseNum :: String -> Maybe GimlVal
parseNum str = do
let digitsAndDot = filter (\x -> isDigit x || x == '.') str
if '.' `elem` digitsAndDot
then return $ Float $ fst . head $ readFloat digitsAndDot
else return $ Number $ read digitsAndDot