    {-|
      Copyright  :  (C) 2020-2021, QBayLogic B.V.
      License    :  BSD2 (see the file LICENSE)
      Maintainer :  QBayLogic B.V. <devops@qbaylogic.com
    -}
    {-# LANGUAGE OverloadedStrings #-}

    module Clash.Netlist.Id.Common where

    import           Control.Arrow (first)
    import           Control.Applicative ((<|>))
    import           Data.Maybe (fromMaybe)
    import           Data.Text (Text)
    import           Data.Text.Extra (showt)
    import qualified Data.Text as Text
    import qualified Data.Char as Char

    parseWhiteSpace :: Text -> Maybe Text
    parseWhiteSpace :: Text -> Maybe Text
    parseWhiteSpace = (Char -> Bool) -> Text -> Maybe Text
    parseSingle Char -> Bool
    isWhiteSpace

    isWhiteSpace :: Char -> Bool
    isWhiteSpace :: Char -> Bool
    isWhiteSpace Char
    c = Char
    c Char -> [Char] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: Type -> Type) a.
    (Foldable t, Eq a) =>
    a -> t a -> Bool
    `elem` [Char
    ' ', Char
    '\n', Char
    '\t']

    parsePrintable :: Text -> Maybe Text
    parsePrintable :: Text -> Maybe Text
    parsePrintable = (Char -> Bool) -> Text -> Maybe Text
    parseSingle (\Char
    c -> Char -> Bool
    Char.isPrint Char
    c Bool -> Bool -> Bool
    && Char -> Bool
    Char.isAscii Char
    c)

    parseSingle :: (Char -> Bool) -> Text -> Maybe Text
    parseSingle :: (Char -> Bool) -> Text -> Maybe Text
    parseSingle Char -> Bool
    predicate Text
    s = do
      (Char
    l, Text
    ls) <- Text -> Maybe (Char, Text)
    Text.uncons Text
    s
      if Char -> Bool
    predicate Char
    l then Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    ls else Maybe Text
    forall a. Maybe a
    Nothing

    parseMaybeSingle :: (Char -> Bool) -> Text -> Maybe Text
    parseMaybeSingle :: (Char -> Bool) -> Text -> Maybe Text
    parseMaybeSingle Char -> Bool
    predicate Text
    s = Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe Text
    s ((Char -> Bool) -> Text -> Maybe Text
    parseSingle Char -> Bool
    predicate Text
    s))

    parseLetter :: Text -> Maybe Text
    parseLetter :: Text -> Maybe Text
    parseLetter = (Char -> Bool) -> Text -> Maybe Text
    parseSingle (\Char
    c -> Char -> Bool
    Char.isAscii Char
    c Bool -> Bool -> Bool
    && Char -> Bool
    Char.isLetter Char
    c)

    parseDigit :: Text -> Maybe Text
    parseDigit :: Text -> Maybe Text
    parseDigit = (Char -> Bool) -> Text -> Maybe Text
    parseSingle Char -> Bool
    Char.isDigit

    parseLetterOrDigit :: Text -> Maybe Text
    parseLetterOrDigit :: Text -> Maybe Text
    parseLetterOrDigit Text
    s = Text -> Maybe Text
    parseLetter Text
    s Maybe Text -> Maybe Text -> Maybe Text
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
    <|> Text -> Maybe Text
    parseDigit Text
    s

    parseUnderscore :: Text -> Maybe Text
    parseUnderscore :: Text -> Maybe Text
    parseUnderscore = (Char -> Bool) -> Text -> Maybe Text
    parseSingle (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '_')

    parseDollar :: Text -> Maybe Text
    parseDollar :: Text -> Maybe Text
    parseDollar = (Char -> Bool) -> Text -> Maybe Text
    parseSingle (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '$')

    parseTab :: Text -> Maybe Text
    parseTab :: Text -> Maybe Text
    parseTab = (Char -> Bool) -> Text -> Maybe Text
    parseSingle (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '\t')

    parseBackslash :: Text -> Maybe Text
    parseBackslash :: Text -> Maybe Text
    parseBackslash = (Char -> Bool) -> Text -> Maybe Text
    parseSingle (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '\\')

    failNonEmpty :: Text -> Maybe Text
    failNonEmpty :: Text -> Maybe Text
    failNonEmpty Text
    s | Text -> Bool
    Text.null Text
    s = Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    Text.empty
                   | Bool
    otherwise = Maybe Text
    forall a. Maybe a
    Nothing

    repeatParseN :: (Text -> Maybe Text) -> Text -> Maybe (Int, Text)
    repeatParseN :: (Text -> Maybe Text) -> Text -> Maybe (Int, Text)
    repeatParseN Text -> Maybe Text
    parser = Int -> Text -> Maybe (Int, Text)
    forall {a}. Num a => a -> Text -> Maybe (a, Text)
    go Int
    0
     where
      go :: a -> Text -> Maybe (a, Text)
    go a
    n Text
    s0 =
        case Text -> Maybe Text
    parser Text
    s0 of
          Just Text
    s1 -> a -> Text -> Maybe (a, Text)
    go (a
    na -> a -> a
    forall a. Num a => a -> a -> a
    +a
    1) Text
    s1
          Maybe Text
    Nothing -> (a, Text) -> Maybe (a, Text)
    forall a. a -> Maybe a
    Just (a
    n, Text
    s0)

    repeatParse :: (Text -> Maybe Text) -> Text -> Maybe Text
    repeatParse :: (Text -> Maybe Text) -> Text -> Maybe Text
    repeatParse Text -> Maybe Text
    parser Text
    s0 = (Int, Text) -> Text
    forall a b. (a, b) -> b
    snd ((Int, Text) -> Text) -> Maybe (Int, Text) -> Maybe Text
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Text -> Maybe Text) -> Text -> Maybe (Int, Text)
    repeatParseN Text -> Maybe Text
    parser Text
    s0

    -- | Encodes tuples as "TupN" and removes all characters not matching a
    -- predicate.
    zEncode
      :: (Char -> Bool)
      -- ^ Characters to keep
      -> Text
      -> Text
    zEncode :: (Char -> Bool) -> Text -> Text
    zEncode Char -> Bool
    keep Text
    s =
      let go :: Text -> Text
    go = (Char -> Bool) -> Text -> Text
    zEncode Char -> Bool
    keep in
      case Text -> Maybe (Text, Text)
    maybeTuple Text
    s of
        Just (Text
    tupName, Text
    rest) ->
          Text
    tupName Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text -> Text
    go Text
    rest
        Maybe (Text, Text)
    Nothing ->
          case Text -> Maybe (Char, Text)
    Text.uncons Text
    s of
            Just (Char
    c, Text
    rest) ->
              if Char -> Bool
    keep Char
    c then
                Char -> Text -> Text
    Text.cons Char
    c (Text -> Text
    go Text
    rest)
              else
                Text -> Text
    go Text
    rest
            Maybe (Char, Text)
    Nothing -> Text
    s

    prettyName :: Text -> Text
    prettyName :: Text -> Text
    prettyName Text
    t = Text -> ((Text, Text) -> Text) -> Maybe (Text, Text) -> Text
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Text
    t ((Text -> Text -> Text) -> (Text, Text) -> Text
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    (<>)) (Text -> Maybe (Text, Text)
    maybeTuple Text
    t)

    maybeTuple :: Text -> Maybe (Text, Text)
    maybeTuple :: Text -> Maybe (Text, Text)
    maybeTuple Text
    "(# #)" = (Text, Text) -> Maybe (Text, Text)
    forall a. a -> Maybe a
    Just (Text
    "Unit", Text
    "")
    maybeTuple Text
    "()" = (Text, Text) -> Maybe (Text, Text)
    forall a. a -> Maybe a
    Just (Text
    "Unit", Text
    "")
    maybeTuple Text
    t = (Int -> Text) -> (Int, Text) -> (Text, Text)
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: Type -> Type -> Type) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first (\Int
    n -> Text
    "Tuple" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    showt Int
    n) ((Int, Text) -> (Text, Text))
    -> Maybe (Int, Text) -> Maybe (Text, Text)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text -> Maybe (Int, Text)
    parseTuple Text
    t

    parseTuple :: Text -> Maybe (Int, Text)
    parseTuple :: Text -> Maybe (Int, Text)
    parseTuple Text
    t0 = do
      Text
    t1 <- (Char -> Bool) -> Text -> Maybe Text
    parseSingle (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '(') Text
    t0
      Text
    t2 <- (Char -> Bool) -> Text -> Maybe Text
    parseMaybeSingle (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '#') Text
    t1
      (Int
    n, Text
    t3) <- (Text -> Maybe Text) -> Text -> Maybe (Int, Text)
    repeatParseN ((Char -> Bool) -> Text -> Maybe Text
    parseSingle (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ',')) Text
    t2
      Text
    t4 <- (Char -> Bool) -> Text -> Maybe Text
    parseMaybeSingle (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '#') Text
    t3
      Text
    t5 <- (Char -> Bool) -> Text -> Maybe Text
    parseSingle (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    ')') Text
    t4
      (Int, Text) -> Maybe (Int, Text)
    forall a. a -> Maybe a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1, Text
    t5)