    -- |
    -- Module      :  Cryptol.Parser.Selector
    -- Copyright   :  (c) 2013-2016 Galois, Inc.
    -- License     :  BSD3
    -- Maintainer  :  cryptol@galois.com
    -- Stability   :  provisional
    -- Portability :  portable

    {-# LANGUAGE Safe #-}

    {-# LANGUAGE DeriveAnyClass #-}
    {-# LANGUAGE DeriveGeneric #-}
    {-# LANGUAGE OverloadedStrings #-}
    module Cryptol.Parser.Selector
      ( Selector(..)
      , ppSelector
      , ppNestedSels
      , selName
      ) where

    import GHC.Generics (Generic)
    import Control.DeepSeq
    import Data.List(intersperse)

    import Cryptol.Utils.Ident
    import Cryptol.Utils.PP

    {- | Selectors are used for projecting from various components.
    Each selector has an option spec to specify the shape of the thing
    that is being selected.  Currently, there is no surface syntax for
    list selectors, but they are used during the desugaring of patterns.
    -}

    data Selector = TupleSel Int   (Maybe Int)
                    -- ^ Zero-based tuple selection.
                    -- Optionally specifies the shape of the tuple (one-based).

                  | RecordSel Ident (Maybe [Ident])
                    -- ^ Record selection.
                    -- Optionally specifies the shape of the record.

                  | ListSel Int    (Maybe Int)
                    -- ^ List selection.
                    -- Optionally specifies the length of the list.
                    deriving (Selector -> Selector -> Bool
    (Selector -> Selector -> Bool)
    -> (Selector -> Selector -> Bool) -> Eq Selector
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Selector -> Selector -> Bool
    == :: Selector -> Selector -> Bool
    $c/= :: Selector -> Selector -> Bool
    /= :: Selector -> Selector -> Bool
    Eq, Int -> Selector -> ShowS
    [Selector] -> ShowS
    Selector -> [Char]
    (Int -> Selector -> ShowS)
    -> (Selector -> [Char]) -> ([Selector] -> ShowS) -> Show Selector
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Selector -> ShowS
    showsPrec :: Int -> Selector -> ShowS
    $cshow :: Selector -> [Char]
    show :: Selector -> [Char]
    $cshowList :: [Selector] -> ShowS
    showList :: [Selector] -> ShowS
    Show, Eq Selector
    Eq Selector
    -> (Selector -> Selector -> Ordering)
    -> (Selector -> Selector -> Bool)
    -> (Selector -> Selector -> Bool)
    -> (Selector -> Selector -> Bool)
    -> (Selector -> Selector -> Bool)
    -> (Selector -> Selector -> Selector)
    -> (Selector -> Selector -> Selector)
    -> Ord Selector
    Selector -> Selector -> Bool
    Selector -> Selector -> Ordering
    Selector -> Selector -> Selector
    forall a.
    Eq a
    -> (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Selector -> Selector -> Ordering
    compare :: Selector -> Selector -> Ordering
    $c< :: Selector -> Selector -> Bool
    < :: Selector -> Selector -> Bool
    $c<= :: Selector -> Selector -> Bool
    <= :: Selector -> Selector -> Bool
    $c> :: Selector -> Selector -> Bool
    > :: Selector -> Selector -> Bool
    $c>= :: Selector -> Selector -> Bool
    >= :: Selector -> Selector -> Bool
    $cmax :: Selector -> Selector -> Selector
    max :: Selector -> Selector -> Selector
    $cmin :: Selector -> Selector -> Selector
    min :: Selector -> Selector -> Selector
    Ord, (forall x. Selector -> Rep Selector x)
    -> (forall x. Rep Selector x -> Selector) -> Generic Selector
    forall x. Rep Selector x -> Selector
    forall x. Selector -> Rep Selector x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. Selector -> Rep Selector x
    from :: forall x. Selector -> Rep Selector x
    $cto :: forall x. Rep Selector x -> Selector
    to :: forall x. Rep Selector x -> Selector
    Generic, Selector -> ()
    (Selector -> ()) -> NFData Selector
    forall a. (a -> ()) -> NFData a
    $crnf :: Selector -> ()
    rnf :: Selector -> ()
    NFData)

    instance PP Selector where
      ppPrec :: Int -> Selector -> Doc
    ppPrec Int
    _ Selector
    sel =
        case Selector
    sel of
          TupleSel Int
    x Maybe Int
    sig   -> [Doc] -> Doc
    sep (Int -> Doc
    int Int
    x Doc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    : (Int -> Doc) -> Maybe Int -> [Doc]
    forall {t}. (t -> Doc) -> Maybe t -> [Doc]
    ppSig Int -> Doc
    tupleSig Maybe Int
    sig)
          RecordSel Ident
    x Maybe [Ident]
    sig  -> [Doc] -> Doc
    sep (Ident -> Doc
    forall a. PP a => a -> Doc
    pp Ident
    x  Doc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    : ([Ident] -> Doc) -> Maybe [Ident] -> [Doc]
    forall {t}. (t -> Doc) -> Maybe t -> [Doc]
    ppSig [Ident] -> Doc
    forall {a}. PP a => [a] -> Doc
    recordSig Maybe [Ident]
    sig)
          ListSel Int
    x Maybe Int
    sig    -> [Doc] -> Doc
    sep (Int -> Doc
    int Int
    x Doc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    : (Int -> Doc) -> Maybe Int -> [Doc]
    forall {t}. (t -> Doc) -> Maybe t -> [Doc]
    ppSig Int -> Doc
    listSig Maybe Int
    sig)

        where
        tupleSig :: Int -> Doc
    tupleSig Int
    n   = Int -> Doc
    int Int
    n
        recordSig :: [a] -> Doc
    recordSig [a]
    xs = [Doc] -> Doc
    ppRecord ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $ (a -> Doc) -> [a] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> Doc
    forall a. PP a => a -> Doc
    pp [a]
    xs
        listSig :: Int -> Doc
    listSig Int
    n    = Int -> Doc
    int Int
    n

        ppSig :: (t -> Doc) -> Maybe t -> [Doc]
    ppSig t -> Doc
    f = [Doc] -> (t -> [Doc]) -> Maybe t -> [Doc]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] (\t
    x -> [[Char] -> Doc
    text [Char]
    "/* of" Doc -> Doc -> Doc
    <+> t -> Doc
    f t
    x Doc -> Doc -> Doc
    <+> [Char] -> Doc
    text [Char]
    "*/"])

    -- | Display the thing selected by the selector, nicely.
    ppSelector :: Selector -> Doc
    ppSelector :: Selector -> Doc
    ppSelector Selector
    sel =
      case Selector
    sel of
        TupleSel Int
    x Maybe Int
    _  -> Int -> Doc
    forall a. (Integral a, Show a, Eq a) => a -> Doc
    ordinal (Int
    xInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) Doc -> Doc -> Doc
    <+> [Char] -> Doc
    text [Char]
    "field"
        RecordSel Ident
    x Maybe [Ident]
    _ -> [Char] -> Doc
    text [Char]
    "field" Doc -> Doc -> Doc
    <+> Ident -> Doc
    forall a. PP a => a -> Doc
    pp Ident
    x
        ListSel Int
    x Maybe Int
    _   -> Int -> Doc
    forall a. (Integral a, Show a, Eq a) => a -> Doc
    ordinal Int
    x Doc -> Doc -> Doc
    <+> [Char] -> Doc
    text [Char]
    "element"

    -- | The name of a selector (e.g., used in update code)
    selName :: Selector -> Ident
    selName :: Selector -> Ident
    selName Selector
    s =
      case Selector
    s of
        RecordSel Ident
    i Maybe [Ident]
    _ -> Ident
    i
        TupleSel Int
    n Maybe Int
    _  -> [Char] -> Ident
    packIdent ([Char]
    "_" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    n)
        ListSel Int
    n Maybe Int
    _   -> [Char] -> Ident
    packIdent ([Char]
    "__" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    n)

    -- | Show a list of selectors as they appear in a nested selector in an update.
    ppNestedSels :: [Selector] -> Doc
    ppNestedSels :: [Selector] -> Doc
    ppNestedSels = [Doc] -> Doc
    hcat ([Doc] -> Doc) -> ([Selector] -> [Doc]) -> [Selector] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    intersperse Doc
    "." ([Doc] -> [Doc]) -> ([Selector] -> [Doc]) -> [Selector] -> [Doc]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Selector -> Doc) -> [Selector] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map Selector -> Doc
    ppS
      where ppS :: Selector -> Doc
    ppS Selector
    s = case Selector
    s of
                      RecordSel Ident
    i Maybe [Ident]
    _ -> [Char] -> Doc
    text (Ident -> [Char]
    unpackIdent Ident
    i)
                      TupleSel Int
    n Maybe Int
    _ -> Int -> Doc
    int Int
    n
                      ListSel Int
    n Maybe Int
    _  -> Doc -> Doc
    brackets (Int -> Doc
    int Int
    n) -- not in source