{-# Language MultiWayIf #-}
{-# Language OverloadedStrings #-}
-- | Utilites for generating JSON
module Crux.UI.JS where

import Data.Text(unpack)
import Data.List(intercalate)
import Data.Maybe(fromMaybe)
import System.Directory( canonicalizePath )

import What4.ProgramLoc

jsLoc :: ProgramLoc -> IO (Maybe JS)
jsLoc :: ProgramLoc -> IO (Maybe JS)
jsLoc ProgramLoc
x =
  case ProgramLoc -> Position
plSourceLoc ProgramLoc
x of
    SourcePos Text
f Int
l Int
c ->
      do let fstr :: String
fstr = Text -> String
unpack Text
f
         String
fabsolute <-
            if | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
fstr -> String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
""
               | Bool
otherwise -> String -> IO String
canonicalizePath String
fstr
         Maybe JS -> IO (Maybe JS)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe JS -> IO (Maybe JS)) -> Maybe JS -> IO (Maybe JS)
forall a b. (a -> b) -> a -> b
$ JS -> Maybe JS
forall a. a -> Maybe a
Just (JS -> Maybe JS) -> JS -> Maybe JS
forall a b. (a -> b) -> a -> b
$ [(String, JS)] -> JS
jsObj
           [ String
"file" String -> JS -> (String, JS)
forall a b. a -> b -> (a, b)
~> String -> JS
jsStr String
fabsolute
           , String
"line" String -> JS -> (String, JS)
forall a b. a -> b -> (a, b)
~> String -> JS
jsStr (Int -> String
forall a. Show a => a -> String
show Int
l)
           , String
"col"  String -> JS -> (String, JS)
forall a b. a -> b -> (a, b)
~> String -> JS
jsStr (Int -> String
forall a. Show a => a -> String
show Int
c)
           ]
    Position
_ -> Maybe JS -> IO (Maybe JS)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe JS
forall a. Maybe a
Nothing

--------------------------------------------------------------------------------
newtype JS = JS { JS -> String
renderJS :: String }

jsList :: [JS] -> JS
jsList :: [JS] -> JS
jsList [JS]
xs = String -> JS
JS (String -> JS) -> String -> JS
forall a b. (a -> b) -> a -> b
$ String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [ String
x | JS String
x <- [JS]
xs ] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"

infix 1 ~>

(~>) :: a -> b -> (a,b)
~> :: forall a b. a -> b -> (a, b)
(~>) = (,)

jsObj :: [(String,JS)] -> JS
jsObj :: [(String, JS)] -> JS
jsObj [(String, JS)]
xs =
  String -> JS
JS (String -> JS) -> String -> JS
forall a b. (a -> b) -> a -> b
$ String
"{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [ String -> String
forall a. Show a => a -> String
show String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v | (String
x,JS String
v) <- [(String, JS)]
xs ] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}"

jsBool :: Bool -> JS
jsBool :: Bool -> JS
jsBool Bool
b = String -> JS
JS (if Bool
b then String
"true" else String
"false")

jsStr :: String -> JS
jsStr :: String -> JS
jsStr = String -> JS
JS (String -> JS) -> (String -> String) -> String -> JS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. Show a => a -> String
show

jsNull :: JS
jsNull :: JS
jsNull = String -> JS
JS String
"null"

jsMaybe :: Maybe JS -> JS
jsMaybe :: Maybe JS -> JS
jsMaybe = JS -> Maybe JS -> JS
forall a. a -> Maybe a -> a
fromMaybe JS
jsNull

jsNum :: Show a => a -> JS
jsNum :: forall a. Show a => a -> JS
jsNum = String -> JS
JS (String -> JS) -> (a -> String) -> a -> JS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show


---------------------------------------------------