module Haxible.Report (reportTiming) where import Data.Aeson import Data.List (sortOn) import Data.Map (Map) import Data.Map qualified as Map import Data.Text qualified as Text import Haxible.Prelude reportTiming :: NonEmpty Value -> Text reportTiming :: NonEmpty Value -> Text reportTiming NonEmpty Value rawResults = [Text] -> Text Text.unlines ([Text] -> Text) -> [Text] -> Text forall a b. (a -> b) -> a -> b $ [Text "@startuml", Text "scale 1 as 100 pixels"] [Text] -> [Text] -> [Text] forall a. Semigroup a => a -> a -> a <> (Text -> Text -> Text forall a. Monoid a => a -> a -> a mappend Text "concise " (Text -> Text) -> [Text] -> [Text] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [Text] orderedKeys) [Text] -> [Text] -> [Text] forall a. Semigroup a => a -> a -> a <> ((Text, (Integer, Integer, Text)) -> [Text]) -> [(Text, (Integer, Integer, Text))] -> [Text] forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap (Text, (Integer, Integer, Text)) -> [Text] toTiming (Map Text (Integer, Integer, Text) -> [(Text, (Integer, Integer, Text))] forall k a. Map k a -> [(k, a)] Map.toList Map Text (Integer, Integer, Text) modules) [Text] -> [Text] -> [Text] forall a. Semigroup a => a -> a -> a <> [Text "@enduml"] where orderedKeys :: [Text] orderedKeys = (Text, (Integer, Integer, Text)) -> Text forall a b. (a, b) -> a fst ((Text, (Integer, Integer, Text)) -> Text) -> [(Text, (Integer, Integer, Text))] -> [Text] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ((Text, (Integer, Integer, Text)) -> Integer) -> [(Text, (Integer, Integer, Text))] -> [(Text, (Integer, Integer, Text))] forall b a. Ord b => (a -> b) -> [a] -> [a] sortOn (\(Text _, (Integer s, Integer _, Text _)) -> Integer s) (Map Text (Integer, Integer, Text) -> [(Text, (Integer, Integer, Text))] forall k a. Map k a -> [(k, a)] Map.toList Map Text (Integer, Integer, Text) modules) results :: [Value] results :: [Value] results = [Value] -> [Value] forall a. [a] -> [a] reverse ([Value] -> [Value]) -> [Value] -> [Value] forall a b. (a -> b) -> a -> b $ ([Value] -> Value -> [Value]) -> [Value] -> NonEmpty Value -> [Value] forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b foldl' [Value] -> Value -> [Value] go [Value] forall a. Monoid a => a mempty NonEmpty Value rawResults where go :: [Value] -> Value -> [Value] go [Value] acc Value x = case Getting (First (Vector Value)) Value (Vector Value) -> Value -> Maybe (Vector Value) forall s (m :: * -> *) a. MonadReader s m => Getting (First a) s a -> m (Maybe a) preview (Text -> Traversal' Value Value forall t. AsValue t => Text -> Traversal' t Value key Text "results" ((Value -> Const (First (Vector Value)) Value) -> Value -> Const (First (Vector Value)) Value) -> Getting (First (Vector Value)) Value (Vector Value) -> Getting (First (Vector Value)) Value (Vector Value) forall b c a. (b -> c) -> (a -> b) -> a -> c . Getting (First (Vector Value)) Value (Vector Value) forall t. AsValue t => Prism' t (Vector Value) _Array) Value x of Just Vector Value xs -> Vector Value -> [Value] forall (t :: * -> *) a. Foldable t => t a -> [a] toList Vector Value xs [Value] -> [Value] -> [Value] forall a. Semigroup a => a -> a -> a <> [Value] acc Maybe (Vector Value) Nothing -> Value x Value -> [Value] -> [Value] forall a. a -> [a] -> [a] : [Value] acc scaleTime :: Integer -> Integer scaleTime :: Integer -> Integer scaleTime Integer x = Double -> Integer forall a b. (RealFrac a, Integral b) => a -> b round (Integer -> Double forall a. Num a => Integer -> a fromInteger (Integer x Integer -> Integer -> Integer forall a. Num a => a -> a -> a - Integer minDate) Double -> Double -> Double forall a. Num a => a -> a -> a * Double step) toTiming :: (Text, (Integer, Integer, Text)) -> [Text] toTiming :: (Text, (Integer, Integer, Text)) -> [Text] toTiming (Text name, (Integer -> Integer scaleTime -> Integer start, Integer -> Integer scaleTime -> Integer end, Text name')) = [ Text "\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "@" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text name, [Text] -> Text Text.unwords [String -> Text forall source target. From source target => source -> target from (Integer -> String forall a. Show a => a -> String show Integer start), Text "is", Text -> Text quote Text name'], [Text] -> Text Text.unwords [String -> Text forall source target. From source target => source -> target from (Integer -> String forall a. Show a => a -> String show Integer end), Text "is", Text "{hidden}"] ] step :: Double step = Double 9 Double -> Double -> Double forall a. Fractional a => a -> a -> a / (forall target source. (HasCallStack, TryFrom source target, Show source, Typeable source, Typeable target) => source -> target unsafeInto @Double (Integer -> Double) -> Integer -> Double forall a b. (a -> b) -> a -> b $ Integer maxDate Integer -> Integer -> Integer forall a. Num a => a -> a -> a - Integer minDate) minDate, maxDate :: Integer minDate :: Integer minDate = [Integer] -> Integer forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a minimum ([Integer] -> Integer) -> [Integer] -> Integer forall a b. (a -> b) -> a -> b $ (Value -> Integer) -> [Value] -> [Integer] forall a b. (a -> b) -> [a] -> [b] map (Text -> Value -> Integer forall {c} {s}. (Integral c, AsValue s) => Text -> s -> c getNumber Text "__haxible_start") [Value] results maxDate :: Integer maxDate = [Integer] -> Integer forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a maximum ([Integer] -> Integer) -> [Integer] -> Integer forall a b. (a -> b) -> a -> b $ (Value -> Integer) -> [Value] -> [Integer] forall a b. (a -> b) -> [a] -> [b] map (Text -> Value -> Integer forall {c} {s}. (Integral c, AsValue s) => Text -> s -> c getNumber Text "__haxible_end") [Value] results getNumber :: Text -> s -> c getNumber Text key' = Scientific -> c forall a b. (RealFrac a, Integral b) => a -> b round (Scientific -> c) -> (s -> Scientific) -> s -> c forall b c a. (b -> c) -> (a -> b) -> a -> c . Scientific -> Maybe Scientific -> Scientific forall a. a -> Maybe a -> a fromMaybe (String -> Scientific forall a. HasCallStack => String -> a error (String -> Scientific) -> String -> Scientific forall a b. (a -> b) -> a -> b $ String "missing attributes: " String -> String -> String forall a. Semigroup a => a -> a -> a <> Text -> String forall source target. From source target => source -> target from Text key') (Maybe Scientific -> Scientific) -> (s -> Maybe Scientific) -> s -> Scientific forall b c a. (b -> c) -> (a -> b) -> a -> c . Getting (First Scientific) s Scientific -> s -> Maybe Scientific forall s (m :: * -> *) a. MonadReader s m => Getting (First a) s a -> m (Maybe a) preview (Text -> Traversal' s Value forall t. AsValue t => Text -> Traversal' t Value key Text key' ((Value -> Const (First Scientific) Value) -> s -> Const (First Scientific) s) -> ((Scientific -> Const (First Scientific) Scientific) -> Value -> Const (First Scientific) Value) -> Getting (First Scientific) s Scientific forall b c a. (b -> c) -> (a -> b) -> a -> c . (Scientific -> Const (First Scientific) Scientific) -> Value -> Const (First Scientific) Value forall t. AsNumber t => Prism' t Scientific _Number) modules :: Map Text (Integer, Integer, Text) modules :: Map Text (Integer, Integer, Text) modules = (Map Text (Integer, Integer, Text) -> Value -> Map Text (Integer, Integer, Text)) -> Map Text (Integer, Integer, Text) -> [Value] -> Map Text (Integer, Integer, Text) forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b foldl' ((Value -> Map Text (Integer, Integer, Text) -> Map Text (Integer, Integer, Text)) -> Map Text (Integer, Integer, Text) -> Value -> Map Text (Integer, Integer, Text) forall a b c. (a -> b -> c) -> b -> a -> c flip Value -> Map Text (Integer, Integer, Text) -> Map Text (Integer, Integer, Text) go) Map Text (Integer, Integer, Text) forall a. Monoid a => a mempty [Value] results where go :: Value -> Map Text (Integer, Integer, Text) -> Map Text (Integer, Integer, Text) go :: Value -> Map Text (Integer, Integer, Text) -> Map Text (Integer, Integer, Text) go Value v Map Text (Integer, Integer, Text) acc = Text -> (Integer, Integer, Text) -> Map Text (Integer, Integer, Text) -> Map Text (Integer, Integer, Text) forall k a. Ord k => k -> a -> Map k a -> Map k a Map.insert Text moduleID (Text -> Value -> Integer forall {c} {s}. (Integral c, AsValue s) => Text -> s -> c getNumber Text "__haxible_start" Value v, Text -> Value -> Integer forall {c} {s}. (Integral c, AsValue s) => Text -> s -> c getNumber Text "__haxible_end" Value v, Text name) Map Text (Integer, Integer, Text) acc where moduleID :: Text moduleID = [Text] -> Text forall a. [a] -> a head ([Text] -> Text) -> [Text] -> Text forall a b. (a -> b) -> a -> b $ (Text -> Bool) -> [Text] -> [Text] forall a. (a -> Bool) -> [a] -> [a] filter (Text -> Map Text (Integer, Integer, Text) -> Bool forall k a. Ord k => k -> Map k a -> Bool `Map.notMember` Map Text (Integer, Integer, Text) acc) ([Text] -> [Text]) -> [Text] -> [Text] forall a b. (a -> b) -> a -> b $ (Integer -> Text) -> [Integer] -> [Text] forall a b. (a -> b) -> [a] -> [b] map (\Integer i -> Text module_ Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> String -> Text forall source target. From source target => source -> target from (forall a. Show a => a -> String show @Integer Integer i)) [Integer 0 ..] module_ :: Text module_ = Text -> Maybe Text -> Text forall a. a -> Maybe a -> a fromMaybe (String -> Text forall a. HasCallStack => String -> a error String "no module") (Getting (First Text) Value Text -> Value -> Maybe Text forall s (m :: * -> *) a. MonadReader s m => Getting (First a) s a -> m (Maybe a) preview (Text -> Traversal' Value Value forall t. AsValue t => Text -> Traversal' t Value key Text "__haxible_module" ((Value -> Const (First Text) Value) -> Value -> Const (First Text) Value) -> Getting (First Text) Value Text -> Getting (First Text) Value Text forall b c a. (b -> c) -> (a -> b) -> a -> c . Getting (First Text) Value Text forall t. AsPrimitive t => Prism' t Text _String) Value v) name :: Text name = case Vector Value -> [Value] forall (t :: * -> *) a. Foldable t => t a -> [a] toList (Vector Value -> [Value]) -> Vector Value -> [Value] forall a b. (a -> b) -> a -> b $ Vector Value -> Maybe (Vector Value) -> Vector Value forall a. a -> Maybe a -> a fromMaybe (String -> Vector Value forall a. HasCallStack => String -> a error String "no name?") (Getting (First (Vector Value)) Value (Vector Value) -> Value -> Maybe (Vector Value) forall s (m :: * -> *) a. MonadReader s m => Getting (First a) s a -> m (Maybe a) preview (Text -> Traversal' Value Value forall t. AsValue t => Text -> Traversal' t Value key Text "__haxible_play" ((Value -> Const (First (Vector Value)) Value) -> Value -> Const (First (Vector Value)) Value) -> Getting (First (Vector Value)) Value (Vector Value) -> Getting (First (Vector Value)) Value (Vector Value) forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> Traversal' Value Value forall t. AsValue t => Text -> Traversal' t Value key Text "tasks" ((Value -> Const (First (Vector Value)) Value) -> Value -> Const (First (Vector Value)) Value) -> Getting (First (Vector Value)) Value (Vector Value) -> Getting (First (Vector Value)) Value (Vector Value) forall b c a. (b -> c) -> (a -> b) -> a -> c . Getting (First (Vector Value)) Value (Vector Value) forall t. AsValue t => Prism' t (Vector Value) _Array) Value v) of [Value x] -> Text -> Maybe Text -> Text forall a. a -> Maybe a -> a fromMaybe Text "task" (Getting (First Text) Value Text -> Value -> Maybe Text forall s (m :: * -> *) a. MonadReader s m => Getting (First a) s a -> m (Maybe a) preview (Text -> Traversal' Value Value forall t. AsValue t => Text -> Traversal' t Value key Text "name" ((Value -> Const (First Text) Value) -> Value -> Const (First Text) Value) -> Getting (First Text) Value Text -> Getting (First Text) Value Text forall b c a. (b -> c) -> (a -> b) -> a -> c . Getting (First Text) Value Text forall t. AsPrimitive t => Prism' t Text _String) Value x) [Value] _ -> String -> Text forall a. HasCallStack => String -> a error String "No task found"