{-# LANGUAGE AllowAmbiguousTypes   #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE FlexibleContexts      #-}
-- | Shared utilities that may be moved to upstream libraries.
module Util where

import           Data.Function(on)
import           Data.List(groupBy, sortBy)
import           Data.Maybe(fromMaybe)
import qualified Data.Text as T
import           Optics.Core ( Lens, lens )
import           Prelude hiding(getLine)

import           Token(MyTok(..))

-- | Lens with default value.
maybeLens :: a -> Lens (Maybe a) (Maybe a1) a a1
maybeLens :: forall a a1. a -> Lens (Maybe a) (Maybe a1) a a1
maybeLens a
dflt = (Maybe a -> a)
-> (Maybe a -> a1 -> Maybe a1) -> Lens (Maybe a) (Maybe a1) a a1
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
dflt) (\Maybe a
_ a1
a -> a1 -> Maybe a1
forall a. a -> Maybe a
Just a1
a)

-- | Sort and group inputs by a given `Ordering`.
grouping    :: Ord k
            => (   a -> k)
            ->    [a]
            ->   [[a]]
grouping :: forall k a. Ord k => (a -> k) -> [a] -> [[a]]
grouping a -> k
key = (a -> a -> Bool) -> [a] -> [[a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (k -> k -> Bool
forall a. Eq a => a -> a -> Bool
(==)    (k -> k -> Bool) -> (a -> k) -> a -> a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> k
key)
             ([a] -> [[a]]) -> ([a] -> [a]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy  (k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (k -> k -> Ordering) -> (a -> k) -> a -> a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> k
key)

-- | Sort and remove duplicates in a list.
--   Duplicates are detected as equals by default `Ord`ering.
nubSorted :: Ord a => [a] -> [a]
nubSorted :: forall a. Ord a => [a] -> [a]
nubSorted  = (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
nubSortedBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

-- | Given an `Ord`ering, sort and remove duplicates.
nubSortedBy :: (a -> a -> Ordering) -> [a] -> [a]
nubSortedBy :: forall a. (a -> a -> Ordering) -> [a] -> [a]
nubSortedBy a -> a -> Ordering
comparison = ([a] -> a) -> [[a]] -> [a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap    [a] -> a
forall a. HasCallStack => [a] -> a
head
                       ([[a]] -> [a]) -> ([a] -> [[a]]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Bool) -> [a] -> [[a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy a -> a -> Bool
equality
                       ([a] -> [[a]]) -> ([a] -> [a]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy  a -> a -> Ordering
comparison
  where
    equality :: a -> a -> Bool
equality a
a a
b = a
a a -> a -> Ordering
`comparison` a
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ

-- | Safe tail function that returns empty list for empty input.
safeTail :: [a] -> [a]
safeTail []     = []
safeTail (a
_:[a]
ls) = [a]
ls

-- | Take text in braces, and return its inner part.
--   Fail if the given text does not start with opening brace,
--   and end in closing brace.
unbrace :: Text -> Maybe Text
unbrace Text
txt | HasCallStack => Text -> Char
Text -> Char
T.head Text
txt Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'(' Bool -> Bool -> Bool
&& HasCallStack => Text -> Char
Text -> Char
T.last Text
txt Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')' Bool -> Bool -> Bool
&& Text -> Int
T.length Text
txt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2 = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text
Text -> Text
T.tail (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text
Text -> Text
T.init Text
txt
unbrace Text
_ = Maybe Text
forall a. Maybe a
Nothing

brace :: a -> a
brace a
txt = [a] -> a
forall a. Monoid a => [a] -> a
mconcat [a
"(", a
txt, a
")"]

-- | Preprocess tokens before formatting
--   in order to detect tokens like functions converted to operator syntax.
--   These are merged into a single token.
preformatTokens :: [(MyTok, b)] -> [(MyTok, b)]
preformatTokens []                                                     = []
preformatTokens ((MyTok
TOperator,b
"`"):(MyTok
TVar, b
"elem"):(MyTok
TOperator, b
"`"):[(MyTok, b)]
rest) = (MyTok
TOperator, b
"elem")(MyTok, b) -> [(MyTok, b)] -> [(MyTok, b)]
forall a. a -> [a] -> [a]
:[(MyTok, b)] -> [(MyTok, b)]
preformatTokens [(MyTok, b)]
rest
preformatTokens ((MyTok, b)
a                                              :[(MyTok, b)]
rest) =  (MyTok, b)
a                 (MyTok, b) -> [(MyTok, b)] -> [(MyTok, b)]
forall a. a -> [a] -> [a]
:[(MyTok, b)] -> [(MyTok, b)]
preformatTokens [(MyTok, b)]
rest