-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com
-- SPDX-License-Identifier: MIT

module Misc
  ( toDouble
  , fqnToAttrs
  , attributesFromBindings
  , attributesFromBindings'
  , attributeFromBinding
  , uniqueBindings
  , uniqueBindings'
  , orThrow
  )
where

import AST
import Control.Exception
import Data.Functor ((<&>))
import Data.List (intercalate)
import Data.Maybe (catMaybes)
import Text.Printf (printf)

orThrow :: (Exception e) => (String -> e) -> Either String a -> IO a
orThrow :: forall e a. Exception e => (String -> e) -> Either String a -> IO a
orThrow String -> e
_ (Right a
value) = a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
value
orThrow String -> e
asException (Left String
err) = e -> IO a
forall e a. Exception e => e -> IO a
throwIO (String -> e
asException String
err)

attributesFromBindings :: [Binding] -> [Attribute]
attributesFromBindings :: [Binding] -> [Attribute]
attributesFromBindings [] = []
attributesFromBindings [Binding]
bds = [Maybe Attribute] -> [Attribute]
forall a. [Maybe a] -> [a]
catMaybes ([Binding] -> [Maybe Attribute]
attributesFromBindings' [Binding]
bds)

attributesFromBindings' :: [Binding] -> [Maybe Attribute]
attributesFromBindings' :: [Binding] -> [Maybe Attribute]
attributesFromBindings' = (Binding -> Maybe Attribute) -> [Binding] -> [Maybe Attribute]
forall a b. (a -> b) -> [a] -> [b]
map Binding -> Maybe Attribute
attributeFromBinding

uniqueBindings' :: [Binding] -> IO [Binding]
uniqueBindings' :: [Binding] -> IO [Binding]
uniqueBindings' [Binding]
bds = case [Binding] -> Either String [Binding]
uniqueBindings [Binding]
bds of
  Left String
msg -> IOError -> IO [Binding]
forall e a. Exception e => e -> IO a
throwIO (String -> IOError
userError String
msg)
  Right [Binding]
_ -> [Binding] -> IO [Binding]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Binding]
bds

uniqueBindings :: [Binding] -> Either String [Binding]
uniqueBindings :: [Binding] -> Either String [Binding]
uniqueBindings [Binding]
bds = case [Binding] -> Maybe Attribute
repeated [Binding]
bds of
  Just Attribute
attr ->
    String -> Either String [Binding]
forall a b. a -> Either a b
Left
      ( String -> String -> String -> String
forall r. PrintfType r => String -> r
printf
          String
"Duplicated attribute '%s' found in %s"
          (Attribute -> String
forall a. Show a => a -> String
show Attribute
attr)
          (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Attribute -> String) -> [Attribute] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Attribute -> String
forall a. Show a => a -> String
show ([Binding] -> [Attribute]
attributesFromBindings [Binding]
bds)))
      )
  Maybe Attribute
_ -> [Binding] -> Either String [Binding]
forall a b. b -> Either a b
Right [Binding]
bds

fqnToAttrs :: Expression -> Maybe [Attribute]
fqnToAttrs :: Expression -> Maybe [Attribute]
fqnToAttrs Expression
expr = Expression -> Maybe [Attribute]
go Expression
expr Maybe [Attribute]
-> ([Attribute] -> [Attribute]) -> Maybe [Attribute]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [Attribute] -> [Attribute]
forall a. [a] -> [a]
reverse
  where
    go :: Expression -> Maybe [Attribute]
    go :: Expression -> Maybe [Attribute]
go Expression
ExRoot = [Attribute] -> Maybe [Attribute]
forall a. a -> Maybe a
Just []
    go (ExDispatch Expression
ex Attribute
at) = Expression -> Maybe [Attribute]
go Expression
ex Maybe [Attribute]
-> ([Attribute] -> [Attribute]) -> Maybe [Attribute]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (:) Attribute
at
    go Expression
_ = Maybe [Attribute]
forall a. Maybe a
Nothing

toDouble :: Int -> Double
toDouble :: Int -> Double
toDouble = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral