    {-# OPTIONS_HADDOCK not-home #-}
    {-# LANGUAGE DeriveFunctor #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE CPP #-}
    module Hedgehog.Internal.Discovery (
        PropertySource(..)
      , readProperties
      , findProperties
      , readDeclaration

      , Pos(..)
      , Position(..)
      ) where

    import           Control.Exception (IOException, handle)
    import           Control.Monad.IO.Class (MonadIO(..))

    import qualified Data.Char as Char
    import qualified Data.List as List
    import           Data.Map (Map)
    import qualified Data.Map as Map
    import qualified Data.Ord as Ord

    import           Hedgehog.Internal.Property (PropertyName(..))
    import           Hedgehog.Internal.Source (LineNo(..), ColumnNo(..))

    #if __GLASGOW_HASKELL__ < 808
    import           Data.Semigroup (Semigroup(..))
    #endif

    ------------------------------------------------------------------------
    -- Property Extraction

    newtype PropertySource =
      PropertySource {
          PropertySource -> Pos String
    propertySource :: Pos String
        } deriving (PropertySource -> PropertySource -> Bool
    (PropertySource -> PropertySource -> Bool)
    -> (PropertySource -> PropertySource -> Bool) -> Eq PropertySource
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: PropertySource -> PropertySource -> Bool
    == :: PropertySource -> PropertySource -> Bool
    $c/= :: PropertySource -> PropertySource -> Bool
    /= :: PropertySource -> PropertySource -> Bool
    Eq, Eq PropertySource
    Eq PropertySource =>
    (PropertySource -> PropertySource -> Ordering)
    -> (PropertySource -> PropertySource -> Bool)
    -> (PropertySource -> PropertySource -> Bool)
    -> (PropertySource -> PropertySource -> Bool)
    -> (PropertySource -> PropertySource -> Bool)
    -> (PropertySource -> PropertySource -> PropertySource)
    -> (PropertySource -> PropertySource -> PropertySource)
    -> Ord PropertySource
    PropertySource -> PropertySource -> Bool
    PropertySource -> PropertySource -> Ordering
    PropertySource -> PropertySource -> PropertySource
    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 :: PropertySource -> PropertySource -> Ordering
    compare :: PropertySource -> PropertySource -> Ordering
    $c< :: PropertySource -> PropertySource -> Bool
    < :: PropertySource -> PropertySource -> Bool
    $c<= :: PropertySource -> PropertySource -> Bool
    <= :: PropertySource -> PropertySource -> Bool
    $c> :: PropertySource -> PropertySource -> Bool
    > :: PropertySource -> PropertySource -> Bool
    $c>= :: PropertySource -> PropertySource -> Bool
    >= :: PropertySource -> PropertySource -> Bool
    $cmax :: PropertySource -> PropertySource -> PropertySource
    max :: PropertySource -> PropertySource -> PropertySource
    $cmin :: PropertySource -> PropertySource -> PropertySource
    min :: PropertySource -> PropertySource -> PropertySource
    Ord, Int -> PropertySource -> ShowS
    [PropertySource] -> ShowS
    PropertySource -> String
    (Int -> PropertySource -> ShowS)
    -> (PropertySource -> String)
    -> ([PropertySource] -> ShowS)
    -> Show PropertySource
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> PropertySource -> ShowS
    showsPrec :: Int -> PropertySource -> ShowS
    $cshow :: PropertySource -> String
    show :: PropertySource -> String
    $cshowList :: [PropertySource] -> ShowS
    showList :: [PropertySource] -> ShowS
    Show)

    readProperties :: MonadIO m => String -> FilePath -> m (Map PropertyName PropertySource)
    readProperties :: forall (m :: * -> *).
    MonadIO m =>
    String -> String -> m (Map PropertyName PropertySource)
    readProperties String
    prefix String
    path =
      String -> String -> String -> Map PropertyName PropertySource
    findProperties String
    prefix String
    path (String -> Map PropertyName PropertySource)
    -> m String -> m (Map PropertyName PropertySource)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO String -> m String
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (String -> IO String
    readFile String
    path)

    readDeclaration :: MonadIO m => FilePath -> LineNo -> m (Maybe (String, Pos String))
    readDeclaration :: forall (m :: * -> *).
    MonadIO m =>
    String -> LineNo -> m (Maybe (String, Pos String))
    readDeclaration String
    path LineNo
    line = do
      mfile <- IO (Maybe String) -> m (Maybe String)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Maybe String) -> m (Maybe String))
    -> IO (Maybe String) -> m (Maybe String)
    forall a b. (a -> b) -> a -> b
    $ String -> IO (Maybe String)
    forall (m :: * -> *). MonadIO m => String -> m (Maybe String)
    readFileSafe String
    path
      pure $ do
        file <- mfile
        takeHead .
          List.sortBy (Ord.comparing $ Ord.Down . posLine . posPostion . snd) .
          filter ((<= line) . posLine . posPostion . snd) $
          Map.toList (findDeclarations path file)

    readFileSafe :: MonadIO m => FilePath -> m (Maybe String)
    readFileSafe :: forall (m :: * -> *). MonadIO m => String -> m (Maybe String)
    readFileSafe String
    path =
      IO (Maybe String) -> m (Maybe String)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Maybe String) -> m (Maybe String))
    -> IO (Maybe String) -> m (Maybe String)
    forall a b. (a -> b) -> a -> b
    $
        (IOException -> IO (Maybe String))
    -> IO (Maybe String) -> IO (Maybe String)
    forall e a. Exception e => (e -> IO a) -> IO a -> IO a
    handle (\(IOException
    _ :: IOException) -> Maybe String -> IO (Maybe String)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe String
    forall a. Maybe a
    Nothing) (String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> IO String -> IO (Maybe String)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO String
    readFile String
    path)

    takeHead :: [a] -> Maybe a
    takeHead :: forall a. [a] -> Maybe a
    takeHead = \case
      [] ->
        Maybe a
    forall a. Maybe a
    Nothing
      a
    x : [a]
    _ ->
        a -> Maybe a
    forall a. a -> Maybe a
    Just a
    x

    findProperties :: String -> FilePath -> String -> Map PropertyName PropertySource
    findProperties :: String -> String -> String -> Map PropertyName PropertySource
    findProperties String
    prefix String
    path =
      (Pos String -> PropertySource)
    -> Map PropertyName (Pos String) -> Map PropertyName PropertySource
    forall a b k. (a -> b) -> Map k a -> Map k b
    Map.map Pos String -> PropertySource
    PropertySource (Map PropertyName (Pos String) -> Map PropertyName PropertySource)
    -> (String -> Map PropertyName (Pos String))
    -> String
    -> Map PropertyName PropertySource
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      (String -> PropertyName)
    -> Map String (Pos String) -> Map PropertyName (Pos String)
    forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
    Map.mapKeysMonotonic String -> PropertyName
    PropertyName (Map String (Pos String) -> Map PropertyName (Pos String))
    -> (String -> Map String (Pos String))
    -> String
    -> Map PropertyName (Pos String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      (String -> Pos String -> Bool)
    -> Map String (Pos String) -> Map String (Pos String)
    forall k a. (k -> a -> Bool) -> Map k a -> Map k a
    Map.filterWithKey (\String
    k Pos String
    _ -> String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    List.isPrefixOf String
    prefix String
    k) (Map String (Pos String) -> Map String (Pos String))
    -> (String -> Map String (Pos String))
    -> String
    -> Map String (Pos String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      String -> String -> Map String (Pos String)
    findDeclarations String
    path

    findDeclarations :: FilePath -> String -> Map String (Pos String)
    findDeclarations :: String -> String -> Map String (Pos String)
    findDeclarations String
    path =
      [Classified (Pos Char)] -> Map String (Pos String)
    declarations ([Classified (Pos Char)] -> Map String (Pos String))
    -> (String -> [Classified (Pos Char)])
    -> String
    -> Map String (Pos String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      [Pos Char] -> [Classified (Pos Char)]
    classified ([Pos Char] -> [Classified (Pos Char)])
    -> (String -> [Pos Char]) -> String -> [Classified (Pos Char)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      String -> String -> [Pos Char]
    positioned String
    path

    ------------------------------------------------------------------------
    -- Declaration Identification

    declarations :: [Classified (Pos Char)] -> Map String (Pos String)
    declarations :: [Classified (Pos Char)] -> Map String (Pos String)
    declarations =
      let
        loop :: [Classified (Pos Char)] -> [(String, Pos String)]
    loop = \case
          [] ->
            []
          Classified (Pos Char)
    x : [Classified (Pos Char)]
    xs ->
            let
              ([Classified (Pos Char)]
    ys, [Classified (Pos Char)]
    zs) =
                (Classified (Pos Char) -> Bool)
    -> [Classified (Pos Char)]
    -> ([Classified (Pos Char)], [Classified (Pos Char)])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break Classified (Pos Char) -> Bool
    isDeclaration [Classified (Pos Char)]
    xs
            in
              Pos String -> (String, Pos String)
    tagWithName (Classified (Pos Char) -> [Classified (Pos Char)] -> Pos String
    forget Classified (Pos Char)
    x ([Classified (Pos Char)] -> Pos String)
    -> [Classified (Pos Char)] -> Pos String
    forall a b. (a -> b) -> a -> b
    $ [Classified (Pos Char)] -> [Classified (Pos Char)]
    trimEnd [Classified (Pos Char)]
    ys) (String, Pos String)
    -> [(String, Pos String)] -> [(String, Pos String)]
    forall a. a -> [a] -> [a]
    : [Classified (Pos Char)] -> [(String, Pos String)]
    loop [Classified (Pos Char)]
    zs
      in
        (Pos String -> Pos String -> Pos String)
    -> [(String, Pos String)] -> Map String (Pos String)
    forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
    Map.fromListWith Pos String -> Pos String -> Pos String
    forall a. Semigroup a => a -> a -> a
    (<>) ([(String, Pos String)] -> Map String (Pos String))
    -> ([Classified (Pos Char)] -> [(String, Pos String)])
    -> [Classified (Pos Char)]
    -> Map String (Pos String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Classified (Pos Char)] -> [(String, Pos String)]
    loop ([Classified (Pos Char)] -> [(String, Pos String)])
    -> ([Classified (Pos Char)] -> [Classified (Pos Char)])
    -> [Classified (Pos Char)]
    -> [(String, Pos String)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Classified (Pos Char) -> Bool)
    -> [Classified (Pos Char)] -> [Classified (Pos Char)]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Bool -> Bool
    not (Bool -> Bool)
    -> (Classified (Pos Char) -> Bool) -> Classified (Pos Char) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Classified (Pos Char) -> Bool
    isDeclaration)

    trimEnd :: [Classified (Pos Char)] -> [Classified (Pos Char)]
    trimEnd :: [Classified (Pos Char)] -> [Classified (Pos Char)]
    trimEnd [Classified (Pos Char)]
    xs =
      let
        ([Classified (Pos Char)]
    space0, [Classified (Pos Char)]
    code) =
          (Classified (Pos Char) -> Bool)
    -> [Classified (Pos Char)]
    -> ([Classified (Pos Char)], [Classified (Pos Char)])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span Classified (Pos Char) -> Bool
    isWhitespace ([Classified (Pos Char)]
     -> ([Classified (Pos Char)], [Classified (Pos Char)]))
    -> [Classified (Pos Char)]
    -> ([Classified (Pos Char)], [Classified (Pos Char)])
    forall a b. (a -> b) -> a -> b
    $ [Classified (Pos Char)] -> [Classified (Pos Char)]
    forall a. [a] -> [a]
    reverse [Classified (Pos Char)]
    xs

        ([Classified (Pos Char)]
    line_tail0, [Classified (Pos Char)]
    space) =
          (Classified (Pos Char) -> Bool)
    -> [Classified (Pos Char)]
    -> ([Classified (Pos Char)], [Classified (Pos Char)])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span (\(Classified Class
    _ (Pos Position
    _ Char
    x)) -> Char
    x Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\n') ([Classified (Pos Char)]
     -> ([Classified (Pos Char)], [Classified (Pos Char)]))
    -> [Classified (Pos Char)]
    -> ([Classified (Pos Char)], [Classified (Pos Char)])
    forall a b. (a -> b) -> a -> b
    $
          [Classified (Pos Char)] -> [Classified (Pos Char)]
    forall a. [a] -> [a]
    reverse [Classified (Pos Char)]
    space0

        line_tail :: [Classified (Pos Char)]
    line_tail =
          case [Classified (Pos Char)]
    space of
            [] ->
              [Classified (Pos Char)]
    line_tail0
            Classified (Pos Char)
    x : [Classified (Pos Char)]
    _ ->
              [Classified (Pos Char)]
    line_tail0 [Classified (Pos Char)]
    -> [Classified (Pos Char)] -> [Classified (Pos Char)]
    forall a. [a] -> [a] -> [a]
    ++ [Classified (Pos Char)
    x]
      in
        [Classified (Pos Char)] -> [Classified (Pos Char)]
    forall a. [a] -> [a]
    reverse [Classified (Pos Char)]
    code [Classified (Pos Char)]
    -> [Classified (Pos Char)] -> [Classified (Pos Char)]
    forall a. [a] -> [a] -> [a]
    ++ [Classified (Pos Char)]
    line_tail

    isWhitespace :: Classified (Pos Char) -> Bool
    isWhitespace :: Classified (Pos Char) -> Bool
    isWhitespace (Classified Class
    c (Pos Position
    _ Char
    x)) =
      Class
    c Class -> Class -> Bool
    forall a. Eq a => a -> a -> Bool
    == Class
    Comment Bool -> Bool -> Bool
    ||
      Char -> Bool
    Char.isSpace Char
    x

    tagWithName :: Pos String -> (String, Pos String)
    tagWithName :: Pos String -> (String, Pos String)
    tagWithName (Pos Position
    p String
    x) =
      (ShowS
    takeName String
    x, Position -> String -> Pos String
    forall a. Position -> a -> Pos a
    Pos Position
    p String
    x)

    takeName :: String -> String
    takeName :: ShowS
    takeName String
    xs =
      case String -> [String]
    words String
    xs of
        [] ->
          String
    ""
        String
    x : [String]
    _ ->
          String
    x

    forget :: Classified (Pos Char) -> [Classified (Pos Char)] -> Pos String
    forget :: Classified (Pos Char) -> [Classified (Pos Char)] -> Pos String
    forget (Classified Class
    _ (Pos Position
    p Char
    x)) [Classified (Pos Char)]
    xs =
      Position -> String -> Pos String
    forall a. Position -> a -> Pos a
    Pos Position
    p (String -> Pos String) -> String -> Pos String
    forall a b. (a -> b) -> a -> b
    $
        Char
    x Char -> ShowS
    forall a. a -> [a] -> [a]
    : (Classified (Pos Char) -> Char)
    -> [Classified (Pos Char)] -> String
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Pos Char -> Char
    forall a. Pos a -> a
    posValue (Pos Char -> Char)
    -> (Classified (Pos Char) -> Pos Char)
    -> Classified (Pos Char)
    -> Char
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Classified (Pos Char) -> Pos Char
    forall a. Classified a -> a
    classifiedValue) [Classified (Pos Char)]
    xs

    isDeclaration :: Classified (Pos Char) -> Bool
    isDeclaration :: Classified (Pos Char) -> Bool
    isDeclaration (Classified Class
    c (Pos Position
    p Char
    x)) =
      Class
    c Class -> Class -> Bool
    forall a. Eq a => a -> a -> Bool
    == Class
    NotComment Bool -> Bool -> Bool
    &&
      Position -> ColumnNo
    posColumn Position
    p ColumnNo -> ColumnNo -> Bool
    forall a. Eq a => a -> a -> Bool
    == ColumnNo
    1 Bool -> Bool -> Bool
    &&
      (Char -> Bool
    Char.isLower Char
    x Bool -> Bool -> Bool
    || Char
    x Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '_')

    ------------------------------------------------------------------------
    -- Comment Classification

    data Class =
        NotComment
      | Comment
        deriving (Class -> Class -> Bool
    (Class -> Class -> Bool) -> (Class -> Class -> Bool) -> Eq Class
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Class -> Class -> Bool
    == :: Class -> Class -> Bool
    $c/= :: Class -> Class -> Bool
    /= :: Class -> Class -> Bool
    Eq, Eq Class
    Eq Class =>
    (Class -> Class -> Ordering)
    -> (Class -> Class -> Bool)
    -> (Class -> Class -> Bool)
    -> (Class -> Class -> Bool)
    -> (Class -> Class -> Bool)
    -> (Class -> Class -> Class)
    -> (Class -> Class -> Class)
    -> Ord Class
    Class -> Class -> Bool
    Class -> Class -> Ordering
    Class -> Class -> Class
    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 :: Class -> Class -> Ordering
    compare :: Class -> Class -> Ordering
    $c< :: Class -> Class -> Bool
    < :: Class -> Class -> Bool
    $c<= :: Class -> Class -> Bool
    <= :: Class -> Class -> Bool
    $c> :: Class -> Class -> Bool
    > :: Class -> Class -> Bool
    $c>= :: Class -> Class -> Bool
    >= :: Class -> Class -> Bool
    $cmax :: Class -> Class -> Class
    max :: Class -> Class -> Class
    $cmin :: Class -> Class -> Class
    min :: Class -> Class -> Class
    Ord, Int -> Class -> ShowS
    [Class] -> ShowS
    Class -> String
    (Int -> Class -> ShowS)
    -> (Class -> String) -> ([Class] -> ShowS) -> Show Class
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Class -> ShowS
    showsPrec :: Int -> Class -> ShowS
    $cshow :: Class -> String
    show :: Class -> String
    $cshowList :: [Class] -> ShowS
    showList :: [Class] -> ShowS
    Show)

    data Classified a =
      Classified {
          forall a. Classified a -> Class
    _classifiedClass :: !Class
        , forall a. Classified a -> a
    classifiedValue :: !a
        } deriving (Classified a -> Classified a -> Bool
    (Classified a -> Classified a -> Bool)
    -> (Classified a -> Classified a -> Bool) -> Eq (Classified a)
    forall a. Eq a => Classified a -> Classified a -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: forall a. Eq a => Classified a -> Classified a -> Bool
    == :: Classified a -> Classified a -> Bool
    $c/= :: forall a. Eq a => Classified a -> Classified a -> Bool
    /= :: Classified a -> Classified a -> Bool
    Eq, Eq (Classified a)
    Eq (Classified a) =>
    (Classified a -> Classified a -> Ordering)
    -> (Classified a -> Classified a -> Bool)
    -> (Classified a -> Classified a -> Bool)
    -> (Classified a -> Classified a -> Bool)
    -> (Classified a -> Classified a -> Bool)
    -> (Classified a -> Classified a -> Classified a)
    -> (Classified a -> Classified a -> Classified a)
    -> Ord (Classified a)
    Classified a -> Classified a -> Bool
    Classified a -> Classified a -> Ordering
    Classified a -> Classified a -> Classified a
    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
    forall a. Ord a => Eq (Classified a)
    forall a. Ord a => Classified a -> Classified a -> Bool
    forall a. Ord a => Classified a -> Classified a -> Ordering
    forall a. Ord a => Classified a -> Classified a -> Classified a
    $ccompare :: forall a. Ord a => Classified a -> Classified a -> Ordering
    compare :: Classified a -> Classified a -> Ordering
    $c< :: forall a. Ord a => Classified a -> Classified a -> Bool
    < :: Classified a -> Classified a -> Bool
    $c<= :: forall a. Ord a => Classified a -> Classified a -> Bool
    <= :: Classified a -> Classified a -> Bool
    $c> :: forall a. Ord a => Classified a -> Classified a -> Bool
    > :: Classified a -> Classified a -> Bool
    $c>= :: forall a. Ord a => Classified a -> Classified a -> Bool
    >= :: Classified a -> Classified a -> Bool
    $cmax :: forall a. Ord a => Classified a -> Classified a -> Classified a
    max :: Classified a -> Classified a -> Classified a
    $cmin :: forall a. Ord a => Classified a -> Classified a -> Classified a
    min :: Classified a -> Classified a -> Classified a
    Ord, Int -> Classified a -> ShowS
    [Classified a] -> ShowS
    Classified a -> String
    (Int -> Classified a -> ShowS)
    -> (Classified a -> String)
    -> ([Classified a] -> ShowS)
    -> Show (Classified a)
    forall a. Show a => Int -> Classified a -> ShowS
    forall a. Show a => [Classified a] -> ShowS
    forall a. Show a => Classified a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall a. Show a => Int -> Classified a -> ShowS
    showsPrec :: Int -> Classified a -> ShowS
    $cshow :: forall a. Show a => Classified a -> String
    show :: Classified a -> String
    $cshowList :: forall a. Show a => [Classified a] -> ShowS
    showList :: [Classified a] -> ShowS
    Show)

    classified :: [Pos Char] -> [Classified (Pos Char)]
    classified :: [Pos Char] -> [Classified (Pos Char)]
    classified =
      let
        ok :: a -> Classified a
    ok =
          Class -> a -> Classified a
    forall a. Class -> a -> Classified a
    Classified Class
    NotComment

        ko :: a -> Classified a
    ko =
          Class -> a -> Classified a
    forall a. Class -> a -> Classified a
    Classified Class
    Comment

        loop :: a -> Bool -> [Pos Char] -> [Classified (Pos Char)]
    loop a
    nesting Bool
    in_line = \case
          [] ->
            []

          x :: Pos Char
    x@(Pos Position
    _ Char
    '\n') : [Pos Char]
    xs | Bool
    in_line ->
            Pos Char -> Classified (Pos Char)
    forall {a}. a -> Classified a
    ok Pos Char
    x Classified (Pos Char)
    -> [Classified (Pos Char)] -> [Classified (Pos Char)]
    forall a. a -> [a] -> [a]
    : a -> Bool -> [Pos Char] -> [Classified (Pos Char)]
    loop a
    nesting Bool
    False [Pos Char]
    xs

          Pos Char
    x : [Pos Char]
    xs | Bool
    in_line ->
            Pos Char -> Classified (Pos Char)
    forall {a}. a -> Classified a
    ko Pos Char
    x Classified (Pos Char)
    -> [Classified (Pos Char)] -> [Classified (Pos Char)]
    forall a. a -> [a] -> [a]
    : a -> Bool -> [Pos Char] -> [Classified (Pos Char)]
    loop a
    nesting Bool
    in_line [Pos Char]
    xs

          x :: Pos Char
    x@(Pos Position
    _ Char
    '{') : y :: Pos Char
    y@(Pos Position
    _ Char
    '-') : [Pos Char]
    xs ->
            Pos Char -> Classified (Pos Char)
    forall {a}. a -> Classified a
    ko Pos Char
    x Classified (Pos Char)
    -> [Classified (Pos Char)] -> [Classified (Pos Char)]
    forall a. a -> [a] -> [a]
    : Pos Char -> Classified (Pos Char)
    forall {a}. a -> Classified a
    ko Pos Char
    y Classified (Pos Char)
    -> [Classified (Pos Char)] -> [Classified (Pos Char)]
    forall a. a -> [a] -> [a]
    : a -> Bool -> [Pos Char] -> [Classified (Pos Char)]
    loop (a
    nesting a -> a -> a
    forall a. Num a => a -> a -> a
    + a
    1) Bool
    in_line [Pos Char]
    xs

          x :: Pos Char
    x@(Pos Position
    _ Char
    '-') : y :: Pos Char
    y@(Pos Position
    _ Char
    '}') : [Pos Char]
    xs | a
    nesting a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    > a
    0 ->
            Pos Char -> Classified (Pos Char)
    forall {a}. a -> Classified a
    ko Pos Char
    x Classified (Pos Char)
    -> [Classified (Pos Char)] -> [Classified (Pos Char)]
    forall a. a -> [a] -> [a]
    : Pos Char -> Classified (Pos Char)
    forall {a}. a -> Classified a
    ko Pos Char
    y Classified (Pos Char)
    -> [Classified (Pos Char)] -> [Classified (Pos Char)]
    forall a. a -> [a] -> [a]
    : a -> Bool -> [Pos Char] -> [Classified (Pos Char)]
    loop (a
    nesting a -> a -> a
    forall a. Num a => a -> a -> a
    - a
    1) Bool
    in_line [Pos Char]
    xs

          Pos Char
    x : [Pos Char]
    xs | a
    nesting a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    > a
    0 ->
            Pos Char -> Classified (Pos Char)
    forall {a}. a -> Classified a
    ko Pos Char
    x Classified (Pos Char)
    -> [Classified (Pos Char)] -> [Classified (Pos Char)]
    forall a. a -> [a] -> [a]
    : a -> Bool -> [Pos Char] -> [Classified (Pos Char)]
    loop a
    nesting Bool
    in_line [Pos Char]
    xs

          -- FIXME This is not technically correct, we should allow arbitrary runs
          -- FIXME of dashes followed by a symbol character. Here we have only
          -- FIXME allowed two.
          x :: Pos Char
    x@(Pos Position
    _ Char
    '-') : y :: Pos Char
    y@(Pos Position
    _ Char
    '-') : z :: Pos Char
    z@(Pos Position
    _ Char
    zz) : [Pos Char]
    xs
            | Bool -> Bool
    not (Char -> Bool
    Char.isSymbol Char
    zz)
            ->
              Pos Char -> Classified (Pos Char)
    forall {a}. a -> Classified a
    ko Pos Char
    x Classified (Pos Char)
    -> [Classified (Pos Char)] -> [Classified (Pos Char)]
    forall a. a -> [a] -> [a]
    : Pos Char -> Classified (Pos Char)
    forall {a}. a -> Classified a
    ko Pos Char
    y Classified (Pos Char)
    -> [Classified (Pos Char)] -> [Classified (Pos Char)]
    forall a. a -> [a] -> [a]
    : a -> Bool -> [Pos Char] -> [Classified (Pos Char)]
    loop a
    nesting Bool
    True (Pos Char
    z Pos Char -> [Pos Char] -> [Pos Char]
    forall a. a -> [a] -> [a]
    : [Pos Char]
    xs)

          Pos Char
    x : [Pos Char]
    xs ->
            Pos Char -> Classified (Pos Char)
    forall {a}. a -> Classified a
    ok Pos Char
    x Classified (Pos Char)
    -> [Classified (Pos Char)] -> [Classified (Pos Char)]
    forall a. a -> [a] -> [a]
    : a -> Bool -> [Pos Char] -> [Classified (Pos Char)]
    loop a
    nesting Bool
    in_line [Pos Char]
    xs
      in
        Int -> Bool -> [Pos Char] -> [Classified (Pos Char)]
    forall {a}.
    (Num a, Ord a) =>
    a -> Bool -> [Pos Char] -> [Classified (Pos Char)]
    loop (Int
    0 :: Int) Bool
    False

    ------------------------------------------------------------------------
    -- Character Positioning

    data Position =
      Position {
          Position -> String
    _posPath :: !FilePath
        , Position -> LineNo
    posLine :: !LineNo
        , Position -> ColumnNo
    posColumn :: !ColumnNo
        } deriving (Position -> Position -> Bool
    (Position -> Position -> Bool)
    -> (Position -> Position -> Bool) -> Eq Position
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Position -> Position -> Bool
    == :: Position -> Position -> Bool
    $c/= :: Position -> Position -> Bool
    /= :: 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
    $ccompare :: Position -> Position -> Ordering
    compare :: Position -> Position -> Ordering
    $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
    >= :: Position -> Position -> Bool
    $cmax :: Position -> Position -> Position
    max :: Position -> Position -> Position
    $cmin :: Position -> Position -> Position
    min :: Position -> Position -> 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
    $cshowsPrec :: Int -> Position -> ShowS
    showsPrec :: Int -> Position -> ShowS
    $cshow :: Position -> String
    show :: Position -> String
    $cshowList :: [Position] -> ShowS
    showList :: [Position] -> ShowS
    Show)

    data Pos a =
      Pos {
          forall a. Pos a -> Position
    posPostion :: !Position
        , forall a. Pos a -> a
    posValue :: a
        } deriving (Pos a -> Pos a -> Bool
    (Pos a -> Pos a -> Bool) -> (Pos a -> Pos a -> Bool) -> Eq (Pos a)
    forall a. Eq a => Pos a -> Pos a -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: forall a. Eq a => Pos a -> Pos a -> Bool
    == :: Pos a -> Pos a -> Bool
    $c/= :: forall a. Eq a => Pos a -> Pos a -> Bool
    /= :: Pos a -> Pos a -> Bool
    Eq, Eq (Pos a)
    Eq (Pos a) =>
    (Pos a -> Pos a -> Ordering)
    -> (Pos a -> Pos a -> Bool)
    -> (Pos a -> Pos a -> Bool)
    -> (Pos a -> Pos a -> Bool)
    -> (Pos a -> Pos a -> Bool)
    -> (Pos a -> Pos a -> Pos a)
    -> (Pos a -> Pos a -> Pos a)
    -> Ord (Pos a)
    Pos a -> Pos a -> Bool
    Pos a -> Pos a -> Ordering
    Pos a -> Pos a -> Pos a
    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
    forall a. Ord a => Eq (Pos a)
    forall a. Ord a => Pos a -> Pos a -> Bool
    forall a. Ord a => Pos a -> Pos a -> Ordering
    forall a. Ord a => Pos a -> Pos a -> Pos a
    $ccompare :: forall a. Ord a => Pos a -> Pos a -> Ordering
    compare :: Pos a -> Pos a -> Ordering
    $c< :: forall a. Ord a => Pos a -> Pos a -> Bool
    < :: Pos a -> Pos a -> Bool
    $c<= :: forall a. Ord a => Pos a -> Pos a -> Bool
    <= :: Pos a -> Pos a -> Bool
    $c> :: forall a. Ord a => Pos a -> Pos a -> Bool
    > :: Pos a -> Pos a -> Bool
    $c>= :: forall a. Ord a => Pos a -> Pos a -> Bool
    >= :: Pos a -> Pos a -> Bool
    $cmax :: forall a. Ord a => Pos a -> Pos a -> Pos a
    max :: Pos a -> Pos a -> Pos a
    $cmin :: forall a. Ord a => Pos a -> Pos a -> Pos a
    min :: Pos a -> Pos a -> Pos a
    Ord, Int -> Pos a -> ShowS
    [Pos a] -> ShowS
    Pos a -> String
    (Int -> Pos a -> ShowS)
    -> (Pos a -> String) -> ([Pos a] -> ShowS) -> Show (Pos a)
    forall a. Show a => Int -> Pos a -> ShowS
    forall a. Show a => [Pos a] -> ShowS
    forall a. Show a => Pos a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall a. Show a => Int -> Pos a -> ShowS
    showsPrec :: Int -> Pos a -> ShowS
    $cshow :: forall a. Show a => Pos a -> String
    show :: Pos a -> String
    $cshowList :: forall a. Show a => [Pos a] -> ShowS
    showList :: [Pos a] -> ShowS
    Show, (forall a b. (a -> b) -> Pos a -> Pos b)
    -> (forall a b. a -> Pos b -> Pos a) -> Functor Pos
    forall a b. a -> Pos b -> Pos a
    forall a b. (a -> b) -> Pos a -> Pos b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> Pos a -> Pos b
    fmap :: forall a b. (a -> b) -> Pos a -> Pos b
    $c<$ :: forall a b. a -> Pos b -> Pos a
    <$ :: forall a b. a -> Pos b -> Pos a
    Functor)

    instance Semigroup a => Semigroup (Pos a) where
      <> :: Pos a -> Pos a -> Pos a
    (<>) (Pos Position
    p a
    x) (Pos Position
    q a
    y) =
        if Position
    p Position -> Position -> Bool
    forall a. Ord a => a -> a -> Bool
    < Position
    q then
          Position -> a -> Pos a
    forall a. Position -> a -> Pos a
    Pos Position
    p (a
    x a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> a
    y)
        else
          Position -> a -> Pos a
    forall a. Position -> a -> Pos a
    Pos Position
    q (a
    y a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> a
    x)

    positioned :: FilePath -> [Char] -> [Pos Char]
    positioned :: String -> String -> [Pos Char]
    positioned String
    path =
      let
        loop :: LineNo -> ColumnNo -> String -> [Pos Char]
    loop LineNo
    l ColumnNo
    c = \case
          [] ->
            []

          Char
    '\n' : String
    xs ->
            Position -> Char -> Pos Char
    forall a. Position -> a -> Pos a
    Pos (String -> LineNo -> ColumnNo -> Position
    Position String
    path LineNo
    l ColumnNo
    c) Char
    '\n' Pos Char -> [Pos Char] -> [Pos Char]
    forall a. a -> [a] -> [a]
    : LineNo -> ColumnNo -> String -> [Pos Char]
    loop (LineNo
    l LineNo -> LineNo -> LineNo
    forall a. Num a => a -> a -> a
    + LineNo
    1) ColumnNo
    1 String
    xs

          Char
    x : String
    xs ->
            Position -> Char -> Pos Char
    forall a. Position -> a -> Pos a
    Pos (String -> LineNo -> ColumnNo -> Position
    Position String
    path LineNo
    l ColumnNo
    c) Char
    x Pos Char -> [Pos Char] -> [Pos Char]
    forall a. a -> [a] -> [a]
    : LineNo -> ColumnNo -> String -> [Pos Char]
    loop LineNo
    l (ColumnNo
    c ColumnNo -> ColumnNo -> ColumnNo
    forall a. Num a => a -> a -> a
    + ColumnNo
    1) String
    xs
      in
        LineNo -> ColumnNo -> String -> [Pos Char]
    loop LineNo
    1 ColumnNo
    1