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

    {-# LANGUAGE Safe #-}

    {-# LANGUAGE DeriveAnyClass #-}
    {-# LANGUAGE DeriveGeneric #-}
    {-# LANGUAGE RecordWildCards #-}
    module Cryptol.Parser.Position where

    import           Data.Text(Text)
    import qualified Data.Text as T

    import GHC.Generics (Generic)
    import Control.DeepSeq

    import Cryptol.Utils.PP

    data Located a  = Located { Located a -> Range
    srcRange :: !Range, Located a -> a
    thing :: !a }
                      deriving (Located a -> Located a -> Bool
    (Located a -> Located a -> Bool)
    -> (Located a -> Located a -> Bool) -> Eq (Located a)
    forall a. Eq a => Located a -> Located a -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Located a -> Located a -> Bool
    $c/= :: forall a. Eq a => Located a -> Located a -> Bool
    == :: Located a -> Located a -> Bool
    $c== :: forall a. Eq a => Located a -> Located a -> Bool
    Eq, Int -> Located a -> ShowS
    [Located a] -> ShowS
    Located a -> String
    (Int -> Located a -> ShowS)
    -> (Located a -> String)
    -> ([Located a] -> ShowS)
    -> Show (Located a)
    forall a. Show a => Int -> Located a -> ShowS
    forall a. Show a => [Located a] -> ShowS
    forall a. Show a => Located a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [Located a] -> ShowS
    $cshowList :: forall a. Show a => [Located a] -> ShowS
    show :: Located a -> String
    $cshow :: forall a. Show a => Located a -> String
    showsPrec :: Int -> Located a -> ShowS
    $cshowsPrec :: forall a. Show a => Int -> Located a -> ShowS
    Show, (forall x. Located a -> Rep (Located a) x)
    -> (forall x. Rep (Located a) x -> Located a)
    -> Generic (Located a)
    forall x. Rep (Located a) x -> Located a
    forall x. Located a -> Rep (Located a) x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    forall a x. Rep (Located a) x -> Located a
    forall a x. Located a -> Rep (Located a) x
    $cto :: forall a x. Rep (Located a) x -> Located a
    $cfrom :: forall a x. Located a -> Rep (Located a) x
    Generic, Located a -> ()
    (Located a -> ()) -> NFData (Located a)
    forall a. NFData a => Located a -> ()
    forall a. (a -> ()) -> NFData a
    rnf :: Located a -> ()
    $crnf :: forall a. NFData a => Located a -> ()
    NFData)

    data Position   = Position { Position -> Int
    line :: !Int, Position -> Int
    col :: !Int }
                      deriving (Position -> Position -> Bool
    (Position -> Position -> Bool)
    -> (Position -> Position -> Bool) -> Eq Position
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Position -> Position -> Bool
    $c/= :: Position -> Position -> Bool
    == :: Position -> Position -> Bool
    $c== :: Position -> Position -> Bool
    Eq, Eq Position
    Eq Position =>
    (Position -> Position -> Ordering)
    -> (Position -> Position -> Bool)
    -> (Position -> Position -> Bool)
    -> (Position -> Position -> Bool)
    -> (Position -> Position -> Bool)
    -> (Position -> Position -> Position)
    -> (Position -> Position -> Position)
    -> Ord Position
    Position -> Position -> Bool
    Position -> Position -> Ordering
    Position -> Position -> Position
    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
    min :: Position -> Position -> Position
    $cmin :: Position -> Position -> Position
    max :: Position -> Position -> Position
    $cmax :: Position -> Position -> Position
    >= :: Position -> Position -> Bool
    $c>= :: Position -> Position -> Bool
    > :: Position -> Position -> Bool
    $c> :: Position -> Position -> Bool
    <= :: Position -> Position -> Bool
    $c<= :: Position -> Position -> Bool
    < :: Position -> Position -> Bool
    $c< :: Position -> Position -> Bool
    compare :: Position -> Position -> Ordering
    $ccompare :: Position -> Position -> Ordering
    $cp1Ord :: Eq Position
    Ord, Int -> Position -> ShowS
    [Position] -> ShowS
    Position -> String
    (Int -> Position -> ShowS)
    -> (Position -> String) -> ([Position] -> ShowS) -> Show Position
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [Position] -> ShowS
    $cshowList :: [Position] -> ShowS
    show :: Position -> String
    $cshow :: Position -> String
    showsPrec :: Int -> Position -> ShowS
    $cshowsPrec :: Int -> Position -> ShowS
    Show, (forall x. Position -> Rep Position x)
    -> (forall x. Rep Position x -> Position) -> Generic Position
    forall x. Rep Position x -> Position
    forall x. Position -> Rep Position x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cto :: forall x. Rep Position x -> Position
    $cfrom :: forall x. Position -> Rep Position x
    Generic, Position -> ()
    (Position -> ()) -> NFData Position
    forall a. (a -> ()) -> NFData a
    rnf :: Position -> ()
    $crnf :: Position -> ()
    NFData)

    data Range      = Range { Range -> Position
    from   :: !Position
                            , Range -> Position
    to     :: !Position
                            , Range -> String
    source :: FilePath }
                      deriving (Range -> Range -> Bool
    (Range -> Range -> Bool) -> (Range -> Range -> Bool) -> Eq Range
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Range -> Range -> Bool
    $c/= :: Range -> Range -> Bool
    == :: Range -> Range -> Bool
    $c== :: Range -> Range -> Bool
    Eq, Int -> Range -> ShowS
    [Range] -> ShowS
    Range -> String
    (Int -> Range -> ShowS)
    -> (Range -> String) -> ([Range] -> ShowS) -> Show Range
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [Range] -> ShowS
    $cshowList :: [Range] -> ShowS
    show :: Range -> String
    $cshow :: Range -> String
    showsPrec :: Int -> Range -> ShowS
    $cshowsPrec :: Int -> Range -> ShowS
    Show, (forall x. Range -> Rep Range x)
    -> (forall x. Rep Range x -> Range) -> Generic Range
    forall x. Rep Range x -> Range
    forall x. Range -> Rep Range x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cto :: forall x. Rep Range x -> Range
    $cfrom :: forall x. Range -> Rep Range x
    Generic, Range -> ()
    (Range -> ()) -> NFData Range
    forall a. (a -> ()) -> NFData a
    rnf :: Range -> ()
    $crnf :: Range -> ()
    NFData)

    -- | An empty range.
    --
    -- Caution: using this on the LHS of a use of rComb will cause the empty source
    -- to propagate.
    emptyRange :: Range
    emptyRange :: Range
    emptyRange  = $WRange :: Position -> Position -> String -> Range
    Range { from :: Position
    from = Position
    start, to :: Position
    to = Position
    start, source :: String
    source = "" }

    start :: Position
    start :: Position
    start = $WPosition :: Int -> Int -> Position
    Position { line :: Int
    line = 1, col :: Int
    col = 1 }

    move :: Position -> Char -> Position
    move :: Position -> Char -> Position
    move p :: Position
    p c :: Char
    c = case Char
    c of
                '\t' -> Position
    p { col :: Int
    col = ((Position -> Int
    col Position
    p Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 7) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` 8) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * 8 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1 }
                '\n' -> Position
    p { col :: Int
    col = 1, line :: Int
    line = 1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Position -> Int
    line Position
    p }
                _    -> Position
    p { col :: Int
    col = 1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Position -> Int
    col Position
    p }

    moves :: Position -> Text -> Position
    moves :: Position -> Text -> Position
    moves p :: Position
    p cs :: Text
    cs = (Position -> Char -> Position) -> Position -> Text -> Position
    forall a. (a -> Char -> a) -> a -> Text -> a
    T.foldl' Position -> Char -> Position
    move Position
    p Text
    cs

    rComb :: Range -> Range -> Range
    rComb :: Range -> Range -> Range
    rComb r1 :: Range
    r1 r2 :: Range
    r2  = $WRange :: Position -> Position -> String -> Range
    Range { from :: Position
    from = Position
    rFrom, to :: Position
    to = Position
    rTo, source :: String
    source = Range -> String
    source Range
    r1 }
      where rFrom :: Position
    rFrom = Position -> Position -> Position
    forall a. Ord a => a -> a -> a
    min (Range -> Position
    from Range
    r1) (Range -> Position
    from Range
    r2)
            rTo :: Position
    rTo   = Position -> Position -> Position
    forall a. Ord a => a -> a -> a
    max (Range -> Position
    to Range
    r1)   (Range -> Position
    to Range
    r2)

    rCombs :: [Range] -> Range
    rCombs :: [Range] -> Range
    rCombs  = (Range -> Range -> Range) -> [Range] -> Range
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldl1 Range -> Range -> Range
    rComb

    instance Functor Located where
      fmap :: (a -> b) -> Located a -> Located b
    fmap f :: a -> b
    f l :: Located a
    l = Located a
    l { thing :: b
    thing = a -> b
    f (Located a -> a
    forall a. Located a -> a
    thing Located a
    l) }

    --------------------------------------------------------------------------------

    instance PP Position where
      ppPrec :: Int -> Position -> Doc
    ppPrec _ p :: Position
    p = Int -> Doc
    int (Position -> Int
    line Position
    p) Doc -> Doc -> Doc
    <.> Doc
    colon Doc -> Doc -> Doc
    <.> Int -> Doc
    int (Position -> Int
    col Position
    p)

    instance PP Range where
      ppPrec :: Int -> Range -> Doc
    ppPrec _ r :: Range
    r = String -> Doc
    text (Range -> String
    source Range
    r) Doc -> Doc -> Doc
    <.> Char -> Doc
    char ':'
                Doc -> Doc -> Doc
    <.> Position -> Doc
    forall a. PP a => a -> Doc
    pp (Range -> Position
    from Range
    r) Doc -> Doc -> Doc
    <.> String -> Doc
    text "--" Doc -> Doc -> Doc
    <.> Position -> Doc
    forall a. PP a => a -> Doc
    pp (Range -> Position
    to Range
    r)

    instance PP a => PP (Located a) where
      ppPrec :: Int -> Located a -> Doc
    ppPrec _ l :: Located a
    l = Doc -> Doc
    parens (String -> Doc
    text "at" Doc -> Doc -> Doc
    <+> Range -> Doc
    forall a. PP a => a -> Doc
    pp (Located a -> Range
    forall a. Located a -> Range
    srcRange Located a
    l) Doc -> Doc -> Doc
    <.> Doc
    comma Doc -> Doc -> Doc
    <+> a -> Doc
    forall a. PP a => a -> Doc
    pp (Located a -> a
    forall a. Located a -> a
    thing Located a
    l))

    instance PPName a => PPName (Located a) where
      ppNameFixity :: Located a -> Maybe (Assoc, Int)
    ppNameFixity  Located { .. } = a -> Maybe (Assoc, Int)
    forall a. PPName a => a -> Maybe (Assoc, Int)
    ppNameFixity a
    thing
      ppPrefixName :: Located a -> Doc
    ppPrefixName  Located { .. } = a -> Doc
    forall a. PPName a => a -> Doc
    ppPrefixName a
    thing
      ppInfixName :: Located a -> Doc
    ppInfixName   Located { .. } = a -> Doc
    forall a. PPName a => a -> Doc
    ppInfixName  a
    thing

    --------------------------------------------------------------------------------

    class HasLoc t where
      getLoc :: t -> Maybe Range

    instance HasLoc Range where
      getLoc :: Range -> Maybe Range
    getLoc r :: Range
    r = Range -> Maybe Range
    forall a. a -> Maybe a
    Just Range
    r

    instance HasLoc (Located a) where
      getLoc :: Located a -> Maybe Range
    getLoc r :: Located a
    r = Range -> Maybe Range
    forall a. a -> Maybe a
    Just (Located a -> Range
    forall a. Located a -> Range
    srcRange Located a
    r)

    instance (HasLoc a, HasLoc b) => HasLoc (a,b) where
      getLoc :: (a, b) -> Maybe Range
    getLoc (f :: a
    f,t :: b
    t) = case a -> Maybe Range
    forall t. HasLoc t => t -> Maybe Range
    getLoc a
    f of
                       Nothing -> b -> Maybe Range
    forall t. HasLoc t => t -> Maybe Range
    getLoc b
    t
                       Just l :: Range
    l ->
                          case b -> Maybe Range
    forall t. HasLoc t => t -> Maybe Range
    getLoc b
    t of
                            Nothing -> Range -> Maybe Range
    forall (m :: * -> *) a. Monad m => a -> m a
    return Range
    l
                            Just l1 :: Range
    l1 -> Range -> Maybe Range
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Range -> Range -> Range
    rComb Range
    l Range
    l1)

    instance HasLoc a => HasLoc [a] where
      getLoc :: [a] -> Maybe Range
    getLoc = Maybe Range -> [a] -> Maybe Range
    forall t. HasLoc t => Maybe Range -> [t] -> Maybe Range
    go Maybe Range
    forall a. Maybe a
    Nothing
        where
        go :: Maybe Range -> [t] -> Maybe Range
    go x :: Maybe Range
    x [] = Maybe Range
    x
        go Nothing (x :: t
    x : xs :: [t]
    xs)  = Maybe Range -> [t] -> Maybe Range
    go (t -> Maybe Range
    forall t. HasLoc t => t -> Maybe Range
    getLoc t
    x) [t]
    xs
        go (Just l :: Range
    l) (x :: t
    x : xs :: [t]
    xs) = case t -> Maybe Range
    forall t. HasLoc t => t -> Maybe Range
    getLoc t
    x of
                                 Nothing -> Maybe Range -> [t] -> Maybe Range
    go (Range -> Maybe Range
    forall a. a -> Maybe a
    Just Range
    l) [t]
    xs
                                 Just l1 :: Range
    l1 -> Maybe Range -> [t] -> Maybe Range
    go (Range -> Maybe Range
    forall a. a -> Maybe a
    Just (Range -> Range -> Range
    rComb Range
    l Range
    l1)) [t]
    xs

    class HasLoc t => AddLoc t where
      addLoc  :: t -> Range -> t
      dropLoc :: t -> t

    instance AddLoc (Located a) where
      addLoc :: Located a -> Range -> Located a
    addLoc t :: Located a
    t r :: Range
    r = Located a
    t { srcRange :: Range
    srcRange = Range
    r }
      dropLoc :: Located a -> Located a
    dropLoc r :: Located a
    r  = Located a
    r

    at :: (HasLoc l, AddLoc t) => l -> t -> t
    at :: l -> t -> t
    at l :: l
    l e :: t
    e = t -> (Range -> t) -> Maybe Range -> t
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe t
    e (t -> Range -> t
    forall t. AddLoc t => t -> Range -> t
    addLoc t
    e) (l -> Maybe Range
    forall t. HasLoc t => t -> Maybe Range
    getLoc l
    l)

    combLoc :: (a -> b -> c) -> Located a -> Located b -> Located c
    combLoc :: (a -> b -> c) -> Located a -> Located b -> Located c
    combLoc f :: a -> b -> c
    f l1 :: Located a
    l1 l2 :: Located b
    l2 = $WLocated :: forall a. Range -> a -> Located a
    Located { srcRange :: Range
    srcRange = Range -> Range -> Range
    rComb (Located a -> Range
    forall a. Located a -> Range
    srcRange Located a
    l1) (Located b -> Range
    forall a. Located a -> Range
    srcRange Located b
    l2)
                              , thing :: c
    thing    = a -> b -> c
    f (Located a -> a
    forall a. Located a -> a
    thing Located a
    l1) (Located b -> b
    forall a. Located a -> a
    thing Located b
    l2)
                              }