diff --git a/.gitignore b/.gitignore index cd74161..a57226e 100644 --- a/.gitignore +++ b/.gitignore @@ -13,3 +13,5 @@ elchemy_ex/lib/* elchemy-*.ez _build/ docs/ +example/ +stable/ diff --git a/Makefile b/Makefile index 9e76125..5e25e19 100644 --- a/Makefile +++ b/Makefile @@ -44,7 +44,7 @@ compile-std-watch: find elchemy-core -name "*.elm" | grep -v ".#" | grep -v "elm-stuff" | entr make compile-std compile-std-tests-watch: - find elchemy-core \( -name "*.elm" -or -name '*.ex' \) | grep -v "elchemy.ex" | grep -v ".#" | grep -v "elm-stuff" | entr bash -c "make compile && make compile-std && make test-std" + find elchemy-core \( -name "*.elm" -or -name '*.ex*' \) | grep -v "elchemy.ex" | grep -v ".#" | grep -v "elm-stuff" | entr bash -c "make compile && make compile-std && make test-std" tests-watch: find . -name "*.elm" | grep -v ".#" | grep -v "elm-stuff" | entr ./node_modules/.bin/elm-test diff --git a/elchemy-core b/elchemy-core index 5627170..bdbe7f9 160000 --- a/elchemy-core +++ b/elchemy-core @@ -1 +1 @@ -Subproject commit 5627170c3f77509b75e25d7d45777e80e74fe870 +Subproject commit bdbe7f92673fe81189523487e6e68c8e1f057249 diff --git a/src/ExExpression.elm b/src/ExExpression.elm index 57d681c..24ea3ad 100644 --- a/src/ExExpression.elm +++ b/src/ExExpression.elm @@ -31,6 +31,7 @@ import ExContext , mergeVariables , areMatchingArity ) +import ExSelector {-| Encode any given expression @@ -322,17 +323,29 @@ isMacro e = Application a _ -> isMacro a - Variable [ "tryFfi" ] -> - True - - Variable [ "ffi" ] -> - True - - Variable [ "lffi" ] -> - True - - Variable [ "flambda" ] -> - True + Variable [ x ] -> + List.member x + [ "tryFfi" + , "ffi" + , "lffi" + , "flambda" + , "updateIn" + , "updateIn2" + , "updateIn3" + , "updateIn4" + , "updateIn5" + , "putIn" + , "putIn" + , "putIn2" + , "putIn3" + , "putIn4" + , "putIn5" + , "getIn" + , "getIn2" + , "getIn3" + , "getIn4" + , "getIn5" + ] other -> False @@ -344,9 +357,7 @@ flattenTypeApplication : Expression -> List Expression flattenTypeApplication application = case application of Application left right -> - if isMacro application then - (flattenTypeApplication left) ++ [ right ] - else if isTuple application then + if isMacro application || isTuple application then (flattenTypeApplication left) ++ [ right ] else [ application ] @@ -388,14 +399,53 @@ functionApplication c left right = elixirE c left ++ ".(" ++ elixirE c right ++ ")" +encodeAccessMacroAndRest : Context -> ( ExSelector.AccessMacro, List Expression ) -> String +encodeAccessMacroAndRest c ( ExSelector.AccessMacro t arity selectors, rest ) = + let + encodeSelector (ExSelector.Access s) = + ":" ++ toSnakeCase True s + + encodedSelectors = + selectors |> List.map encodeSelector |> String.join ", " + + encodedType = + case t of + ExSelector.Update -> + "update_in_" + + ExSelector.Get -> + "get_in_" + + ExSelector.Put -> + "put_in_" + + encodedRest = + case rest of + [] -> + "" + + list -> + ".(" + ++ (List.map (elixirE c) rest |> String.join ").(") + ++ ")" + in + encodedType + ++ "([" + ++ encodedSelectors + ++ "])" + ++ encodedRest + + {-| Returns code representation of tuple or function depending on definition -} tupleOrFunction : Context -> Expression -> String tupleOrFunction c a = case flattenTypeApplication a of + -- Not a macro (Application left right) :: [] -> functionApplication c left right + -- A macro (Variable [ "ffi" ]) :: rest -> Debug.crash "Ffi inside function body is deprecated since Elchemy 0.3" @@ -417,18 +467,23 @@ tupleOrFunction c a = [ Variable [ "Err" ], arg ] -> "{:error, " ++ elixirE c arg ++ "}" - (Variable list) :: rest -> - Helpers.moduleAccess c.mod list - |> (\( mod, last ) -> - aliasFor (ExContext.changeCurrentModule mod c) last rest - |> Maybe.withDefault - ("{" - ++ elixirE c (Variable [ last ]) - ++ ", " - ++ (List.map (elixirE c) rest |> String.join ", ") - ++ "}" - ) - ) + -- Regular non-macro application + ((Variable list) as call) :: rest -> + ExSelector.maybeAccessMacro call rest + |> Maybe.map (encodeAccessMacroAndRest c) + |> Maybe.withDefault + (Helpers.moduleAccess c.mod list + |> (\( mod, last ) -> + aliasFor (ExContext.changeCurrentModule mod c) last rest + |> Maybe.withDefault + ("{" + ++ elixirE c (Variable [ last ]) + ++ ", " + ++ (List.map (elixirE c) rest |> String.join ", ") + ++ "}" + ) + ) + ) other -> Debug.crash ("Shouldn't ever work for" ++ toString other) @@ -537,7 +592,7 @@ isTuple a = caseE : Context -> Expression -> List ( Expression, Expression ) -> String caseE c var body = if c.inCaseOf then - Debug.log ("Module " ++ c.mod) "Because of a known bug in elm-ast parser, you can't reliably use nested case..of yet. Sorry" + Debug.crash <| "Module " ++ c.mod ++ "\nBecause of a known bug in elm-ast parser, you can't reliably use nested case..of yet. Sorry" else "case " ++ elixirE c var diff --git a/src/ExSelector.elm b/src/ExSelector.elm new file mode 100644 index 0000000..ed10b0a --- /dev/null +++ b/src/ExSelector.elm @@ -0,0 +1,96 @@ +module ExSelector exposing (Selector(..), maybeAccessMacro, AccessMacro(..), AccessMacroType(..)) + +import Ast.Expression exposing (Expression(AccessFunction, Application, Variable)) +import Regex +import Char +import List.Extra +import Helpers + + +type Selector + = Access String + + +type AccessMacroType + = Get + | Put + | Update + + +type AccessMacro + = AccessMacro AccessMacroType Int (List Selector) + + +getSelector : Expression -> Selector +getSelector expression = + case expression of + AccessFunction name -> + Access (Helpers.toSnakeCase True name) + + _ -> + Debug.crash "The only allowed selectors are: .field" + + +maybeAccessMacro : Expression -> List Expression -> Maybe ( AccessMacro, List Expression ) +maybeAccessMacro call args = + let + accessMacroArgs arity args = + case compare (List.length args) arity of + LT -> + Debug.crash <| + "Access macros [updateIn/getIn/putIn] cannot be partially applied. Expecting " + ++ toString arity + ++ " selector arguments." + + EQ -> + ( List.map getSelector args, [] ) + + GT -> + List.Extra.splitAt arity args + |> Tuple.mapFirst (List.map getSelector) + in + case ( call, args ) of + ( Variable [ name ], args ) -> + accessMacroType name + |> Maybe.map + (\( t, arity ) -> + let + ( selectors, rest ) = + accessMacroArgs arity args + in + ( AccessMacro t arity selectors, rest ) + ) + + _ -> + Nothing + + +accessMacroType : String -> Maybe ( AccessMacroType, Int ) +accessMacroType string = + let + getArity = + String.filter Char.isDigit + >> String.toInt + >> Result.withDefault 1 + + getType x = + [ ( "updateIn\\d?", Update ) + , ( "putIn\\d?", Put ) + , ( "getIn\\d?", Get ) + ] + |> List.foldl + (\( match, res ) acc -> + case acc of + Nothing -> + if Regex.contains (Regex.regex match) x then + Just res + else + Nothing + + res -> + res + ) + Nothing + in + getType string + |> Maybe.map (\t -> ( t, getArity string )) diff --git a/src/Helpers.elm b/src/Helpers.elm index 9f3af6c..9a683ff 100644 --- a/src/Helpers.elm +++ b/src/Helpers.elm @@ -460,6 +460,21 @@ applicationToList application = [ other ] +{-| Change list of expressions into an application +-} +listToApplication : List Expression -> Expression +listToApplication list = + case list of + [] -> + Debug.crash "Empty list to expression conversion" + + [ one ] -> + one + + left :: rest -> + Application left (listToApplication rest) + + {-| Change type application into a list of expressions -} typeApplicationToList : Type -> List Type diff --git a/tests/Tests.elm b/tests/Tests.elm index 206f415..36b6daf 100644 --- a/tests/Tests.elm +++ b/tests/Tests.elm @@ -569,6 +569,28 @@ letIns = ] +accessMacros : Test +accessMacros = + describe "Access macros compile properly" + [ test "Update" + (\() -> + "test = updateIn .a (\\a -> a + 1)" |> has "update_in_([:a]).(fn a -> (a + 1) end)" + ) + , test "Update5" + (\() -> + "test = updateIn5 .a .b .c .d .e (\\a -> a + 1) v" |> has "update_in_([:a, :b, :c, :d, :e]).(fn a -> (a + 1) end).(v())" + ) + , test "Get" + (\() -> + "test = getIn3 .something .something .darkSide True v" |> has "get_in_([:something, :something, :dark_side]).(:true).(v())" + ) + , test "Put" + (\() -> + "test = putIn4 .a .b .c .d 10 v" |> has "put_in_([:a, :b, :c, :d]).(10).(v())" + ) + ] + + all : Test all = describe "All" @@ -586,4 +608,5 @@ all = , doctests , fileImports , letIns + , accessMacros ]