Type.elm

module Elm.Documentation.Type exposing
  ( Type(..)
  , decoder
  )

{-| This is specifically for handling the types that appear in
documentation generated by `elm-make`. If you are looking to parse
arbitrary type signatures with creative indentation (e.g. newlines
and comments) this library will not do what you want. Instead,
check out the source code and go from there. It's not too tough!

@docs Type, decoder

-}

import Char
import Json.Decode as Decode exposing (Decoder)
import Parser exposing (Parser, (|=), (|.))
import Parser.LanguageKit as Parser
import Set
import String



-- TYPES


{-| Represent Elm types as values! Here are some examples:

    Int            ==> Type "Int" []

    a -> b         ==> Lambda (Var "a") (Var "b")

    ( a, b )       ==> Tuple [ Var "a", Var "b" ]

    Maybe a        ==> Type "Maybe" [ Var "a" ]

    { x : Float }  ==> Record [("x", Type "Float" [])] Nothing
-}
type Type
  = Var String
  | Lambda Type Type
  | Tuple (List Type)
  | Type String (List Type)
  | Record (List (String, Type)) (Maybe String)



-- DECODE


{-| Decode the JSON representation of `Type` values.
-}
decoder : Decoder Type
decoder =
  Decode.andThen decoderHelp Decode.string


decoderHelp : String -> Decoder Type
decoderHelp string =
  case parse string of
    Err error ->
      Decode.fail "TODO"

    Ok tipe ->
      Decode.succeed tipe



-- PARSE TYPES


parse : String -> Result Parser.Error Type
parse source =
  Parser.run tipe source



-- FUNCTIONS


tipe : Parser Type
tipe =
  Parser.lazy <| \_ ->
    tipeTerm
      |> Parser.andThen tipeHelp


tipeHelp : Type -> Parser Type
tipeHelp t =
  Parser.oneOf
    [ Parser.map (Lambda t) arrowAndType
    , Parser.succeed t
    ]


arrowAndType : Parser Type
arrowAndType =
  Parser.delayedCommit spaces <|
    Parser.succeed identity
      |. arrow
      |. spaces
      |= tipe


arrow : Parser ()
arrow =
  Parser.symbol "->"


tipeTerm : Parser Type
tipeTerm =
  Parser.lazy <| \_ ->
    Parser.oneOf
      [ Parser.map Var lowVar
      , Parser.succeed Type
          |= qualifiedCapVar
          |= chompArgs []
      , record
      , tuple
      ]


chompArgs : List Type -> Parser (List Type)
chompArgs revArgs =
  Parser.oneOf
    [ Parser.delayedCommit spaces term
        |> Parser.andThen (\arg -> chompArgs (arg :: revArgs))
    , Parser.succeed (List.reverse revArgs)
    ]


term : Parser Type
term =
  Parser.lazy <| \_ ->
    Parser.oneOf
      [ Parser.map Var lowVar
      , Parser.map (flip Type []) qualifiedCapVar
      , record
      , tuple
      ]



-- RECORDS


record : Parser Type
record =
  Parser.lazy <| \_ ->
    Parser.succeed (flip Record)
      |. Parser.symbol "{"
      |. spaces
      |= extension
      |= commaSep field
      |. spaces
      |. Parser.symbol "}"


extension : Parser (Maybe String)
extension =
  Parser.oneOf
    [ Parser.delayedCommitMap always ext (Parser.succeed ())
    , Parser.succeed Nothing
    ]


ext : Parser (Maybe String)
ext =
  Parser.succeed Just
    |= lowVar
    |. spaces
    |. Parser.symbol "|"
    |. spaces


field : Parser (String, Type)
field =
  Parser.lazy <| \_ ->
    Parser.succeed (,)
      |= lowVar
      |. spaces
      |. Parser.symbol ":"
      |. spaces
      |= tipe



-- TUPLE


tuple : Parser Type
tuple =
  Parser.map tuplize <|
    Parser.tuple spaces tipe


tuplize : List Type -> Type
tuplize args =
  case args of
    [tipe] ->
      tipe

    _ ->
      Tuple args



-- VAR HELPERS


lowVar : Parser String
lowVar =
  variable Char.isLower


capVar : Parser String
capVar =
  variable Char.isUpper


isInnerVarChar : Char -> Bool
isInnerVarChar char =
  Char.isLower char
  || Char.isUpper char
  || Char.isDigit char
  || char == '_'


qualifiedCapVar : Parser String
qualifiedCapVar =
  Parser.source <|
    capVar
      |. Parser.repeat Parser.zeroOrMore (Parser.symbol "." |. capVar)


variable : (Char -> Bool) -> Parser String
variable isFirst =
  Parser.variable isFirst isInnerVarChar Set.empty



-- HELPERS


spaces : Parser ()
spaces =
  Parser.ignore Parser.zeroOrMore (\char -> char == ' ')


commaSep : Parser a -> Parser (List a)
commaSep parser =
  parser
    |> Parser.andThen (\first -> commaSepHelp parser [first])


commaSepHelp : Parser a -> List a -> Parser (List a)
commaSepHelp parser revList =
  Parser.oneOf
    [ commaAnd parser
        |> Parser.andThen (\a -> commaSepHelp parser (a :: revList))
    , Parser.succeed (List.reverse revList)
    ]


commaAnd : Parser a -> Parser a
commaAnd parser =
  Parser.delayedCommit spaces <|
    Parser.succeed identity
      |. comma
      |. spaces
      |= parser


comma : Parser ()
comma =
  Parser.symbol ","