module Cirru
( CirruValue(..)
, CirruState(..)
, CrValue(..)
, CirruBuffer(..)
, createNesting
, appendItem
, resolveDollar
, resolveComma
) where
import Data.Text (pack, unpack)
import Data.Aeson.Types (Array)
import Data.List
import qualified Data.Vector as V
import Debug.Trace
import Data.Aeson
import Data.Traversable (traverse)
import Data.Foldable (toList)
import Control.Applicative
data CirruBuffer = CirruBuffer { bText :: String
, bX :: Integer
, bY :: Integer
}
instance Show CirruBuffer where
show (CirruBuffer text _ _) = text
data CrValue = CrList [CrValue] | CrString String
instance Show CrValue where
show (CrString a) = a
show (CrList a) = "[" ++ (intercalate "," (map show a)) ++"]"
instance FromJSON CrValue where
parseJSON v =
withText "CrString" (pure . CrString . unpack) v
<|> withArray "CrList" (\a -> CrList . toList <$> traverse parseJSON a) v
instance ToJSON CrValue where
toJSON (CrString text) = String $ pack text
toJSON (CrList list) = Array $ V.fromList (map toJSON list)
data CirruValue = CirruList [CirruValue] | CirruToken { tText :: String
, tX :: Integer
, tY :: Integer
, tEx :: Integer
, tEy :: Integer
, tPath :: String
}
instance Show CirruValue where
show (CirruToken text _ _ _ _ _) = text
show (CirruList a) = "{" ++ (intercalate "," (map show a)) ++ "}"
instance ToJSON CirruValue where
toJSON (CirruToken text _ _ _ _ _) = String (pack text)
toJSON (CirruList list) = Array $ V.fromList (map toJSON list)
data CirruState = CirruState { sName :: String
, sX :: Integer
, sY :: Integer
, sLevel :: Integer
, sIndent :: Integer
, sIndented :: Integer
, sNest :: Integer
, sPath :: String
}
instance Show CirruState where
show (CirruState name x y level indent indented nest path) =
name ++ " l:" ++ (show level) ++ " i:" ++ (show indent) ++ "," ++ (show indented) ++ " " ++ (show nest)
appendItem :: CirruValue -> Integer -> CirruValue -> CirruValue
appendItem (CirruToken _ _ _ _ _ _) _ _ = error "can not append to token"
appendItem (CirruList xs) 0 x = CirruList (xs ++ [x])
appendItem (CirruList xs) n x =
CirruList (before ++ after2)
where
before = init xs
lastItem = last xs
(CirruList after) = appendItem lastItem (n 1) x
after2 = [CirruList after]
createNesting :: Integer -> CirruValue
createNesting 1 = CirruList []
createNesting n = CirruList [(createNesting (n 1))]
repeatDollar :: CirruValue -> CirruValue -> CirruValue
repeatDollar (CirruList xs) (CirruList []) = (CirruList xs)
repeatDollar (CirruList before) (CirruList after) =
if (length after) == 0
then CirruList before
else case (head after) of
(CirruList cursor) ->
repeatDollar (CirruList (before ++ [CirruList newCursor])) (CirruList (tail after))
where (CirruList newCursor) = resolveDollar (CirruList cursor)
(CirruToken "$" _ _ _ _ _) ->
CirruList (before ++ [CirruList newAfter])
where (CirruList newAfter) = resolveDollar (CirruList (tail after))
(CirruToken s _ _ _ _ _) ->
repeatDollar (CirruList (before ++ [head after])) (CirruList (tail after))
resolveDollar :: CirruValue -> CirruValue
resolveDollar (CirruList []) = (CirruList [])
resolveDollar (CirruList xs) = repeatDollar (CirruList []) (CirruList xs)
repeatComma :: CirruValue -> CirruValue -> CirruValue
repeatComma (CirruList xs) (CirruList []) = (CirruList xs)
repeatComma (CirruList before) (CirruList after) =
if (length after) == 0
then CirruList before
else case (head after) of
(CirruToken _ _ _ _ _ _) ->
repeatComma (CirruList (before ++ [head after])) (CirruList (tail after))
(CirruList cursor) ->
if (length cursor) == 0
then repeatComma (CirruList (before ++ [head after])) (CirruList (tail after))
else case (head cursor) of
(CirruList _) ->
repeatComma (CirruList (before ++ [CirruList newCursor])) (CirruList (tail after))
where (CirruList newCursor) = resolveComma (CirruList cursor)
(CirruToken "," _ _ _ _ _) ->
repeatComma (CirruList before) (CirruList (newCursor ++ (tail after)))
where (CirruList newCursor) = resolveComma (CirruList (tail cursor))
(CirruToken _ _ _ _ _ _) ->
repeatComma (CirruList (before ++ [CirruList newCursor])) (CirruList (tail after))
where (CirruList newCursor) = resolveComma (CirruList cursor)
resolveComma :: CirruValue -> CirruValue
resolveComma (CirruList []) = (CirruList [])
resolveComma (CirruList xs) = repeatComma (CirruList []) (CirruList xs)