{-# Language MultiWayIf #-}
{-# Language OverloadedStrings #-}
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